simul: gather disconnection specifications, create guard signal

3 files changed, 191 insertions, 33 deletions

diff --git a/src/simul/simul-vhdl_elab.adb b/src/simul/simul-vhdl_elab.adb
index 1185b3cb7..0fd99b551 100644
--- a/src/simul/simul-vhdl_elab.adb
+++ b/src/simul/simul-vhdl_elab.adb
@@ -24,6 +24,7 @@ with Vhdl.Canon;
 
 with Synth.Vhdl_Stmts;
 with Synth.Vhdl_Decls;
+with Synth.Vhdl_Expr;
 with Trans_Analyzes;
 
 with Simul.Vhdl_Debug;
@@ -107,7 +108,7 @@ package body Simul.Vhdl_Elab is
             end;
          when Type_Record =>
             declare
-               List : constant Iir_Flist := Get_Elements_Declaration_List
+               List : constant Node_Flist := Get_Elements_Declaration_List
                  (Sig_Type);
                El : Iir_Element_Declaration;
             begin
@@ -153,7 +154,7 @@ package body Simul.Vhdl_Elab is
       end if;
       E.Sig := null;
 
-      if E.Typ.W > 0 then
+      if E.Kind in Mode_Signal_User and then E.Typ.W > 0 then
          E.Nbr_Sources :=
            new Nbr_Sources_Array'(0 .. E.Typ.W - 1 =>
                                     (Nbr_Drivers => 0,
@@ -170,6 +171,41 @@ package body Simul.Vhdl_Elab is
       Signals_Table.Table (Val.Val.S) := E;
    end Gather_Signal;
 
+   procedure Gather_Disconnection (Inst : Synth_Instance_Acc; Decl : Node)
+   is
+      List : constant Node_Flist := Get_Signal_List (Decl);
+      Marker : Mark_Type;
+      Name : Node;
+      Base_Vt : Valtyp;
+      Typ : Type_Acc;
+      Off : Value_Offsets;
+      Sig : Signal_Index_Type;
+      Tval : Valtyp;
+      T : Std_Time;
+   begin
+      Mark_Expr_Pool (Marker);
+
+      Tval := Synth.Vhdl_Expr.Synth_Expression (Inst, Get_Expression (Decl));
+      T := Std_Time (Read_Discrete (Tval));
+
+      for I in Flist_First .. Flist_Last (List) loop
+         Name := Get_Nth_Element (List, I);
+         Synth.Vhdl_Stmts.Synth_Assignment_Prefix
+           (Inst, Name, Base_Vt, Typ, Off);
+         Sig := Base_Vt.Val.S;
+         Typ := Unshare (Typ, Global_Pool'Access);
+         Disconnect_Table.Append
+           ((Sig => Sig,
+             Off => Off,
+             Typ => Typ,
+             Val => T,
+             Prev => Signals_Table.Table (Sig).Disconnect));
+         Signals_Table.Table (Sig).Disconnect := Disconnect_Table.Last;
+      end loop;
+
+      Release_Expr_Pool (Marker);
+   end Gather_Disconnection;
+
    procedure Gather_Quantity (Inst : Synth_Instance_Acc; Decl : Node)
    is
       Val : constant Valtyp := Get_Value (Inst, Decl);
@@ -206,28 +242,34 @@ package body Simul.Vhdl_Elab is
                when Iir_Linkage_Mode =>
                   Gather_Signal ((Mode_Linkage, Decl, Inst, null, null, null,
                                   No_Sensitivity_Index, No_Signal_Index,
-                                  No_Driver_Index, No_Connect_Index, null));
+                                  No_Driver_Index, No_Connect_Index,
+                                  No_Disconnect_Index, null));
                when Iir_Buffer_Mode =>
                   Gather_Signal ((Mode_Buffer, Decl, Inst, null, null, null,
                                   No_Sensitivity_Index, No_Signal_Index,
-                                  No_Driver_Index, No_Connect_Index, null));
+                                  No_Driver_Index, No_Connect_Index,
+                                  No_Disconnect_Index, null));
                when Iir_Out_Mode =>
                   Gather_Signal ((Mode_Out, Decl, Inst, null, null, null,
                                   No_Sensitivity_Index, No_Signal_Index,
-                                  No_Driver_Index, No_Connect_Index, null));
+                                  No_Driver_Index, No_Connect_Index,
+                                  No_Disconnect_Index, null));
                when Iir_Inout_Mode =>
                   Gather_Signal ((Mode_Inout, Decl, Inst, null, null, null,
                                   No_Sensitivity_Index, No_Signal_Index,
-                                  No_Driver_Index, No_Connect_Index, null));
+                                  No_Driver_Index, No_Connect_Index,
+                                  No_Disconnect_Index, null));
                when Iir_In_Mode =>
                   Gather_Signal ((Mode_In, Decl, Inst, null, null, null,
                                   No_Sensitivity_Index, No_Signal_Index,
-                                  No_Driver_Index, No_Connect_Index, null));
+                                  No_Driver_Index, No_Connect_Index,
+                                  No_Disconnect_Index, null));
             end case;
          when Iir_Kind_Signal_Declaration =>
             Gather_Signal ((Mode_Signal, Decl, Inst, null, null, null,
                             No_Sensitivity_Index, No_Signal_Index,
-                            No_Driver_Index, No_Connect_Index, null));
+                            No_Driver_Index, No_Connect_Index,
+                            No_Disconnect_Index, null));
          when Iir_Kind_Configuration_Specification =>
             null;
          when Iir_Kind_Free_Quantity_Declaration
