grt-vpi.adb

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

      if Info.Irange = null then
         Len := 1;
      else
         Len := Info.Irange.I32.Len;
      end if;

      Tmpstring3idx := 1; -- reset string buffer

      case Info.Val is
         when Vcd_Effective =>
            case Info.Kind is
               when Vcd_Bad
                 | Vcd_Integer32 =>
                  return null;
               when Vcd_Bit
                 | Vcd_Bool
                 | Vcd_Bitvector =>
                  for J in 0 .. Len - 1 loop
                     ii_vpi_get_value_bin_str_B2
                       (To_Signal_Arr_Ptr (Info.Addr)(J).Value.B2);
                  end loop;
               when Vcd_Stdlogic
                 | Vcd_Stdlogic_Vector =>
                  for J in 0 .. Len - 1 loop
                     ii_vpi_get_value_bin_str_E8
                       (To_Signal_Arr_Ptr (Info.Addr)(J).Value.E8);
                  end loop;
            end case;
         when Vcd_Driving =>
            case Info.Kind is
               when Vcd_Bad
                 | Vcd_Integer32 =>
                  return null;
               when Vcd_Bit
                 | Vcd_Bool
                 | Vcd_Bitvector =>
                  for J in 0 .. Len - 1 loop
                     ii_vpi_get_value_bin_str_B2
                       (To_Signal_Arr_Ptr (Info.Addr)(J).Driving_Value.B2);
                  end loop;
               when Vcd_Stdlogic
                 | Vcd_Stdlogic_Vector =>
                  for J in 0 .. Len - 1 loop
                     ii_vpi_get_value_bin_str_E8
                       (To_Signal_Arr_Ptr (Info.Addr)(J).Driving_Value.E8);
                  end loop;
            end case;
      end case;
      Tmpstring3 (Tmpstring3idx) := NUL;
      return To_Ghdl_C_String (Tmpstring3'Address);
   end ii_vpi_get_value_bin_str;

   procedure vpi_get_value (Expr : vpiHandle; Value : p_vpi_value)
   is
   begin
      case Value.Format is
         when vpiObjTypeVal=>
            -- fill in the object type and value:
            -- For an integer, vpiIntVal
            -- For a real, vpiRealVal
            -- For a scalar, either vpiScalar or vpiStrength
            -- For a time variable, vpiTimeVal with vpiSimTime
            -- For a vector, vpiVectorVal
            dbgPut_Line ("vpi_get_value: vpiObjTypeVal");
         when vpiBinStrVal=>
            Value.Str := ii_vpi_get_value_bin_str (Expr.Ref);
            --aValue.mStr := NulTerminate2(aExpr.mRef.Name.all);
         when vpiOctStrVal=>
            dbgPut_Line("vpi_get_value: vpiNet, vpiOctStrVal");
         when vpiDecStrVal=>
            dbgPut_Line("vpi_get_value: vpiNet, vpiDecStrVal");
         when vpiHexStrVal=>
            dbgPut_Line("vpi_get_value: vpiNet, vpiHexStrVal");
         when vpiScalarVal=>
            dbgPut_Line("vpi_get_value: vpiNet, vpiScalarVal");
         when vpiIntVal=>
            case Expr.mType is
               when vpiLeftRange
                 | vpiRightRange=>
                  declare
                     Info : Verilog_Wire_Info;
                  begin
                     Get_Verilog_Wire (Expr.Ref, Info);
                     if Info.Irange /= null then
                        if Expr.mType = vpiLeftRange then
                           Value.Integer_m := Integer (Info.Irange.I32.Left);
                        else
                           Value.Integer_m := Integer (Info.Irange.I32.Right);
                        end if;
                     else
                        Value.Integer_m  := 0;
                     end if;
                  end;
               when others=>
                  dbgPut_Line ("vpi_get_value: vpiIntVal, unknown mType");
            end case;
         when vpiRealVal=>     dbgPut_Line("vpi_get_value: vpiRealVal");
         when vpiStringVal=>   dbgPut_Line("vpi_get_value: vpiStringVal");
         when vpiTimeVal=>     dbgPut_Line("vpi_get_value: vpiTimeVal");
         when vpiVectorVal=>   dbgPut_Line("vpi_get_value: vpiVectorVal");
         when vpiStrengthVal=> dbgPut_Line("vpi_get_value: vpiStrengthVal");
         when others=>         dbgPut_Line("vpi_get_value: unknown mFormat");
      end case;
   end vpi_get_value;

   ------------------------------------------------------------------------
   -- void  vpi_get_time(vpiHandle obj, s_vpi_time*t);
   -- see IEEE 1364-2001, page xxx
   Sim_Time : Std_Time;
   procedure vpi_get_time (Obj: vpiHandle; Time: p_vpi_time)
   is
      pragma Unreferenced (Obj);
   begin
      --dbgPut_Line ("vpi_get_time");
      Time.mType := vpiSimTime;
      Time.mHigh := 0;
      Time.mLow  := Integer (Sim_Time / 1000000);
      Time.mReal := 0.0;
   end vpi_get_time;

   ------------------------------------------------------------------------
   -- vpiHandle vpi_register_cb(p_cb_data data)
   g_cbEndOfCompile : p_cb_data;
   g_cbEndOfSimulation: p_cb_data;
   --g_cbValueChange:     s_cb_data;
   g_cbReadOnlySync:    p_cb_data;

   type Vpi_Var_Type is record
      Info : Verilog_Wire_Info;
      Cb   : s_cb_data;
   end record;

   package Vpi_Table is new GNAT.Table
     (Table_Component_Type => Vpi_Var_Type,
      Table_Index_Type     => Vpi_Index_Type,
      Table_Low_Bound      => 0,
      Table_Initial        => 32,
      Table_Increment      => 100);

   function vpi_register_cb (Data : p_cb_data) return vpiHandle
   is
      Res : p_cb_data := null;
   begin
      --dbgPut_Line ("vpi_register_cb");
      case Data.Reason is
         when cbEndOfCompile =>
            Res := new s_cb_data'(Data.all);
            g_cbEndOfCompile := Res;
            Sim_Time:= 0;
         when cbEndOfSimulation =>
            Res := new s_cb_data'(Data.all);
            g_cbEndOfSimulation := Res;
         when cbValueChange =>
            declare
               N : Vpi_Index_Type;
            begin
               --g_cbValueChange:=     aData.all;
               Vpi_Table.Increment_Last;
               N := Vpi_Table.Last;
               Vpi_Table.Table (N).Cb := Data.all;
               Get_Verilog_Wire (Data.Obj.Ref, Vpi_Table.Table (N).Info);
            end;
         when cbReadOnlySynch=>
            Res := new s_cb_data'(Data.all);
            g_cbReadOnlySync := Res;
         when others=>
            dbgPut_Line ("vpi_register_cb: unknwon reason");
      end case;
      if Res /= null then
         return new struct_vpiHandle'(mType => vpiCallback,
                                      Cb => Res);
      else
         return null;
      end if;
   end vpi_register_cb;

