Constants in vpi (#1297)

* Adding some very basic vpi tests.

* Modify test so that's it's checking VPI access to constants.

* Provide VPI to access constants.

* Add vpi tests to testsuite.

* Fix bug to allow getting values of generic/constant boolean and std_logic.

* Fix stupid copying mistake in last commit.

* Formatting and trying to get tests working on windows.

* Fixing comment and removing redundant VhpiConstantDeclK

4 files changed, 47 insertions, 13 deletions

diff --git a/src/grt/grt-avhpi.adb b/src/grt/grt-avhpi.adb
index 374dcc3a6..5e234b9c7 100644
--- a/src/grt/grt-avhpi.adb
+++ b/src/grt/grt-avhpi.adb
@@ -126,7 +126,8 @@ package body Grt.Avhpi is
             end case;
          when VhpiIndexedNames =>
             case Ref.Kind is
-               when VhpiGenericDeclK =>
+               when VhpiGenericDeclK |
+                    VhpiConstDeclK=>
                   Res := (Kind => AvhpiNameIteratorK,
                           Ctxt => Ref.Ctxt,
                           N_Addr => Avhpi_Get_Address (Ref),
@@ -184,7 +185,8 @@ package body Grt.Avhpi is
       El_Type1 : Ghdl_Rti_Access;
    begin
       case Obj_Rti.Common.Kind is
-         when Ghdl_Rtik_Generic =>
+         when Ghdl_Rtik_Generic |
+              Ghdl_Rtik_Constant =>
             Is_Sig := False;
          when others =>
             Internal_Error ("add_index");
@@ -391,6 +393,10 @@ package body Grt.Avhpi is
             Res := (Kind => VhpiGenericDeclK,
                     Ctxt => Ctxt,
                     Obj => To_Ghdl_Rtin_Object_Acc (Rti));
+         when Ghdl_Rtik_Constant =>
+            Res := (Kind => VhpiConstDeclK,
+                    Ctxt => Ctxt,
+                    Obj => To_Ghdl_Rtin_Object_Acc (Rti));
          when Ghdl_Rtik_Subtype_Array =>
             declare
                Atype : constant Ghdl_Rtin_Subtype_Composite_Acc :=
@@ -480,6 +486,7 @@ package body Grt.Avhpi is
             case Ch.Kind is
                when Ghdl_Rtik_Port
                  | Ghdl_Rtik_Generic
+                 | Ghdl_Rtik_Constant
                  | Ghdl_Rtik_Signal
                  | Ghdl_Rtik_Type_Array
                  | Ghdl_Rtik_Subtype_Array
@@ -599,7 +606,8 @@ package body Grt.Avhpi is
             return Obj.Inst.Name;
          when VhpiSigDeclK
            | VhpiPortDeclK
-           | VhpiGenericDeclK =>
+           | VhpiGenericDeclK
+           | VhpiConstDeclK =>
             return Obj.Obj.Name;
          when VhpiSubtypeDeclK =>
             return To_Ghdl_Rtin_Subtype_Scalar_Acc (Obj.Atype).Name;
@@ -715,7 +723,8 @@ package body Grt.Avhpi is
                   Add (Obj.Inst.Name);
                when VhpiSigDeclK
                  | VhpiPortDeclK
-                 | VhpiGenericDeclK =>
+                 | VhpiGenericDeclK
+                 | VhpiConstDeclK =>
                   Add (Obj.Obj.Name);
                when VhpiIfGenerateK =>
                   Add (To_Ghdl_Rtin_Generate_Acc
@@ -937,7 +946,8 @@ package body Grt.Avhpi is
                     | VhpiSubtypeDeclK
                     | VhpiArrayTypeDeclK =>
                      Atype := Ref.Atype;
-                  when VhpiGenericDeclK =>
+                  when VhpiGenericDeclK
+                    | VhpiConstDeclK =>
                      Atype := Ref.Obj.Obj_Type;
                   when VhpiIndexedNameK =>
                      Atype := Ref.N_Type;
@@ -1130,7 +1140,8 @@ package body Grt.Avhpi is
                case Obj.Kind is
                   when VhpiSigDeclK
                     | VhpiPortDeclK
-                    | VhpiGenericDeclK =>
+                    | VhpiGenericDeclK
+                    | VhpiConstDeclK =>
                      --  Objects.
                      Linecol := Obj.Obj.Linecol;
                   when VhpiPackInstK
@@ -1230,7 +1241,8 @@ package body Grt.Avhpi is
             return Obj.Atype;
          when VhpiSigDeclK
            | VhpiPortDeclK
-           | VhpiGenericDeclK =>
+           | VhpiGenericDeclK
+           | VhpiConstDeclK =>
             return To_Ghdl_Rti_Access (Obj.Obj);
          when others =>
             return null;
@@ -1288,8 +1300,13 @@ package body Grt.Avhpi is
             Vptr := To_Ghdl_Value_Ptr (Obj.N_Addr);
             Atype := Obj.N_Type;
          when VhpiGenericDeclK =>
+            --  Putting values for generics is necessary to support SDF
+            --  annotations.
             Vptr := To_Ghdl_Value_Ptr (Avhpi_Get_Address (Obj));
             Atype := Obj.Obj.Obj_Type;
+         when VhpiConstDeclK =>
+            -- Don't support changing values of constants.
+            return AvhpiErrorNotImplemented;
          when others =>
             return AvhpiErrorNotImplemented;
       end case;
diff --git a/src/grt/grt-vcd.adb b/src/grt/grt-vcd.adb
index 6722f2a75..aab295555 100644
--- a/src/grt/grt-vcd.adb
+++ b/src/grt/grt-vcd.adb
@@ -416,7 +416,8 @@ package body Grt.Vcd is
             end case;
          when VhpiSigDeclK =>
             Val := Vcd_Effective;
-         when VhpiGenericDeclK =>
+         when VhpiGenericDeclK
+           | VhpiConstDeclK =>
             Val := Vcd_Variable;
          when others =>
             Info := (Vtype => Vcd_Bad,
diff --git a/src/grt/grt-vpi.adb b/src/grt/grt-vpi.adb
index a2884bd76..afcc2692f 100644
--- a/src/grt/grt-vpi.adb
+++ b/src/grt/grt-vpi.adb
@@ -574,6 +574,15 @@ package body Grt.Vpi is
                   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;
@@ -596,6 +605,9 @@ package body Grt.Vpi is
          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;
@@ -859,7 +871,8 @@ package body Grt.Vpi is
       case Vhpi_Get_Kind (Obj) is
          when VhpiPortDeclK
            | VhpiSigDeclK
-           | VhpiGenericDeclK =>
+           | VhpiGenericDeclK
+           | VhpiConstDeclK =>
             null;
          when others =>
             return null;
@@ -894,13 +907,15 @@ package body Grt.Vpi is
                Append_Bin (Ghdl_U64 (V), 32);
             end;
          when Vcd_Bit
-           | Vcd_Bool
-           | Vcd_Bitvector =>
+           | 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
-           | Vcd_Stdlogic_Vector =>
+         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;
diff --git a/src/grt/grt-vpi.ads b/src/grt/grt-vpi.ads
index 578ed23af..353451edd 100644
--- a/src/grt/grt-vpi.ads
+++ b/src/grt/grt-vpi.ads
@@ -38,6 +38,7 @@ package Grt.Vpi is
    vpiSize :          constant Integer :=  4;
    vpiFile :          constant Integer :=  5;
    vpiLineNo :        constant Integer :=  6;
+   vpiConstant :      constant Integer :=  7;
 
    vpiDefName :       constant Integer :=  9;
    vpiTimePrecision : constant Integer := 12;