testhal/AVR/GPT

--  GHDL Run Time (GRT) - VPI interface.
--  Copyright (C) 2002 - 2014 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.
pragma Unreferenced (System.Storage_Elements);
with Grt.Stdio; use Grt.Stdio;
with Grt.C; use Grt.C;
with Grt.Signals; use Grt.Signals;
with Grt.Astdio; use Grt.Astdio;
with Grt.Astdio.Vhdl; use Grt.Astdio.Vhdl;
with Grt.Strings; use Grt.Strings;
with Grt.Hooks; use Grt.Hooks;
with Grt.Options;
with Grt.Vcd; use Grt.Vcd;
with Grt.Errors; use Grt.Errors;
with Grt.Rtis_Types;
with Grt.Std_Logic_1164; use Grt.Std_Logic_1164;
with Grt.Callbacks; use Grt.Callbacks;
with Grt.Vstrings; use Grt.Vstrings;

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;

   Product : constant String := "GHDL" & NUL;
   Version : constant String := "0.1" & NUL;

   --  If true, emit traces
   Flag_Trace : Boolean := False;
   Trace_File : FILEs;
   Trace_Indent : Natural := 0;

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

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

   procedure dbgPut (C : Character)
   is
      R : int;
      pragma Unreferenced (R);
   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;

   --  Clear error status.
   procedure Reset_Error;

   procedure Trace_Start (Msg : String) is
   begin
      for I in 1 .. Trace_Indent loop
         Put (Trace_File, ' ');
      end loop;
      Put (Trace_File, Msg);
   end Trace_Start;

   procedure Trace (Msg : String) is
   begin
      Put (Trace_File, Msg);
   end Trace;

   procedure Trace (V : Integer) is
   begin
      Put_I32 (Trace_File, Ghdl_I32 (V));
   end Trace;

   procedure Trace_Cb_Reason (V : Integer) is
   begin
      case V is
         when cbValueChange =>
            Trace ("cbValueChange");
         when cbReadWriteSynch =>
            Trace ("cbReadWriteSynch");
         when cbReadOnlySynch =>
            Trace ("cbReadOnlySynch");
         when cbNextSimTime =>
            Trace ("cbNextSimTime");
         when cbAfterDelay =>
            Trace ("cbAfterDelay");
         when cbEndOfCompile =>
            Trace ("cbEndOfCompile");
         when cbStartOfSimulation =>
            Trace ("cbStartOfSimulation");
         when cbEndOfSimulation =>
            Trace ("cbEndOfSimulation");
         when others =>
            Trace (V);
      end case;
   end Trace_Cb_Reason;

   procedure Trace_Property (V : Integer) is
   begin
      case V is
         when vpiUndefined =>
            Trace ("vpiUndefined");
         when vpiType =>
            Trace ("vpiType");
         when vpiName =>
            Trace ("vpiName");
         when vpiFullName =>
            Trace ("vpiFullName");
         when vpiSize =>
            Trace ("vpiSize");
         when vpiFile =>
            Trace ("vpiFile");
         when vpiLineNo =>
            Trace ("vpiLineNo");

         when vpiDefName =>
            Trace ("vpiDefName");
         when vpiTimePrecision =>
            Trace ("vpiTimePrecision");
         when vpiDefFile =>
            Trace ("vpiDefFile");

         --  Port and net properties

         when vpiScalar =>
            Trace ("vpiScalar");
         when vpiVector =>
            Trace ("vpiVector");

         when vpiModule =>
            Trace ("vpiModule");
         when vpiNet =>
            Trace ("vpiNet");
         when vpiPort =>
            Trace ("vpiPort");
         when vpiParameter =>
            Trace ("vpiParameter");
         when vpiScope =>
            Trace ("vpiScope");
         when vpiInternalScope =>
            Trace ("vpiInternalScope");
         when vpiLeftRange =>
            Trace ("vpiLeftRange");
         when vpiRightRange =>
            Trace ("vpiRightRange");

         when vpiStop =>
            Trace ("vpiStop");
         when vpiFinish =>
            Trace ("vpiFinish");
         when vpiReset =>
            Trace ("vpiReset");

         when others =>
            Trace (V);
      end case;
   end Trace_Property;

   procedure Trace_Format (F : Integer) is
   begin
      case F is
         when vpiBinStrVal =>
            Trace ("BinStr");
         when vpiOctStrVal =>
            Trace ("OctStr");
         when vpiDecStrVal =>
            Trace ("DecStr");
         when vpiHexStrVal =>
            Trace ("HexStr");
         when vpiScalarVal =>
            Trace ("Scalar");
         when vpiIntVal =>
            Trace ("Int");
         when vpiRealVal =>
            Trace ("Real");
         when vpiStringVal =>
            Trace ("String");
         when vpiVectorVal =>
            Trace ("Vector");
         when vpiStrengthVal =>
            Trace ("Strength");
         when vpiTimeVal =>
            Trace ("Time");
         when vpiObjTypeVal =>
            Trace ("ObjType");
         when vpiSuppressVal =>
            Trace ("Suppress");

         when others =>
            Trace (F);
      end case;
   end Trace_Format;

   procedure Trace_Time_Tag (V : Integer) is
   begin
      case V is
         when vpiSimTime =>
            Trace ("vpiSimTime");
         when others =>
            Trace (V);
      end case;
   end Trace_Time_Tag;

   procedure Trace (H : vpiHandle)
   is
      function To_Address is
         new Ada.Unchecked_Conversion (vpiHandle, System.Address);
   begin
      Put (Trace_File, To_Address (H));
   end Trace;

   procedure Trace (Str : Ghdl_C_String) is
   begin
      if Str = null then
         Put (Trace_File, "null");
      else
         Put (Trace_File, '"');
         Put (Trace_File, Str);
         Put (Trace_File, '"');
      end if;
   end Trace;

   procedure Trace_Time (V : Std_Time) is
   begin
      Put_Time (Trace_File, V);
   end Trace_Time;

   procedure Trace_Value (V : p_vpi_value) is
   begin
      case V.Format is
         when vpiBinStrVal
           | vpiOctStrVal
           | vpiDecStrVal
           | vpiHexStrVal
           | vpiStringVal =>
            Trace (V.Str);
         when vpiScalarVal =>
            Trace (V.Scalar);
         when vpiIntVal =>
            Trace (V.Integer_m);
            --when vpiRealVal=>     null; -- what is the equivalent to double?
            --when vpiTimeVal=>     mTime:     p_vpi_time;
            --when vpiVectorVal=>   mVector:   p_vpi_vecval;
            --when vpiStrengthVal=> mStrength: p_vpi_strengthval;
         when others =>
            null;
      end case;
   end Trace_Value;

   procedure Trace_Newline is
   begin
      New_Line (Trace_File);
   end Trace_Newline;

   function Vpi_Time_To_Time (V : s_vpi_time) return Std_Time is
      Res : Std_Time;
   begin
      if V.mType /= vpiSimTime then
         raise Program_Error;
      end if;
      Res := Std_Time (Unsigned_64 (V.mHigh) * 2 ** 32 + Unsigned_64 (V.mLow));
      return Res;
   end Vpi_Time_To_Time;

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

   --  Free an handler, when it was not passed by reference.
   procedure Free_Copy (H : vpiHandle)
   is
      Copy : vpiHandle;
   begin
      Copy := H;
      Free (Copy);
   end Free_Copy;

   ------------------------------------------------------------------------
   -- 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_Internal
     (aType: integer; Ref: vpiHandle) return vpiHandle
   is
      Res : vpiHandle;
      Rel : VhpiOneToManyT;
      Error : AvhpiErrorT;
   begin
      case aType is
         when vpiPort | 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
         Res := null;
      else
         Res := new struct_vpiHandle (aType);
         Vhpi_Iterator (Rel, Ref.Ref, Res.Ref, Error);

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

      return Res;
   end Vpi_Iterate_Internal;

   function vpi_iterate (aType: integer; Ref: vpiHandle) return vpiHandle
   is
      Res : vpiHandle;
   begin
      if Flag_Trace then
         Trace_Start ("vpi_iterate (");
         Trace_Property (aType);
         Trace (", ");
         Trace (Ref);
         Trace (") = ");
      end if;

      Res := Vpi_Iterate_Internal (aType, Ref);

      if Flag_Trace then
         Trace (Res);
         Trace_Newline;
      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_Size (Ref : vpiHandle) return Integer
   is
      Info : Verilog_Wire_Info;
   begin
      Get_Verilog_Wire (Ref.Ref, Info);
      case Info.Vtype is
         when Vcd_Var_Vectors =>
            return Natural (Get_Wire_Length (Info));
         when Vcd_Bool
           | Vcd_Bit
           | Vcd_Stdlogic =>
            return 1;
         when Vcd_Integer32 =>
            return 32;
         when Vcd_Enum8 =>
            return 8;
         when Vcd_Float64 =>
            return 0;
         when Vcd_Bad =>
            return 0;
      end case;
   end Vpi_Get_Size;

   function Vpi_Get_Vector (Ref : vpiHandle) return Boolean
   is
      Info : Verilog_Wire_Info;
   begin
      Get_Verilog_Wire (Ref.Ref, Info);
      case Info.Vtype is
         when Vcd_Bool
           | Vcd_Integer32
           | Vcd_Float64
           | Vcd_Bit
           | Vcd_Stdlogic
           | Vcd_Enum8 =>
            return False;
         when Vcd_Bitvector
           | Vcd_Stdlogic_Vector =>
            return True;
         when Vcd_Bad =>
            return False;
      end case;
   end Vpi_Get_Vector;

   function vpi_get (Property: integer; Ref: vpiHandle) return Integer
   is
      Res : Integer;
   begin
      if Flag_Trace then
         Trace_Start ("vpi_get (");
         Trace_Property (Property);
         Trace (", ");
         Trace (Ref);
         Trace (") = ");
      end if;

      case Property is
         when vpiType =>
            Res := Ref.mType;
         when vpiTimePrecision =>
            Res := -3 * Options.Time_Resolution_Scale;
         when vpiSize =>
            Res := Vpi_Get_Size (Ref);
         when vpiVector =>
            Res := Boolean'Pos (Vpi_Get_Vector (Ref));
         when vpiDirection =>
            case Vhpi_Get_Mode (Ref.Ref) is
               when VhpiInMode =>
                  Res := vpiInput;
               when VhpiOutMode =>
                  Res := vpiOutput;
               when VhpiInoutMode =>
                  Res := vpiInout;
               when others =>
                  Res := vpiNoDirection;
            end case;
         when others =>
            dbgPut_Line ("vpi_get: unknown property");
            Res := 0;
      end case;

      if Flag_Trace then
         case Property is
            when vpiType =>
               Trace_Property (Res);
            when others =>
               Trace (Res);
         end case;
         Trace_Newline;
      end if;

      return Res;
   end vpi_get;

   function Vhpi_Handle_To_Vpi_Prop (Res : VhpiHandleT) return Integer is
   begin
      case Vhpi_Get_Kind (Res) is
         when VhpiEntityDeclK
           | VhpiArchBodyK
           | VhpiBlockStmtK
           | VhpiIfGenerateK
           | VhpiForGenerateK
           | VhpiCompInstStmtK =>
            return vpiModule;
         when VhpiPortDeclK =>
            declare
               Info : Verilog_Wire_Info;
            begin
               Get_Verilog_Wire (Res, Info);
               if Info.Vtype /= Vcd_Bad then
                  return vpiNet;
               end if;
            end;
         when VhpiSigDeclK =>
            declare
               Info : Verilog_Wire_Info;
            begin
               Get_Verilog_Wire (Res, Info);
               if Info.Vtype /= Vcd_Bad then
                  return vpiNet;
               end if;
            end;
         when VhpiGenericDeclK =>
            declare
               Info : Verilog_Wire_Info;
            begin
               Get_Verilog_Wire (Res, Info);
               if Info.Vtype /= Vcd_Bad then
                  return vpiParameter;
               end if;
            end;
         when VhpiConstDeclK =>
            declare
               Info : Verilog_Wire_Info;
            begin
               Get_Verilog_Wire (Res, Info);
               if Info.Vtype /= Vcd_Bad then
                  return vpiConstant;
               end if;
            end;
         when others =>
            null;
      end case;
      return vpiUndefined;
   end Vhpi_Handle_To_Vpi_Prop;

   function Build_vpiHandle (Res : VhpiHandleT; Prop : Integer)
                            return vpiHandle is
   begin
      case Prop is
         when vpiModule =>
            return new struct_vpiHandle'(mType => vpiModule,
                                         Ref => Res);
         when vpiNet =>
            return new struct_vpiHandle'(mType => vpiNet,
                                         Ref => Res);
         when vpiPort =>
            return new struct_vpiHandle'(mType => vpiPort,
                                         Ref => Res);
         when vpiParameter =>
            return new struct_vpiHandle'(mType => vpiParameter,
                                         Ref => Res);
         when vpiConstant =>
            return new struct_vpiHandle'(mType => vpiConstant,
                                         Ref => Res);
         when others =>
            return null;
      end case;
   end Build_vpiHandle;

   ------------------------------------------------------------------------
   -- 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_Internal (Iter: vpiHandle) return vpiHandle
   is
      Res : VhpiHandleT;
      Error : AvhpiErrorT;
      R : vpiHandle;
      Kind, Expected_Kind : Integer;
   begin
      --  End of scan reached.  Avoid a crash in case of misuse.
      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 =>
               --  End of iteration.
               return null;
            when others =>
               --  Fall through.
               null;
         end case;
      end if;

      case Iter.mType is
         when vpiInternalScope
           | vpiModule =>
            Expected_Kind := vpiModule;
         when vpiPort =>
            Expected_Kind := vpiPort;
         when vpiNet =>
            Expected_Kind := vpiNet;
         when others =>
            Expected_Kind := vpiUndefined;
      end case;

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

         Kind := Vhpi_Handle_To_Vpi_Prop (Res);
         if Kind /= vpiUndefined
           and then (Kind = Expected_Kind
                       or(Kind = vpiPort and Expected_Kind = vpiNet))
         then
            return Build_vpiHandle (Res, Kind);
         end if;
      end loop;

      return null;
   end Vpi_Scan_Internal;

   function vpi_scan (Iter: vpiHandle) return vpiHandle
   is
      Res : vpiHandle;
   begin
      if Flag_Trace then
         Trace_Start ("vpi_scan (");
         Trace (Iter);
         Trace (") = ");
      end if;

      Res := Vpi_Scan_Internal (Iter);

      if Flag_Trace then
         Trace (Res);
         Trace_Newline;
      end if;

      --  IEEE 1364-2005 27.5 vpi_free_object()
      --  The iterator object shall automatically be freed when vpi_scan()
      --  returns NULL because it has either completed an object traversal
      --  or encountered an error condition.
      --  Free the iterator.
      if Res = null then
         Free_Copy (Iter);
      end if;

      return Res;
   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_Internal (Property : Integer; Ref : vpiHandle)
                                 return Ghdl_C_String
   is
      Prop : VhpiStrPropertyT;
      Len : Natural;
      Res : Ghdl_C_String;
   begin
      if Ref = null then
         return null;
      end if;

      case Property is
         when vpiFullName =>
            Prop := VhpiFullNameP;
         when vpiName =>
            Prop := VhpiNameP;
         when vpiType =>
            Tmpstring2 (1 .. 4) := "???" & NUL;
            return To_Ghdl_C_String (Tmpstring2'Address);
         when others =>
            dbgPut_Line ("vpi_get_str: unhandled 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 '.'.
         Res := To_Ghdl_C_String (Tmpstring2 (2)'Address);
      else
         Res := To_Ghdl_C_String (Tmpstring2'Address);
      end if;

      return Res;
   end Vpi_Get_Str_Internal;

   function vpi_get_str (Property : Integer; Ref : vpiHandle)
                        return Ghdl_C_String
   is
      Res : Ghdl_C_String;
   begin
      if Flag_Trace then
         Trace_Start ("vpi_get_str (");
         Trace_Property (Property);
         Trace (", ");
         Trace (Ref);
         Trace (") = ");
      end if;

      Res := Vpi_Get_Str_Internal (Property, Ref);

      if Flag_Trace then
         Trace (Res);
         Trace_Newline;
      end if;

      return Res;
   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_Internal
     (aType : Integer; Ref : vpiHandle) return vpiHandle
   is
      Res : vpiHandle;
   begin
      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 vpiPort| 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_Internal;

   function vpi_handle (aType : Integer; Ref : vpiHandle) return vpiHandle
   is
      Res : vpiHandle;
   begin
      if Flag_Trace then
         Trace_Start ("vpi_handle (");
         Trace_Property (aType);
         Trace (", ");
         Trace (Ref);
         Trace (") = ");
      end if;

      Res := Vpi_Handle_Internal (aType, Ref);

      if Flag_Trace then
         Trace (Res);
         Trace_Newline;
      end if;

      return Res;
   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
   Buf_Value : Vstring;

   procedure Append_Bin (V : Ghdl_U64; Ndigits : Natural) is
   begin
      for I in reverse 0 .. Ndigits - 1 loop
         if (Shift_Right (V, I) and 1) /= 0 then
            Append (Buf_Value, '1');
         else
            Append (Buf_Value, '0');
         end if;
      end loop;
   end Append_Bin;

   type Map_Type_E8 is array (Ghdl_E8 range 0..8) of character;
   Map_Std_E8: constant Map_Type_E8 := "UX01ZWLH-";

   type Map_Type_B1 is array (Ghdl_B1) of character;
   Map_Std_B1: constant Map_Type_B1 := "01";

   function ii_vpi_get_value_bin_str (Obj : VhpiHandleT)
                                     return Ghdl_C_String
   is
      function E8_To_Char (Val : Ghdl_E8) return Character is
      begin
         if Val not in Map_Type_E8'range then
            return '?';
         else
            return Map_Std_E8 (Val);
         end if;
      end E8_To_Char;

      Info : Verilog_Wire_Info;
      Len : Ghdl_Index_Type;
   begin
      case Vhpi_Get_Kind (Obj) is
         when VhpiPortDeclK
           | VhpiSigDeclK
           | VhpiGenericDeclK
           | VhpiConstDeclK =>
            null;
         when others =>
            return null;
      end case;

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

      Len := Get_Wire_Length (Info);

      Reset (Buf_Value); -- reset string buffer

      case Info.Vtype is
         when Vcd_Bad
           | Vcd_Float64 =>
            return null;
         when Vcd_Enum8 =>
            declare
               V : Ghdl_E8;
            begin
               V := Verilog_Wire_Val (Info).E8;
               Append_Bin (Ghdl_U64 (V), 8);
            end;
         when Vcd_Integer32 =>
            declare
               V : Ghdl_U32;
            begin
               V := Verilog_Wire_Val (Info).E32;
               Append_Bin (Ghdl_U64 (V), 32);
            end;
         when Vcd_Bit
           | Vcd_Bool =>
            Append (Buf_Value, Map_Std_B1 (Verilog_Wire_Val (Info).B1));
         when Vcd_Bitvector =>
            for J in 0 .. Len - 1 loop
               Append (Buf_Value, Map_Std_B1 (Verilog_Wire_Val (Info, J).B1));
            end loop;
         when Vcd_Stdlogic =>
            Append (Buf_Value, E8_To_Char (Verilog_Wire_Val (Info).E8));
         when Vcd_Stdlogic_Vector =>
            for J in 0 .. Len - 1 loop
               Append (Buf_Value, E8_To_Char (Verilog_Wire_Val (Info, J).E8));
            end loop;
      end case;
      Append (Buf_Value, NUL);
      return Get_C_String (Buf_Value);
   end ii_vpi_get_value_bin_str;

   procedure vpi_get_value (Expr : vpiHandle; Value : p_vpi_value) is
   begin
      if Flag_Trace then
         Trace_Start ("vpi_get_value (");
         Trace (Expr);
         Trace (", {format=");
         Trace_Format (Value.Format);
         Trace ("}) = ");
      end if;

      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");
Mode	Name	Size
-rw-r--r--	Makefile	17758	log stats plain
-rw-r--r--	chconf.h	16161	log stats plain
-rw-r--r--	halconf.h	12271	log stats plain
-rw-r--r--	main.c	1708	log stats plain
-rw-r--r--	mcuconf.h	2317	log stats plain
-rw-r--r--	readme.txt	799	log stats plain