@@ -268,6 +310,8 @@ package body Simul.Vhdl_Elab is
                V := Get_Value (Inst, Decl);
                Convert_Type_Width (V.Typ);
             end;
+         when Iir_Kind_Disconnection_Specification =>
+            Gather_Disconnection (Inst, Decl);
          when Iir_Kind_Variable_Declaration =>
             pragma Assert (Get_Shared_Flag (Decl));
             if Get_Default_Value (Decl) = Null_Node then
@@ -846,7 +890,12 @@ package body Simul.Vhdl_Elab is
          when Iir_Kind_Block_Statement =>
             declare
                Hdr : constant Node := Get_Block_Header (N);
+               Guard : constant Node := Get_Guard_Decl (N);
             begin
+               if Guard /= Null_Node then
+                  Gather_Signal ((Mode_Guard, Guard, Inst, null, null, null,
+                                  No_Sensitivity_Index, No_Signal_Index));
+               end if;
                if Hdr /= Null_Node then
                   Gather_Processes_Decls (Inst, Get_Port_Chain (Hdr));
                end if;
@@ -916,27 +965,29 @@ package body Simul.Vhdl_Elab is
               Get_Kind (E.Decl) = Iir_Kind_Interface_Signal_Declaration
               and then Get_Mode (E.Decl) in Iir_Out_Modes;
          begin
-            for J in 1 .. E.Typ.W loop
-               declare
-                  Ns : Nbr_Sources_Type renames E.Nbr_Sources (J - 1);
-               begin
-                  Ns.Total := Ns.Nbr_Drivers + Ns.Nbr_Conns;
-                  if Ns.Total = 0 and then Is_Out then
-                     Ns.Total := 1;
-                  end if;
-                  if E.Collapsed_By /= No_Signal_Index then
-                     --  Add to the parent.
-                     declare
-                        C_Ns : Nbr_Sources_Type renames
-                          Signals_Table.Table (E.Collapsed_By)
-                          .Nbr_Sources (J - 1);
-                     begin
-                        --  Remove 1 for the connection.
-                        C_Ns.Total := C_Ns.Total + Ns.Total - 1;
-                     end;
-                  end if;
-               end;
-            end loop;
+            if E.Kind in Mode_Signal_User then
+               for J in 1 .. E.Typ.W loop
+                  declare
+                     Ns : Nbr_Sources_Type renames E.Nbr_Sources (J - 1);
+                  begin
+                     Ns.Total := Ns.Nbr_Drivers + Ns.Nbr_Conns;
+                     if Ns.Total = 0 and then Is_Out then
+                        Ns.Total := 1;
+                     end if;
+                     if E.Collapsed_By /= No_Signal_Index then
+                        --  Add to the parent.
+                        declare
+                           C_Ns : Nbr_Sources_Type renames
+                             Signals_Table.Table (E.Collapsed_By)
+                             .Nbr_Sources (J - 1);
+                        begin
+                           --  Remove 1 for the connection.
+                           C_Ns.Total := C_Ns.Total + Ns.Total - 1;
+                        end;
+                     end if;
+                  end;
+               end loop;
+            end if;
          end;
       end loop;
    end Gather_Processes;