-------------------------------------------------------------------------------
-- * * *   V P I   d u m m i e s   * * * * * * * * * * * * * * * * * * * * * *
-------------------------------------------------------------------------------

   -- int vpi_free_object(vpiHandle ref)
   function vpi_free_object (aRef: vpiHandle) return integer
   is
      pragma Unreferenced (aRef);
   begin
      return 0;
   end vpi_free_object;

   -- int vpi_get_vlog_info(p_vpi_vlog_info vlog_info_p)
   function vpi_get_vlog_info (aVlog_info_p: System.Address) return integer
   is
      pragma Unreferenced (aVlog_info_p);
   begin
      return 0;
   end vpi_get_vlog_info;

   -- vpiHandle vpi_handle_by_index(vpiHandle ref, int index)
   function vpi_handle_by_index(aRef: vpiHandle; aIndex: integer)
                               return vpiHandle
   is
      pragma Unreferenced (aRef);
      pragma Unreferenced (aIndex);
   begin
      return null;
   end vpi_handle_by_index;

   -- unsigned int vpi_mcd_close(unsigned int mcd)
   function vpi_mcd_close (Mcd: integer) return integer
   is
      pragma Unreferenced (Mcd);
   begin
      return 0;
   end vpi_mcd_close;

   -- char *vpi_mcd_name(unsigned int mcd)
   function vpi_mcd_name (Mcd: integer) return integer
   is
      pragma Unreferenced (Mcd);
   begin
      return 0;
   end vpi_mcd_name;

   -- unsigned int vpi_mcd_open(char *name)
   function vpi_mcd_open (Name : Ghdl_C_String) return Integer
   is
      pragma Unreferenced (Name);
   begin
      return 0;
   end vpi_mcd_open;

   -- vpiHandle vpi_put_value(vpiHandle obj, p_vpi_value value,
   --                         p_vpi_time when, int flags)
   function vpi_put_value (aObj: vpiHandle;
                           aValue: p_vpi_value;
                           aWhen: p_vpi_time;
                           aFlags: integer)
                         return vpiHandle
   is
      pragma Unreferenced (aObj);
      pragma Unreferenced (aValue);
      pragma Unreferenced (aWhen);
      pragma Unreferenced (aFlags);
   begin
      return null;
   end vpi_put_value;

   -- void vpi_register_systf(const struct t_vpi_systf_data*ss)
   procedure vpi_register_systf(aSs: System.Address)
   is
      pragma Unreferenced (aSs);
   begin
      null;
   end vpi_register_systf;

   -- int vpi_remove_cb(vpiHandle ref)
   function vpi_remove_cb (Ref : vpiHandle) return Integer
   is
      pragma Unreferenced (Ref);
   begin
      return 0;
   end vpi_remove_cb;

   -- void vpi_vprintf(const char*fmt, va_list ap)
   procedure vpi_vprintf (Fmt : Address; Ap : Address)
   is
      pragma Unreferenced (Fmt);
      pragma Unreferenced (Ap);
   begin
      null;
   end vpi_vprintf;

   -- missing here, see grt-cvpi.c:
   --    vpi_mcd_open_x
   --    vpi_mcd_vprintf
   --    vpi_mcd_fputc
   --    vpi_mcd_fgetc
   --    vpi_sim_vcontrol
   --    vpi_chk_error
   --    pi_handle_by_name

