src: Define PSL type RTI with simplified assertion state.

4 files changed, 94 insertions, 6 deletions

diff --git a/src/vhdl/translate/trans-chap9.adb b/src/vhdl/translate/trans-chap9.adb
index 158adea33..4acb0c01f 100644
--- a/src/vhdl/translate/trans-chap9.adb
+++ b/src/vhdl/translate/trans-chap9.adb
@@ -355,6 +355,9 @@ package body Trans.Chap9 is
            (Create_Var_Identifier ("COUNT"), Ghdl_Index_Type);
       end if;
 
+      Info.Psl_State_Var := Create_Var
+         (Create_Var_Identifier ("STATE"), Trans.Rtis.Ghdl_Rti_Psl_State);
+
       Info.Psl_Vect_Var := Create_Var
         (Create_Var_Identifier ("VECT"), Info.Psl_Vect_Type);
 
@@ -599,6 +602,10 @@ package body Trans.Chap9 is
       Start_If_Stmt (Clk_Blk,
                      Translate_Psl_Expr (Get_PSL_Clock (Stmt), False));
 
+      -- Default simplified state -> Inactive
+      New_Assign_Stmt (Get_Var (Info.Psl_State_Var),
+                       New_Lit (Trans.Rtis.Ghdl_Rti_Psl_State_Inactive));
+
       --  For each state: if set, evaluate all outgoing edges.
       NFA := Get_PSL_NFA (Stmt);
       S := Get_First_State (NFA);
@@ -613,6 +620,15 @@ package body Trans.Chap9 is
                New_Lit (New_Index_Lit
                  (Unsigned_64 (S_Num))))));
 
+         -- Get simplified state:
+         --  - If in transient state -> In progress.
+         -- Set also if in final state, will be overrided later in
+         -- failure check.
+         if S /= Get_First_State(NFA) then
+            New_Assign_Stmt (Get_Var (Info.Psl_State_Var),
+                             New_Lit (Trans.Rtis.Ghdl_Rti_Psl_State_Running));
+         end if;
+
          E := Get_First_Src_Edge (S);
          while E /= No_Edge loop
             Sd := Get_Edge_Dest (E);
@@ -640,6 +656,7 @@ package body Trans.Chap9 is
          S := Get_Next_State (S);
       end loop;
 
+
       --  Check fail state.
       S := Get_Final_State (NFA);
       S_Num := Get_State_Label (S);
@@ -658,8 +675,14 @@ package body Trans.Chap9 is
             when Iir_Kind_Psl_Assert_Directive =>
                Chap8.Translate_Report
                  (Stmt, Ghdl_Psl_Assert_Failed, Severity_Level_Error);
+               New_Assign_Stmt (
+                  Get_Var (Info.Psl_State_Var),
+                  New_Lit (Trans.Rtis.Ghdl_Rti_Psl_State_Failed));
             when Iir_Kind_Psl_Assume_Directive =>
                Call_Psl_Fail (Stmt, Ghdl_Psl_Assume_Failed);
+               New_Assign_Stmt (
+                  Get_Var (Info.Psl_State_Var),
+                  New_Lit (Trans.Rtis.Ghdl_Rti_Psl_State_Failed));
             when Iir_Kind_Psl_Cover_Directive =>
                if Get_Report_Expression (Stmt) /= Null_Iir then
                   Start_Association (Assocs, Report_Proc);
@@ -667,6 +690,9 @@ package body Trans.Chap9 is
                   New_Association (Assocs, New_Lit (Ghdl_Bool_True_Node));
                   New_Procedure_Call (Assocs);
                end if;
+               New_Assign_Stmt (
+                  Get_Var (Info.Psl_State_Var),
+                  New_Lit (Trans.Rtis.Ghdl_Rti_Psl_State_Covered));
             when others =>
                Error_Kind ("Translate_Psl_Directive_Statement", Stmt);
          end case;