diff --git a/src/simul/simul-vhdl_elab.ads b/src/simul/simul-vhdl_elab.ads
index 8e6424b3c..233bad313 100644
--- a/src/simul/simul-vhdl_elab.ads
+++ b/src/simul/simul-vhdl_elab.ads
@@ -52,10 +52,12 @@ package Simul.Vhdl_Elab is
    type Process_Index_Type is new Nat32;
    type Driver_Index_Type is new Nat32;
    subtype Sensitivity_Index_Type is Driver_Index_Type;
+   type Disconnect_Index_Type is new Nat32;
 
    No_Process_Index : constant Process_Index_Type := 0;
    No_Driver_Index : constant Driver_Index_Type := 0;
    No_Sensitivity_Index : constant Sensitivity_Index_Type := 0;
+   No_Disconnect_Index : constant Disconnect_Index_Type := 0;
 
    type Proc_Record_Type is record
       Proc : Node;
@@ -161,6 +163,7 @@ package Simul.Vhdl_Elab is
          when Mode_Signal_User =>
             Drivers : Driver_Index_Type;
             Connect : Connect_Index_Type;
+            Disconnect : Disconnect_Index_Type;
             Nbr_Sources : Nbr_Sources_Arr_Acc;
          when Mode_Quiet | Mode_Stable | Mode_Delayed
            | Mode_Transaction =>
@@ -210,6 +213,20 @@ package Simul.Vhdl_Elab is
       Table_Low_Bound => No_Sensitivity_Index + 1,
       Table_Initial => 128);
 
+   type Disconnect_Entry is record
+      Sig : Signal_Index_Type;
+      Off : Value_Offsets;
+      Typ : Type_Acc;
+      Prev : Disconnect_Index_Type;
+      Val : Std_Time;
+   end record;
+
+   package Disconnect_Table is new Tables
+     (Table_Component_Type => Disconnect_Entry,
+      Table_Index_Type => Disconnect_Index_Type,
+      Table_Low_Bound => No_Disconnect_Index + 1,
+      Table_Initial => 8);
+
    type Scalar_Quantity_Index is new Uns32;
    No_Scalar_Quantity : constant Scalar_Quantity_Index := 0;
 
diff --git a/src/simul/simul-vhdl_simul.adb b/src/simul/simul-vhdl_simul.adb
index 5eeebe7b6..cae02fad7 100644
--- a/src/simul/simul-vhdl_simul.adb
+++ b/src/simul/simul-vhdl_simul.adb
@@ -2222,6 +2222,97 @@ package body Simul.Vhdl_Simul is
       Create_Signal (E.Val, 0, Sig_Type, E.Typ, E.Nbr_Sources.all, False);
    end Create_User_Signal;
 
