Move files and dirs from translate/

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 000000000..e68b1168b
--- /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;