diff --git a/src/vhdl/translate/trans-rtis.adb b/src/vhdl/translate/trans-rtis.adb
index 50a0986ae..3d2a8dd99 100644
--- a/src/vhdl/translate/trans-rtis.adb
+++ b/src/vhdl/translate/trans-rtis.adb
@@ -135,6 +135,14 @@ package body Trans.Rtis is
    Ghdl_Rtin_Object_Type          : O_Fnode;
    Ghdl_Rtin_Object_Linecol       : O_Fnode;
 
+   -- Node for PSL directive
+   Ghdl_Rtin_Psl_Directive        : O_Tnode;
+   Ghdl_Rtin_Psl_Directive_Common : O_Fnode;
+   Ghdl_Rtin_Psl_Directive_Name   : O_Fnode;
+   Ghdl_Rtin_Psl_Directive_Linecol: O_Fnode;
+   Ghdl_Rtin_Psl_Directive_Loc    : O_Fnode;
+   Ghdl_Rtin_Psl_Directive_Parent : O_Fnode;
+
    --  Node for an instance.
    Ghdl_Rtin_Instance         : O_Tnode;
    Ghdl_Rtin_Instance_Common  : O_Fnode;
@@ -685,6 +693,50 @@ package body Trans.Rtis is
                         Ghdl_Rtin_Object);
       end;
 
+      -- Create PSL State type: Inactive, Running, Failed, Covered
+      declare
+         Constr : O_Enum_List;
+      begin
+         Start_Enum_Type (Constr, 8);
+         New_Enum_Literal
+           (Constr, Get_Identifier ("__ghdl_psl_state_inactive"),
+            Ghdl_Rti_Psl_State_Inactive);
+         New_Enum_Literal
+           (Constr, Get_Identifier ("__ghdl_psl_state_running"),
+            Ghdl_Rti_Psl_State_Running);
+         New_Enum_Literal
+           (Constr, Get_Identifier ("__ghdl_psl_state_failed"),
+            Ghdl_Rti_Psl_State_Failed);
+         New_Enum_Literal
+           (Constr, Get_Identifier ("__ghdl_psl_state_covered"),
+            Ghdl_Rti_Psl_State_Covered);
+
+         Finish_Enum_Type (Constr, Ghdl_Rti_Psl_State);
+         New_Type_Decl (Get_Identifier ("__ghdl_psl_state"),
+                        Ghdl_Rti_Psl_State);
+      end;
+
+
+      -- PSL directive
+      declare
+         Constr : O_Element_List;
+      begin
+         Start_Record_Type (Constr);
+         New_Record_Field (Constr, Ghdl_Rtin_Psl_Directive_Common,
+                           Get_Identifier ("common"), Ghdl_Rti_Common);
+         New_Record_Field (Constr, Ghdl_Rtin_Psl_Directive_Name,
+                           Get_Identifier ("name"), Char_Ptr_Type);
+         New_Record_Field (Constr, Ghdl_Rtin_Psl_Directive_Loc,
+                           Get_Identifier ("loc"), Ghdl_Ptr_Type);
+         New_Record_Field (Constr, Ghdl_Rtin_Psl_Directive_Linecol,
+                           Get_Identifier ("linecol"), Ghdl_Index_Type);
+         New_Record_Field (Constr, Ghdl_Rtin_Psl_Directive_Parent,
+                           Wki_Parent, Ghdl_Rti_Access);
+         Finish_Record_Type (Constr, Ghdl_Rtin_Psl_Directive);
+         New_Type_Decl (Get_Identifier ("__ghdl_rtin_psl_declaration"),
+                        Ghdl_Rtin_Psl_Directive);
+      end;
+
       --  Instance.
       declare
          Constr : O_Element_List;
@@ -763,7 +815,7 @@ package body Trans.Rtis is
          --  Number of children.
          Nbr       : Integer;
 
-         --  Array for the fist children.
+         --  Array for the first children.
          List      : Rti_Array_List;
 
          --  Linked list for the following children.