+   type Guard_Instance_Type is record
+      Instance : Synth_Instance_Acc;
+      Guard : Iir;
+   end record;
+
+   type Guard_Instance_Acc is access Guard_Instance_Type;
+
+   function Guard_Func (Data : System.Address) return Ghdl_B1;
+   pragma Convention (C, Guard_Func);
+
+   function Guard_Func (Data : System.Address) return Ghdl_B1
+   is
+      use Areapools;
+
+      Guard : Guard_Instance_Type;
+      pragma Import (Ada, Guard);
+      for Guard'Address use Data;
+
+      Val : Boolean;
+
+      Prev_Instance_Pool : constant Areapool_Acc := Instance_Pool;
+   begin
+      Instance_Pool := Process_Pool'Access;
+
+      Val := Execute_Condition
+        (Guard.Instance, Get_Guard_Expression (Guard.Guard));
+
+      Instance_Pool := Prev_Instance_Pool;
+
+      return Ghdl_B1'Val (Boolean'Pos (Val));
+   end Guard_Func;
+
+   procedure Add_Guard_Sensitivity (Typ : Type_Acc; Sig : Memory_Ptr) is
+   begin
+      case Typ.Kind is
+         when Type_Scalars =>
+            Grt.Signals.Ghdl_Signal_Guard_Dependence (Read_Sig (Sig));
+         when Type_Vector
+           | Type_Array =>
+            declare
+               Len : constant Uns32 := Typ.Abound.Len;
+            begin
+               for I in 1 .. Len loop
+                  Add_Guard_Sensitivity
+                    (Typ.Arr_El, Sig_Index (Sig, (Len - I) * Typ.Arr_El.W));
+               end loop;
+            end;
+         when Type_Record =>
+            for I in Typ.Rec.E'Range loop
+               Add_Guard_Sensitivity
+                 (Typ.Rec.E (I).Typ,
+                  Sig_Index (Sig, Typ.Rec.E (I).Offs.Net_Off));
+            end loop;
+         when others =>
+            raise Internal_Error;
+      end case;
+   end Add_Guard_Sensitivity;
+
+   procedure Create_Guard_Signal (Idx : Signal_Index_Type)
+   is
+      E : Signal_Entry renames Signals_Table.Table (Idx);
+
+      Dep_List : Iir_List;
+      Dep_It : List_Iterator;
+      S : Ghdl_Signal_Ptr;
+      Data : Guard_Instance_Acc;
+   begin
+      Data := new Guard_Instance_Type'(Instance => E.Inst, Guard => E.Decl);
+
+      S := Grt.Signals.Ghdl_Signal_Create_Guard
+        (To_Ghdl_Value_Ptr (To_Address (E.Val)),
+         Data.all'Address, Guard_Func'Access);
+      Write_Sig (E.Sig, S);
+
+      Dep_List := Get_Guard_Sensitivity_List (E.Decl);
+      Dep_It := List_Iterate (Dep_List);
+      while Is_Valid (Dep_It) loop
+         declare
+            El : constant Node := Get_Element (Dep_It);
+            Sig_Mem : Memory_Ptr;
+            Info : Target_Info;
+         begin
+            Info := Synth_Target (E.Inst, El);
+            Sig_Mem := Signals_Table.Table (Info.Obj.Val.S).Sig;
+            Add_Guard_Sensitivity
+              (Info.Targ_Type, Sig_Index (Sig_Mem, Info.Off.Net_Off));
+         end;
+         Next (Dep_It);
+      end loop;
+   end Create_Guard_Signal;
+
    function Alloc_Signal_Memory (Vtype : Type_Acc) return Memory_Ptr
    is
       function To_Memory_Ptr is new Ada.Unchecked_Conversion
@@ -2240,8 +2331,7 @@ package body Simul.Vhdl_Simul is
       E.Sig := Alloc_Signal_Memory (E.Typ);
       case E.Kind is
          when Mode_Guard =>
-            --  Create_Guard_Signal (E.Instance, E.Sig, E.Val, E.Decl);
-            raise Internal_Error;
+            Create_Guard_Signal (Idx);
          when Mode_Stable | Mode_Quiet | Mode_Transaction =>
             -- Create_Implicit_Signal
             --  (E.Sig, E.Val, E.Time, E.Prefix, E.Kind);
@@ -2487,11 +2577,11 @@ package body Simul.Vhdl_Simul is
       Dst_Val := Create_Value_Memory (Val, Current_Pool);
       Dst_Val := Synth_Association_Conversion
         (Conv.Inst, Conv.Func, Dst_Val, Conv.Dst_Typ);
-      pragma Assert (Dst_Val.Typ.Wkind = Wkind_Sim);
-
       if Dst_Val = No_Valtyp then
          Grt.Errors.Fatal_Error;
       end if;
+
+      pragma Assert (Dst_Val.Typ.Wkind = Wkind_Sim);
       Convert_Type_Width (Dst_Val.Typ);
       Dst := Synth.Vhdl_Expr.Get_Value_Memtyp (Dst_Val);