Move files and dirs from translate/

1 files changed, 118 insertions, 0 deletions

diff --git a/src/grt/grt-rtis_types.adb b/src/grt/grt-rtis_types.adb
new file mode 100644
index 000000000..f22a309bc
--- /dev/null
+++ b/src/grt/grt-rtis_types.adb
@@ -0,0 +1,118 @@
+--  GHDL Run Time (GRT) -  Well known RTI types.
+--  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 Grt.Astdio;
+with Grt.Avhpi; use Grt.Avhpi;
+
+package body Grt.Rtis_Types is
+
+   procedure Avhpi_Error (Err : AvhpiErrorT)
+   is
+      use Grt.Astdio;
+      pragma Unreferenced (Err);
+   begin
+      Put_Line ("grt.rtis_utils.Avhpi_Error!");
+   end Avhpi_Error;
+
+   --  Extract std_ulogic type.
+   procedure Search_Types (Pack : VhpiHandleT)
+   is
+      Decl_It : VhpiHandleT;
+      Decl : VhpiHandleT;
+
+      Error : AvhpiErrorT;
+      Name : String (1 .. 16);
+      Name_Len : Natural;
+      Rti : Ghdl_Rti_Access;
+   begin
+      Vhpi_Get_Str (VhpiLibLogicalNameP, Pack, Name, Name_Len);
+      if not (Name_Len = 4 and then Name (1 .. 4)= "ieee") then
+         return;
+      end if;
+
+      Vhpi_Iterator (VhpiDecls, Pack, Decl_It, Error);
+      if Error /= AvhpiErrorOk then
+         Avhpi_Error (Error);
+         return;
+      end if;
+
+      --  Extract packages.
+      loop
+         Vhpi_Scan (Decl_It, Decl, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         if Vhpi_Get_Kind (Decl) = VhpiEnumTypeDeclK then
+            Vhpi_Get_Str (VhpiNameP, Decl, Name, Name_Len);
+            Rti := Avhpi_Get_Rti (Decl);
+            if Name_Len = 10 and then Name (1 .. 10) = "std_ulogic" then
+               Ieee_Std_Logic_1164_Std_Ulogic_RTI_Ptr := Rti;
+            end if;
+         end if;
+      end loop;
+   end Search_Types;
+
+   procedure Search_Packages
+   is
+      Pack : VhpiHandleT;
+      Pack_It : VhpiHandleT;
+
+      Error : AvhpiErrorT;
+      Name : String (1 .. 16);
+      Name_Len : Natural;
+   begin
+      Get_Package_Inst (Pack_It);
+
+      --  Extract packages.
+      loop
+         Vhpi_Scan (Pack_It, Pack, Error);
+         exit when Error = AvhpiErrorIteratorEnd;
+         if Error /= AvhpiErrorOk then
+            Avhpi_Error (Error);
+            return;
+         end if;
+
+         Vhpi_Get_Str (VhpiNameP, Pack, Name, Name_Len);
+         if Name_Len = 14 and then Name (1 .. 14) = "std_logic_1164" then
+            Search_Types (Pack);
+         end if;
+      end loop;
+   end Search_Packages;
+
+   Search_Types_RTI_Done : Boolean := False;
+
+   procedure Search_Types_RTI is
+   begin
+      if Search_Types_RTI_Done then
+         return;
+      else
+         Search_Types_RTI_Done := True;
+      end if;
+
+      Search_Packages;
+   end Search_Types_RTI;
+end Grt.Rtis_Types;