1 files changed, 0 insertions, 387 deletions
diff --git a/src/translate/grt/grt-images.adb b/src/translate/grt/grt-images.adb
deleted file mode 100644
index 342c98f..0000000
--- a/src/translate/grt/grt-images.adb
+++ /dev/null
@@ -1,387 +0,0 @@
---  GHDL Run Time (GRT) -  'image 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; use System;
-with System.Storage_Elements; --  Work around GNAT bug.
-pragma Unreferenced (System.Storage_Elements);
-with Ada.Unchecked_Conversion;
-with Grt.Rtis_Utils; use Grt.Rtis_Utils;
-with Grt.Processes; use Grt.Processes;
-with Grt.Vstrings; use Grt.Vstrings;
-with Grt.Errors; use Grt.Errors;
-
-package body Grt.Images is
-   function To_Std_String_Basep is new Ada.Unchecked_Conversion
-     (Source => System.Address, Target => Std_String_Basep);
-
-   function To_Std_String_Boundp is new Ada.Unchecked_Conversion
-     (Source => System.Address, Target => Std_String_Boundp);
-
-   procedure Set_String_Bounds (Res : Std_String_Ptr; Len : Ghdl_Index_Type)
-   is
-   begin
-      Res.Bounds := To_Std_String_Boundp
-        (Ghdl_Stack2_Allocate (Std_String_Bound'Size / System.Storage_Unit));
-      Res.Bounds.Dim_1 := (Left => 1,
-                           Right => Std_Integer (Len),
-                           Dir => Dir_To,
-                           Length => Len);
-   end Set_String_Bounds;
-
-   procedure Return_String (Res : Std_String_Ptr; Str : String)
-   is
-   begin
-      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Str'Length));
-      for I in 0 .. Str'Length - 1 loop
-         Res.Base (Ghdl_Index_Type (I)) := Str (Str'First + I);
-      end loop;
-      Set_String_Bounds (Res, Str'Length);
-   end Return_String;
-
-   procedure Return_Enum
-     (Res : Std_String_Ptr; Rti : Ghdl_Rti_Access; Index : Ghdl_Index_Type)
-   is
-      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
-      Str : Ghdl_C_String;
-   begin
-      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
-      Str := Enum_Rti.Names (Index);
-      Return_String (Res, Str (1 .. strlen (Str)));
-   end Return_Enum;
-
-   procedure Ghdl_Image_B1
-     (Res : Std_String_Ptr; Val : Ghdl_B1; Rti : Ghdl_Rti_Access)
-   is
-   begin
-      Return_Enum (Res, Rti, Ghdl_B1'Pos (Val));
-   end Ghdl_Image_B1;
-
-   procedure Ghdl_Image_E8
-     (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access)
-   is
-   begin
-      Return_Enum (Res, Rti, Ghdl_E8'Pos (Val));
-   end Ghdl_Image_E8;
-
-   procedure Ghdl_Image_E32
-     (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access)
-   is
-   begin
-      Return_Enum (Res, Rti, Ghdl_E32'Pos (Val));
-   end Ghdl_Image_E32;
-
-   procedure Ghdl_Image_I32 (Res : Std_String_Ptr; Val : Ghdl_I32)
-   is
-      Str : String (1 .. 11);
-      First : Natural;
-   begin
-      To_String (Str, First, Val);
-      Return_String (Res, Str (First .. Str'Last));
-   end Ghdl_Image_I32;
-
-   procedure Ghdl_Image_P64
-     (Res : Std_String_Ptr; Val : Ghdl_I64; Rti : Ghdl_Rti_Access)
-   is
-      Str : String (1 .. 21);
-      First : Natural;
-      Phys : constant Ghdl_Rtin_Type_Physical_Acc
-        := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
-      Unit_Name : Ghdl_C_String;
-      Unit_Len : Natural;
-   begin
-      To_String (Str, First, Val);
-      Unit_Name := Get_Physical_Unit_Name (Phys.Units (0));
-      Unit_Len := strlen (Unit_Name);
-      declare
-         L : constant Natural := Str'Last + 1 - First;
-         Str2 : String (1 .. L + 1 + Unit_Len);
-      begin
-         Str2 (1 .. L) := Str (First .. Str'Last);
-         Str2 (L + 1) := ' ';
-         Str2 (L + 2 .. Str2'Last) := Unit_Name (1 .. Unit_Len);
-         Return_String (Res, Str2);
-      end;
-   end Ghdl_Image_P64;
-
-   procedure Ghdl_Image_P32
-     (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access)
-   is
-      Str : String (1 .. 11);
-      First : Natural;
-      Phys : constant Ghdl_Rtin_Type_Physical_Acc
-        := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
-      Unit_Name : Ghdl_C_String;
-      Unit_Len : Natural;
-   begin
-      To_String (Str, First, Val);
-      Unit_Name := Get_Physical_Unit_Name (Phys.Units (0));
-      Unit_Len := strlen (Unit_Name);
-      declare
-         L : constant Natural := Str'Last + 1 - First;
-         Str2 : String (1 .. L + 1 + Unit_Len);
-      begin
-         Str2 (1 .. L) := Str (First .. Str'Last);
-         Str2 (L + 1) := ' ';
-         Str2 (L + 2 .. Str2'Last) := Unit_Name (1 .. Unit_Len);
-         Return_String (Res, Str2);
-      end;
-   end Ghdl_Image_P32;
-
-   procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64)
-   is
-      Str : String (1 .. 24);
-      P : Natural;
-   begin
-      To_String (Str, P, Val);
-      Return_String (Res, Str (1 .. P));
-   end Ghdl_Image_F64;
-
-   procedure Ghdl_To_String_I32 (Res : Std_String_Ptr; Val : Ghdl_I32)
-     renames Ghdl_Image_I32;
-   procedure Ghdl_To_String_F64 (Res : Std_String_Ptr; Val : Ghdl_F64)
-     renames Ghdl_Image_F64;
-
-   procedure Ghdl_To_String_F64_Digits
-     (Res : Std_String_Ptr; Val : Ghdl_F64; Nbr_Digits : Ghdl_I32)
-   is
-      Str : String_Real_Digits;
-      P : Natural;
-   begin
-      To_String (Str, P, Val, Nbr_Digits);
-      Return_String (Res, Str (1 .. P));
-   end Ghdl_To_String_F64_Digits;
-
-   procedure Ghdl_To_String_F64_Format
-     (Res : Std_String_Ptr; Val : Ghdl_F64; Format : Std_String_Ptr)
-   is
-      C_Format : String (1 .. Positive (Format.Bounds.Dim_1.Length + 1));
-      Str : Grt.Vstrings.String_Real_Format;
-      P : Natural;
-   begin
-      for I in 1 .. C_Format'Last - 1 loop
-         C_Format (I) := Format.Base (Ghdl_Index_Type (I - 1));
-      end loop;
-      C_Format (C_Format'Last) := NUL;
-
-      To_String (Str, P, Val, To_Ghdl_C_String (C_Format'Address));
-      Return_String (Res, Str (1 .. P));
-   end Ghdl_To_String_F64_Format;
-
-   subtype Log_Base_Type is Ghdl_Index_Type range 3 .. 4;
-   Hex_Chars : constant array (Natural range 0 .. 15) of Character :=
-     "0123456789ABCDEF";
-
-   procedure Ghdl_BV_To_String (Res : Std_String_Ptr;
-                                Val : Std_Bit_Vector_Basep;
-                                Len : Ghdl_Index_Type;
-                                Log_Base : Log_Base_Type)
-   is
-      Res_Len : constant Ghdl_Index_Type := (Len + Log_Base - 1) / Log_Base;
-      Pos : Ghdl_Index_Type;
-      V : Natural;
-      Sh : Natural range 0 .. 4;
-   begin
-      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Res_Len));
-      V := 0;
-      Sh := 0;
-      Pos := Res_Len - 1;
-      for I in reverse 1 .. Len loop
-         V := V + Std_Bit'Pos (Val (I - 1)) * (2 ** Sh);
-         Sh := Sh + 1;
-         if Sh = Natural (Log_Base) or else I = 1 then
-            Res.Base (Pos) := Hex_Chars (V);
-            Pos := Pos - 1;
-            Sh := 0;
-            V := 0;
-         end if;
-      end loop;
-      Set_String_Bounds (Res, Res_Len);
-   end Ghdl_BV_To_String;
-
-   procedure Ghdl_BV_To_Ostring (Res : Std_String_Ptr;
-                                 Base : Std_Bit_Vector_Basep;
-                                 Len : Ghdl_Index_Type) is
-   begin
-      Ghdl_BV_To_String (Res, Base, Len, 3);
-   end Ghdl_BV_To_Ostring;
-
-   procedure Ghdl_BV_To_Hstring (Res : Std_String_Ptr;
-                                 Base : Std_Bit_Vector_Basep;
-                                 Len : Ghdl_Index_Type) is
-   begin
-      Ghdl_BV_To_String (Res, Base, Len, 4);
-   end Ghdl_BV_To_Hstring;
-
-   procedure To_String_Enum
-     (Res : Std_String_Ptr; Rti : Ghdl_Rti_Access; Index : Ghdl_Index_Type)
-   is
-      Enum_Rti : Ghdl_Rtin_Type_Enum_Acc;
-      Str : Ghdl_C_String;
-   begin
-      Enum_Rti := To_Ghdl_Rtin_Type_Enum_Acc (Rti);
-      Str := Enum_Rti.Names (Index);
-      if Str (1) = ''' then
-         Return_String (Res, Str (2 .. 2));
-      else
-         Return_String (Res, Str (1 .. strlen (Str)));
-      end if;
-   end To_String_Enum;
-
-   procedure Ghdl_To_String_B1
-     (Res : Std_String_Ptr; Val : Ghdl_B1; Rti : Ghdl_Rti_Access) is
-   begin
-      To_String_Enum (Res, Rti, Ghdl_B1'Pos (Val));
-   end Ghdl_To_String_B1;
-
-   procedure Ghdl_To_String_E8
-     (Res : Std_String_Ptr; Val : Ghdl_E8; Rti : Ghdl_Rti_Access) is
-   begin
-      To_String_Enum (Res, Rti, Ghdl_E8'Pos (Val));
-   end Ghdl_To_String_E8;
-
-   procedure Ghdl_To_String_E32
-     (Res : Std_String_Ptr; Val : Ghdl_E32; Rti : Ghdl_Rti_Access) is
-   begin
-      To_String_Enum (Res, Rti, Ghdl_E32'Pos (Val));
-   end Ghdl_To_String_E32;
-
-   procedure Ghdl_To_String_Char (Res : Std_String_Ptr; Val : Std_Character) is
-   begin
-      Return_String (Res, (1 => Val));
-   end Ghdl_To_String_Char;
-
-   procedure Ghdl_To_String_P32
-     (Res : Std_String_Ptr; Val : Ghdl_I32; Rti : Ghdl_Rti_Access)
-     renames Ghdl_Image_P32;
-
-   procedure Ghdl_To_String_P64
-     (Res : Std_String_Ptr; Val : Ghdl_I64; Rti : Ghdl_Rti_Access)
-     renames Ghdl_Image_P64;
-
-   procedure Ghdl_Time_To_String_Unit
-     (Res : Std_String_Ptr;
-      Val : Std_Time; Unit : Std_Time; Rti : Ghdl_Rti_Access)
-   is
-      Str : Grt.Vstrings.String_Time_Unit;
-      First : Natural;
-      Phys : constant Ghdl_Rtin_Type_Physical_Acc
-        := To_Ghdl_Rtin_Type_Physical_Acc (Rti);
-      Unit_Name : Ghdl_C_String;
-      Unit_Len : Natural;
-   begin
-      Unit_Name := null;
-      for I in 1 .. Phys.Nbr loop
-         if Get_Physical_Unit_Value (Phys.Units (I - 1), Rti) = Ghdl_I64 (Unit)
-         then
-            Unit_Name := Get_Physical_Unit_Name (Phys.Units (I - 1));
-            exit;
-         end if;
-      end loop;
-      if Unit_Name = null then
-         Error ("no unit for to_string");
-      end if;
-      Grt.Vstrings.To_String (Str, First, Ghdl_I64 (Val), Ghdl_I64 (Unit));
-      Unit_Len := strlen (Unit_Name);
-      declare
-         L : constant Natural := Str'Last + 1 - First;
-         Str2 : String (1 .. L + 1 + Unit_Len);
-      begin
-         Str2 (1 .. L) := Str (First .. Str'Last);
-         Str2 (L + 1) := ' ';
-         Str2 (L + 2 .. Str2'Last) := Unit_Name (1 .. Unit_Len);
-         Return_String (Res, Str2);
-      end;
-   end Ghdl_Time_To_String_Unit;
-
-   procedure Ghdl_Array_Char_To_String_B1
-     (Res : Std_String_Ptr;
-      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access)
-   is
-      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
-        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
-      Str : Ghdl_C_String;
-      Arr : constant Ghdl_B1_Array_Base_Ptr := To_Ghdl_B1_Array_Base_Ptr (Val);
-   begin
-      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Len));
-      for I in 1 .. Len loop
-         Str := Enum_Rti.Names (Ghdl_B1'Pos (Arr (I - 1)));
-         Res.Base (I - 1) := Str (2);
-      end loop;
-      Set_String_Bounds (Res, Len);
-   end Ghdl_Array_Char_To_String_B1;
-
-   procedure Ghdl_Array_Char_To_String_E8
-     (Res : Std_String_Ptr;
-      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access)
-   is
-      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
-        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
-      Str : Ghdl_C_String;
-      Arr : constant Ghdl_E8_Array_Base_Ptr := To_Ghdl_E8_Array_Base_Ptr (Val);
-   begin
-      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Len));
-      for I in 1 .. Len loop
-         Str := Enum_Rti.Names (Ghdl_E8'Pos (Arr (I - 1)));
-         Res.Base (I - 1) := Str (2);
-      end loop;
-      Set_String_Bounds (Res, Len);
-   end Ghdl_Array_Char_To_String_E8;
-
-   procedure Ghdl_Array_Char_To_String_E32
-     (Res : Std_String_Ptr;
-      Val : Ghdl_Ptr; Len : Ghdl_Index_Type; Rti : Ghdl_Rti_Access)
-   is
-      Enum_Rti : constant Ghdl_Rtin_Type_Enum_Acc :=
-        To_Ghdl_Rtin_Type_Enum_Acc (Rti);
-      Str : Ghdl_C_String;
-      Arr : constant Ghdl_E32_Array_Base_Ptr :=
-        To_Ghdl_E32_Array_Base_Ptr (Val);
-   begin
-      Res.Base := To_Std_String_Basep (Ghdl_Stack2_Allocate (Len));
-      for I in 1 .. Len loop
-         Str := Enum_Rti.Names (Ghdl_E32'Pos (Arr (I - 1)));
-         Res.Base (I - 1) := Str (2);
-      end loop;
-      Set_String_Bounds (Res, Len);
-   end Ghdl_Array_Char_To_String_E32;
-
---     procedure Ghdl_Image_F64 (Res : Std_String_Ptr; Val : Ghdl_F64)
---     is
---        --  Sign (1) + digit (1) + dot (1) + digits (15) + exp (1) + sign (1)
---        --  + exp_digits (4) -> 24.
---        Str : String (1 .. 25);
-
---        procedure Snprintf_G (Str : System.Address;
---                              Size : Integer;
---                              Arg : Ghdl_F64);
---        pragma Import (C, Snprintf_G, "__ghdl_snprintf_g");
-
---        function strlen (Str : System.Address) return Integer;
---        pragma Import (C, strlen);
---     begin
---        Snprintf_G (Str'Address, Str'Length, Val);
---        Return_String (Res, Str (1 .. strlen (Str'Address)));
---     end Ghdl_Image_F64;
-
-end Grt.Images;