------------------------------------------------------------------------------
-- * * *   G H D L   h o o k s   * * * * * * * * * * * * * * * * * * * * * * *
------------------------------------------------------------------------------

   --  VCD filename.
   Vpi_Filename : String_Access := null;

   ------------------------------------------------------------------------
   --  Return TRUE if OPT is an option for VPI.
   function Vpi_Option (Opt : String) return Boolean
   is
      F : Natural := Opt'First;
   begin
      if Opt'Length < 5 or else Opt (F .. F + 4) /= "--vpi" then
         return False;
      end if;
      if Opt'Length > 6 and then Opt (F + 5) = '=' then
         --  Add an extra NUL character.
         Vpi_Filename := new String (1 .. Opt'Length - 6 + 1);
         Vpi_Filename (1 .. Opt'Length - 6) := Opt (F + 6 .. Opt'Last);
         Vpi_Filename (Vpi_Filename'Last) := NUL;
         return True;
      else
         return False;
      end if;
   end Vpi_Option;

   ------------------------------------------------------------------------
   procedure Vpi_Help is
   begin
      Put_Line (" --vpi=FILENAME     load VPI module");
   end Vpi_Help;

   ------------------------------------------------------------------------
   --  Called before elaboration.

   -- void loadVpiModule(const char* modulename)
   function LoadVpiModule (Filename: Address) return Integer;
   pragma Import (C, LoadVpiModule, "loadVpiModule");


   procedure Vpi_Init
   is
   begin
      Sim_Time:= 0;

      --g_cbEndOfCompile.mCb_rtn:= null;
      --g_cbEndOfSimulation.mCb_rtn:= null;
      --g_cbValueChange.mCb_rtn:= null;

      if Vpi_Filename /= null then
         if LoadVpiModule (Vpi_Filename.all'Address) /= 0 then
            Error ("cannot load VPI module");
         end if;
      end if;
   end Vpi_Init;

   procedure Vpi_Cycle;

   ------------------------------------------------------------------------
   --  Called after elaboration.
   procedure Vpi_Start
   is
      Res : Integer;
   begin
      if g_cbEndOfCompile /= null then
         Res := g_cbEndOfCompile.Cb_Rtn.all (g_cbEndOfCompile);
      end if;
      if Vpi_Filename /= null then
         Register_Cycle_Hook (Vpi_Cycle'Access);
      end if;
   end Vpi_Start;

   ------------------------------------------------------------------------
   --  Called before each non delta cycle.
   procedure Vpi_Cycle
   is
      Res : Integer;
   begin
      if g_cbReadOnlySync /= null
        and then g_cbReadOnlySync.Time.mLow < Integer (Sim_Time / 1_000_000)
      then
         Res := g_cbReadOnlySync.Cb_Rtn.all (g_cbReadOnlySync);
      end if;

      for I in Vpi_Table.First .. Vpi_Table.Last loop
         if Verilog_Wire_Changed (Vpi_Table.Table (I).Info, Sim_Time) then
            Res := Vpi_Table.Table (I).Cb.Cb_Rtn.all
              (To_p_cb_data (Vpi_Table.Table (I).Cb'Address));
         end if;
      end loop;

      if Current_Time /= Std_Time'last then
         Sim_Time:= Current_Time;
      end if;
   end Vpi_Cycle;

   ------------------------------------------------------------------------
   --  Called at the end of the simulation.
   procedure Vpi_End
   is
      Res : Integer;
   begin
      if g_cbEndOfSimulation /= null then
         Res := g_cbEndOfSimulation.Cb_Rtn.all (g_cbEndOfSimulation);
      end if;
   end Vpi_End;

   Vpi_Hooks : aliased constant Hooks_Type :=
     (Option => Vpi_Option'Access,
      Help => Vpi_Help'Access,
      Init => Vpi_Init'Access,
      Start => Vpi_Start'Access,
      Finish => Vpi_End'Access);

   procedure Register is
   begin
      Register_Hooks (Vpi_Hooks'Access);
   end Register;
end Grt.Vpi;