@@ -2019,7 +2071,7 @@ package body Trans.Rtis is
       Pop_Identifier_Prefix (Mark);
    end Generate_Object;
 
-   procedure Generate_Psl_Directive (Decl : Iir)
+   procedure Generate_Psl_Directive (Decl : Iir; Parent : O_Dnode)
    is
       Info : constant Psl_Info_Acc := Get_Info (Decl);
       Name : O_Dnode;
@@ -2034,12 +2086,12 @@ package body Trans.Rtis is
       Push_Identifier_Prefix (Mark, Get_Identifier (Decl));
 
       New_Const_Decl (Info.Psl_Rti_Const, Create_Identifier ("RTI"),
-                      Global_Storage, Ghdl_Rtin_Object);
+                      Global_Storage, Ghdl_Rtin_Psl_Directive);
 
       Name := Generate_Name (Decl);
 
       Start_Init_Value (Info.Psl_Rti_Const);
-      Start_Record_Aggr (List, Ghdl_Rtin_Object);
+      Start_Record_Aggr (List, Ghdl_Rtin_Psl_Directive);
       case Get_Kind (Decl) is
          when Iir_Kind_Psl_Cover_Directive =>
             Kind := Ghdl_Rtik_Psl_Cover;
@@ -2057,8 +2109,8 @@ package body Trans.Rtis is
 
       Field_Off := Get_Scope_Offset (Info.Psl_Scope, Ghdl_Ptr_Type);
       New_Record_Aggr_El (List, Field_Off);
-      New_Record_Aggr_El (List, New_Null_Access (Ghdl_Rti_Access));
       New_Record_Aggr_El (List, Generate_Linecol (Decl));
+      New_Record_Aggr_El (List, New_Rti_Address (Parent));
       Finish_Record_Aggr (List, Val);
       Finish_Init_Value (Info.Psl_Rti_Const, Val);
 
@@ -2430,7 +2482,7 @@ package body Trans.Rtis is
               | Iir_Kind_Psl_Assume_Directive
               | Iir_Kind_Psl_Cover_Directive
               | Iir_Kind_Psl_Endpoint_Declaration =>
-               Generate_Psl_Directive (Stmt);
+               Generate_Psl_Directive (Stmt, Parent_Rti);
             when others =>
                Error_Kind ("rti.generate_concurrent_statement_chain", Stmt);
          end case;
diff --git a/src/vhdl/translate/trans-rtis.ads b/src/vhdl/translate/trans-rtis.ads
index b3cfa49ea..dfa30a615 100644
--- a/src/vhdl/translate/trans-rtis.ads
+++ b/src/vhdl/translate/trans-rtis.ads
@@ -73,6 +73,13 @@ package Trans.Rtis is
    Ghdl_Rtik_Psl_Endpoint                : O_Cnode;
    Ghdl_Rtik_Error                       : O_Cnode;
 
+   -- PSL State types
+   Ghdl_Rti_Psl_State                    : O_Tnode;
+   Ghdl_Rti_Psl_State_Inactive           : O_Cnode;
+   Ghdl_Rti_Psl_State_Running            : O_Cnode;
+   Ghdl_Rti_Psl_State_Failed             : O_Cnode;
+   Ghdl_Rti_Psl_State_Covered            : O_Cnode;
+
    --  RTI types.
    Ghdl_Rti_Depth : O_Tnode;
    Ghdl_Rti_U8    : O_Tnode;
diff --git a/src/vhdl/translate/trans.ads b/src/vhdl/translate/trans.ads
index 7125da68b..4e0b9b959 100644
--- a/src/vhdl/translate/trans.ads
+++ b/src/vhdl/translate/trans.ads
@@ -1943,6 +1943,9 @@ package Trans is
             --  State vector variable.
             Psl_Vect_Var : Var_Type;
 
+            --  Simplified Assertion state (for dumping)
+            Psl_State_Var : Var_Type;
+
             --  Counter variable (nbr of failures or coverage)
             Psl_Count_Var : Var_Type;