grt-rtis_types.adb

vhdl集成电路设计软件.需要用gcc-4.0.2版本编译.

--  GHDL Run Time (GRT) -  Well known RTI types.
--  Copyright (C) 2002, 2003, 2004, 2005 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.
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;