grt-vpi.adb

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

--  GHDL Run Time (GRT) - VPI interface.
--  Copyright (C) 2002, 2003, 2004, 2005 Tristan Gingold & Felix Bertram
--
--  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.

-- Description: VPI interface for GRT runtime
--              the main purpose of this code is to interface with the
--              Icarus Verilog Interactive (IVI) simulator GUI

-------------------------------------------------------------------------------
-- TODO:
-------------------------------------------------------------------------------
-- DONE:
-- * The GHDL VPI implementation doesn't support time
--   callbacks (cbReadOnlySynch). This is needed to support
--   IVI run. Currently, the GHDL simulation runs until
--   complete once a single 'run' is performed...
-- * You are loading '_'-prefixed symbols when you
--   load the vpi plugin. On Linux, there is no leading
--   '_'. I just added code to try both '_'-prefixed and
--   non-'_'-prefixed symbols. I have placed the changed
--   file in the same download dir as the snapshot
-- * I did find out why restart doesn't work for GHDL.
--   You are passing back the leaf name of signals when the
--   FullName is requested.
-------------------------------------------------------------------------------

with Ada.Unchecked_Deallocation;
with System.Storage_Elements; --  Work around GNAT bug.
with Grt.Stdio; use Grt.Stdio;
with Grt.C; use Grt.C;
with Grt.Signals; use Grt.Signals;
with GNAT.Table;
with Grt.Astdio; use Grt.Astdio;
with Grt.Hooks; use Grt.Hooks;
with Grt.Vcd; use Grt.Vcd;
with Grt.Errors; use Grt.Errors;

package body Grt.Vpi is
   --  The VPI interface requires libdl (dlopen, dlsym) to be linked in.
   --  This is now set in Makefile, since this is target dependent.
   --  pragma Linker_Options ("-ldl");

   --errAnyString:     constant String := "grt-vcd.adb: any string" & NUL;
   --errNoString:      constant String := "grt-vcd.adb: no string" & NUL;

   type Vpi_Index_Type is new Natural;

