summaryrefslogtreecommitdiff
path: root/src/grt/grt-disp.adb
diff options
context:
space:
mode:
authorTristan Gingold2014-11-05 05:11:00 +0100
committerTristan Gingold2014-11-05 05:11:00 +0100
commit3fddf1c59fd7a8fcd260bb9e05c611bef3dd141b (patch)
treecbfe6d75f8e09db8b98f335406fb6ecb2fce3e0c /src/grt/grt-disp.adb
parent0a088b311ed2fcebc542f8a2e42d09e2e3c9311c (diff)
downloadghdl-3fddf1c59fd7a8fcd260bb9e05c611bef3dd141b.tar.gz
ghdl-3fddf1c59fd7a8fcd260bb9e05c611bef3dd141b.tar.bz2
ghdl-3fddf1c59fd7a8fcd260bb9e05c611bef3dd141b.zip
Move files and dirs from translate/
Diffstat (limited to 'src/grt/grt-disp.adb')
-rw-r--r--src/grt/grt-disp.adb227
1 files changed, 227 insertions, 0 deletions
diff --git a/src/grt/grt-disp.adb b/src/grt/grt-disp.adb
new file mode 100644
index 0000000..e68b116
--- /dev/null
+++ b/src/grt/grt-disp.adb
@@ -0,0 +1,227 @@
+-- GHDL Run Time (GRT) - Common display subprograms.
+-- Copyright (C) 2002 - 2014 Tristan Gingold
+--
+-- GHDL is free software; you can redistribute it and/or modify it under
+-- the terms of the GNU General Public License as published by the Free
+-- Software Foundation; either version 2, or (at your option) any later
+-- version.
+--
+-- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY
+-- WARRANTY; without even the implied warranty of MERCHANTABILITY or
+-- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+-- for more details.
+--
+-- You should have received a copy of the GNU General Public License
+-- along with GCC; see the file COPYING. If not, write to the Free
+-- Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+-- 02111-1307, USA.
+--
+-- As a special exception, if other files instantiate generics from this
+-- unit, or you link this unit with other files to produce an executable,
+-- this unit does not by itself cause the resulting executable to be
+-- covered by the GNU General Public License. This exception does not
+-- however invalidate any other reasons why the executable file might be
+-- covered by the GNU Public License.
+with System.Storage_Elements; -- Work around GNAT bug.
+pragma Unreferenced (System.Storage_Elements);
+with Grt.Astdio; use Grt.Astdio;
+with Grt.Stdio; use Grt.Stdio;
+--with Grt.Errors; use Grt.Errors;
+
+package body Grt.Disp is
+
+-- procedure Put_Trim (Stream : FILEs; Str : String)
+-- is
+-- Start : Natural;
+-- begin
+-- Start := Str'First;
+-- while Start <= Str'Last and then Str (Start) = ' ' loop
+-- Start := Start + 1;
+-- end loop;
+-- Put (Stream, Str (Start .. Str'Last));
+-- end Put_Trim;
+
+-- procedure Put_E8 (Stream : FILEs; E8 : Ghdl_E8; Type_Desc : Ghdl_Desc_Ptr)
+-- is
+-- begin
+-- Put_Str_Len (Stream, Type_Desc.E8.Values (Natural (E8)));
+-- end Put_E8;
+
+ --procedure Put_E32
+ -- (Stream : FILEs; E32 : Ghdl_E32; Type_Desc : Ghdl_Desc_Ptr)
+ --is
+ --begin
+ -- Put_Str_Len (Stream, Type_Desc.E32.Values (Natural (E32)));
+ --end Put_E32;
+
+ procedure Put_Sig_Index (Sig : Sig_Table_Index)
+ is
+ begin
+ Put_I32 (stdout, Ghdl_I32 (Sig));
+ end Put_Sig_Index;
+
+ procedure Put_Sig_Range (Sig : Sig_Table_Range)
+ is
+ begin
+ Put_Sig_Index (Sig.First);
+ if Sig.Last /= Sig.First then
+ Put ("-");
+ Put_Sig_Index (Sig.Last);
+ end if;
+ end Put_Sig_Range;
+
+ procedure Disp_Now
+ is
+ begin
+ Put ("Now is ");
+ Put_Time (stdout, Current_Time);
+ Put (" +");
+ Put_I32 (stdout, Ghdl_I32 (Current_Delta));
+ New_Line;
+ end Disp_Now;
+
+ procedure Disp_Propagation_Kind (Kind : Propagation_Kind_Type)
+ is
+ begin
+ case Kind is
+ when Drv_One_Driver =>
+ Put ("Drv (1 drv) ");
+ when Eff_One_Driver =>
+ Put ("Eff (1 drv) ");
+ when Drv_One_Port =>
+ Put ("Drv (1 prt) ");
+ when Eff_One_Port =>
+ Put ("Eff (1 prt) ");
+ when Imp_Forward =>
+ Put ("Forward ");
+ when Imp_Forward_Build =>
+ Put ("Forward_Build ");
+ when Imp_Guard =>
+ Put ("Guard ");
+ when Imp_Stable =>
+ Put ("Stable ");
+ when Imp_Quiet =>
+ Put ("Quiet ");
+ when Imp_Transaction =>
+ Put ("Transaction ");
+ when Imp_Delayed =>
+ Put ("Delayed ");
+ when Eff_Actual =>
+ Put ("Eff Actual ");
+ when Eff_Multiple =>
+ Put ("Eff multiple ");
+ when Drv_One_Resolved =>
+ Put ("Drv 1 resolved ");
+ when Eff_One_Resolved =>
+ Put ("Eff 1 resolved ");
+ when In_Conversion =>
+ Put ("In conv ");
+ when Out_Conversion =>
+ Put ("Out conv ");
+ when Drv_Error =>
+ Put ("Drv error ");
+ when Drv_Multiple =>
+ Put ("Drv multiple ");
+ when Prop_End =>
+ Put ("end ");
+ end case;
+ end Disp_Propagation_Kind;
+
+ procedure Disp_Signals_Order is
+ begin
+ for I in Propagation.First .. Propagation.Last loop
+ Put_I32 (stdout, Ghdl_I32 (I));
+ Put (": ");
+ Disp_Propagation_Kind (Propagation.Table (I).Kind);
+ case Propagation.Table (I).Kind is
+ when Drv_One_Driver
+ | Eff_One_Driver
+ | Drv_One_Port
+ | Eff_One_Port
+ | Drv_One_Resolved
+ | Eff_One_Resolved
+ | Imp_Guard
+ | Imp_Stable
+ | Imp_Quiet
+ | Imp_Transaction
+ | Imp_Delayed
+ | Eff_Actual =>
+ Put_Sig_Index (Signal_Ptr_To_Index (Propagation.Table (I).Sig));
+ New_Line;
+ when Imp_Forward =>
+ Put_I32 (stdout, Ghdl_I32 (Propagation.Table (I).Sig.Net));
+ New_Line;
+ when Imp_Forward_Build =>
+ declare
+ Forward : Forward_Build_Acc;
+ begin
+ Forward := Propagation.Table (I).Forward;
+ Put_Sig_Index (Signal_Ptr_To_Index (Forward.Src));
+ Put (" -> ");
+ Put_Sig_Index (Signal_Ptr_To_Index (Forward.Targ));
+ New_Line;
+ end;
+ when Eff_Multiple
+ | Drv_Multiple =>
+ Put_Sig_Range (Propagation.Table (I).Resolv.Sig_Range);
+ New_Line;
+ when In_Conversion
+ | Out_Conversion =>
+ declare
+ Conv : Sig_Conversion_Acc;
+ begin
+ Conv := Propagation.Table (I).Conv;
+ Put_Sig_Range (Conv.Src);
+ Put (" -> ");
+ Put_Sig_Range (Conv.Dest);
+ New_Line;
+ end;
+ when Prop_End =>
+ New_Line;
+ when Drv_Error =>
+ null;
+ end case;
+ end loop;
+ end Disp_Signals_Order;
+
+ procedure Disp_Mode (Mode : Mode_Type)
+ is
+ begin
+ case Mode is
+ when Mode_B1 =>
+ Put (" b1");
+ when Mode_E8 =>
+ Put (" e8");
+ when Mode_E32 =>
+ Put ("e32");
+ when Mode_I32 =>
+ Put ("i32");
+ when Mode_I64 =>
+ Put ("i64");
+ when Mode_F64 =>
+ Put ("f64");
+ end case;
+ end Disp_Mode;
+
+ procedure Disp_Value (Value : Value_Union; Mode : Mode_Type) is
+ begin
+ case Mode is
+ when Mode_B1 =>
+ if Value.B1 then
+ Put ("T");
+ else
+ Put ("F");
+ end if;
+ when Mode_E8 =>
+ Put_I32 (stdout, Ghdl_I32 (Value.E8));
+ when Mode_E32 =>
+ Put_I32 (stdout, Ghdl_I32 (Value.E32));
+ when Mode_I32 =>
+ Put_I32 (stdout, Value.I32);
+ when Mode_I64 =>
+ Put_I64 (stdout, Value.I64);
+ when Mode_F64 =>
+ Put_F64 (stdout, Value.F64);
+ end case;
+ end Disp_Value;
+end Grt.Disp;