-------------------------------------------------------------------------------
-- * * *   h e l p e r s   * * * * * * * * * * * * * * * * * * * * * * * * * *
-------------------------------------------------------------------------------

   ------------------------------------------------------------------------
   -- debugging helpers
   procedure dbgPut (Str : String)
   is
      S : size_t;
   begin
      S := fwrite (Str'Address, Str'Length, 1, stderr);
   end dbgPut;

   procedure dbgPut (C : Character)
   is
      R : int;
   begin
      R := fputc (Character'Pos (C), stderr);
   end dbgPut;

   procedure dbgNew_Line is
   begin
      dbgPut (Nl);
   end dbgNew_Line;

   procedure dbgPut_Line (Str : String)
   is
   begin
      dbgPut (Str);
      dbgNew_Line;
   end dbgPut_Line;

--    procedure dbgPut_Line (Str : Ghdl_Str_Len_Type)
--    is
--    begin
--       Put_Str_Len(stderr, Str);
--       dbgNew_Line;
--    end dbgPut_Line;

   procedure Free is new Ada.Unchecked_Deallocation
     (Name => vpiHandle, Object => struct_vpiHandle);

   ------------------------------------------------------------------------
   -- NUL-terminate strings.
   -- note: there are several buffers
   -- see IEEE 1364-2001
--   tmpstring1: string(1..1024);
--    function NulTerminate1 (Str : Ghdl_Str_Len_Type) return Ghdl_C_String
--    is
--    begin
--       for i in 1..Str.Len loop
--          tmpstring1(i):= Str.Str(i);
--       end loop;
--       tmpstring1(Str.Len+1):= NUL;
--       return To_Ghdl_C_String (tmpstring1'Address);
--    end NulTerminate1;

-------------------------------------------------------------------------------
-- * * *   V P I   f u n c t i o n s   * * * * * * * * * * * * * * * * * * * *
-------------------------------------------------------------------------------

   ------------------------------------------------------------------------
   -- vpiHandle  vpi_iterate(int type, vpiHandle ref)
   -- Obtain an iterator handle to objects with a one-to-many relationship.
   -- see IEEE 1364-2001, page 685
   function vpi_iterate (aType: integer; Ref: vpiHandle) return vpiHandle
   is
      Res : vpiHandle;
      Rel : VhpiOneToManyT;
      Error : AvhpiErrorT;
   begin
      --dbgPut_Line ("vpi_iterate");

      case aType is
         when vpiNet =>
            Rel := VhpiDecls;
         when vpiModule =>
            if Ref = null then
               Res := new struct_vpiHandle (vpiModule);
               Get_Root_Inst (Res.Ref);
               return Res;
            else
               Rel := VhpiInternalRegions;
            end if;
         when vpiInternalScope =>
            Rel := VhpiInternalRegions;
         when others =>
            return null;
      end case;

      -- find the proper start object for our scan
      if Ref = null then
         return null;
      end if;

      Res := new struct_vpiHandle (aType);
      Vhpi_Iterator (Rel, Ref.Ref, Res.Ref, Error);

      if Error /= AvhpiErrorOk then
         Free (Res);
      end if;
      return Res;
   end vpi_iterate;

   ------------------------------------------------------------------------
   -- int vpi_get(int property, vpiHandle ref)
   -- Get the value of an integer or boolean property of an object.
   -- see IEEE 1364-2001, chapter 27.6, page 667
--    function ii_vpi_get_type (aRef: Ghdl_Instance_Name_Acc) return Integer
--    is
--    begin
--       case aRef.Kind is
--          when Ghdl_Name_Entity
--            | Ghdl_Name_Architecture
--            | Ghdl_Name_Block
--            | Ghdl_Name_Generate_Iterative
--            | Ghdl_Name_Generate_Conditional
--            | Ghdl_Name_Instance =>
--             return vpiModule;
--          when Ghdl_Name_Signal =>
--             return vpiNet;
--          when others =>
--             return vpiUndefined;
--       end case;
--    end ii_vpi_get_type;

   function vpi_get (Property: integer; Ref: vpiHandle) return Integer
   is
   begin
      case Property is
         when vpiType=>
            return Ref.mType;
         when vpiTimePrecision=>
            return -9; -- is this nano-seconds?
         when others=>
            dbgPut_Line ("vpi_get: unknown property");
            return 0;
      end case;
   end vpi_get;

   ------------------------------------------------------------------------
   -- vpiHandle  vpi_scan(vpiHandle iter)
   -- Scan the Verilog HDL hierarchy for objects with a one-to-many
   -- relationship.
   -- see IEEE 1364-2001, chapter 27.36, page 709
   function vpi_scan (Iter: vpiHandle) return vpiHandle
   is
      Res : VhpiHandleT;
      Error : AvhpiErrorT;
      R : vpiHandle;
   begin
      --dbgPut_Line ("vpi_scan");
      if Iter = null then
         return null;
      end if;

      --  There is only one top-level module.
      if Iter.mType = vpiModule then
         case Vhpi_Get_Kind (Iter.Ref) is
            when VhpiRootInstK =>
               R := new struct_vpiHandle (Iter.mType);
               R.Ref := Iter.Ref;
               Iter.Ref := Null_Handle;
               return R;
            when VhpiUndefined =>
               return null;
            when others =>
               --  Fall through.
               null;
         end case;
      end if;

      loop
         Vhpi_Scan (Iter.Ref, Res, Error);
         exit when Error /= AvhpiErrorOk;

         case Vhpi_Get_Kind (Res) is
            when VhpiEntityDeclK
              | VhpiArchBodyK
              | VhpiBlockStmtK
              | VhpiIfGenerateK
              | VhpiForGenerateK
              | VhpiCompInstStmtK =>
               case Iter.mType is
                  when vpiInternalScope
                    | vpiModule =>
                     return new struct_vpiHandle'(mType => vpiModule,
                                                  Ref => Res);
                  when others =>
                     null;
               end case;
            when VhpiPortDeclK
              | VhpiSigDeclK =>
               if Iter.mType = vpiNet then
                  declare
                     Info : Verilog_Wire_Info;
                  begin
                     Get_Verilog_Wire (Res, Info);
                     if Info.Kind /= Vcd_Bad then
                        return new struct_vpiHandle'(mType => vpiNet,
                                                     Ref => Res);
                     end if;
                  end;
               end if;
            when others =>
               null;
         end case;
      end loop;
      return null;
   end vpi_scan;

   ------------------------------------------------------------------------
   -- char *vpi_get_str(int property, vpiHandle ref)
   -- see IEEE 1364-2001, page xxx
   Tmpstring2 : String (1 .. 1024);
   function vpi_get_str (Property : Integer; Ref : vpiHandle)
                        return Ghdl_C_String
   is
      Prop : VhpiStrPropertyT;
      Len : Natural;
   begin
      --dbgPut_Line ("vpiGetStr");

      if Ref = null then
         return null;
      end if;

      case Property is
         when vpiFullName=>
            Prop := VhpiFullNameP;
         when vpiName=>
            Prop := VhpiNameP;
         when others=>
            dbgPut_Line ("vpi_get_str: undefined property");
            return null;
      end case;
      Vhpi_Get_Str (Prop, Ref.Ref, Tmpstring2, Len);
      Tmpstring2 (Len + 1) := NUL;
      if Property = vpiFullName then
         for I in Tmpstring2'First .. Len loop
            if Tmpstring2 (I) = ':' then
               Tmpstring2 (I) := '.';
            end if;
         end loop;
         --  Remove the initial '.'.
         return To_Ghdl_C_String (Tmpstring2 (2)'Address);
      else
         return To_Ghdl_C_String (Tmpstring2'Address);
      end if;
   end vpi_get_str;

   ------------------------------------------------------------------------
   -- vpiHandle  vpi_handle(int type, vpiHandle ref)
   -- Obtain a handle to an object with a one-to-one relationship.
   -- see IEEE 1364-2001, chapter 27.16, page 682
   function vpi_handle (aType : Integer; Ref : vpiHandle) return vpiHandle
   is
      Res : vpiHandle;
   begin
      --dbgPut_Line ("vpi_handle");

      if Ref = null then
         return null;
      end if;

      case aType is
         when vpiScope =>
            case Ref.mType is
               when vpiModule =>
                  Res := new struct_vpiHandle (vpiScope);
                  Res.Ref := Ref.Ref;
                  return Res;
               when others =>
                  return null;
            end case;
         when vpiRightRange
           | vpiLeftRange =>
            case Ref.mType is
               when vpiNet =>
                  Res := new struct_vpiHandle (aType);
                  Res.Ref := Ref.Ref;
                  return Res;
               when others =>
                  return null;
            end case;
         when others =>
            return null;
      end case;
   end vpi_handle;

   ------------------------------------------------------------------------
   -- void  vpi_get_value(vpiHandle expr, p_vpi_value value);
   -- Retrieve the simulation value of an object.
   -- see IEEE 1364-2001, chapter 27.14, page 675
   Tmpstring3idx : integer;
   Tmpstring3 : String (1 .. 1024);
   procedure ii_vpi_get_value_bin_str_B2 (Val : Ghdl_B2)
   is
   begin
      case Val is
         when True =>
            Tmpstring3 (Tmpstring3idx) := '1';
         when False =>
            Tmpstring3 (Tmpstring3idx) := '0';
      end case;
      Tmpstring3idx := Tmpstring3idx + 1;
   end ii_vpi_get_value_bin_str_B2;

   procedure ii_vpi_get_value_bin_str_E8 (Val : Ghdl_E8)
   is
      type Map_Type_E8 is array (Ghdl_E8 range 0..8) of character;
      Map_Std_E8: constant Map_Type_E8 := "UX01ZWLH-";
   begin
      if Val not in Map_Type_E8'range then
         Tmpstring3 (Tmpstring3idx) := '?';
      else
         Tmpstring3 (Tmpstring3idx) := Map_Std_E8(Val);
      end if;
      Tmpstring3idx := Tmpstring3idx + 1;
   end ii_vpi_get_value_bin_str_E8;

   function ii_vpi_get_value_bin_str (Obj : VhpiHandleT)
                                     return Ghdl_C_String
   is
      Info : Verilog_Wire_Info;
      Len : Ghdl_Index_Type;
   begin
      case Vhpi_Get_Kind (Obj) is
         when VhpiPortDeclK
           | VhpiSigDeclK =>
            null;
         when others =>
            return null;
      end case;

      --  Get verilog compat info.
      Get_Verilog_Wire (Obj, Info);
      if Info.Kind = Vcd_Bad then
         return null;
      end if;