configuration: add Check_Entity_Declaration_Top from translation.

evaluation: add Get_Path_Instance_Name_Suffix from translation.
grt-signals: rename ghdl_signal_direct_driver to ghdl_signal_add_direct_driver.
 add ghdl_signal_direct_assign; make active_chain private.

2 files changed, 74 insertions, 16 deletions

diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb
index dfcda9694..8b8953efa 100644
--- a/translate/grt/grt-signals.adb
+++ b/translate/grt/grt-signals.adb
@@ -173,6 +173,7 @@ package body Grt.Signals is
                               Has_Active => False,
                               Sig_Kind => Sig_Kind,
 
+                              Is_Direct_Active => False,
                               Mode => Mode,
                               Flags => (Propag => Propag_None,
                                         Is_Dumped => False,
@@ -336,8 +337,8 @@ package body Grt.Signals is
       end if;
    end Ghdl_Process_Add_Driver;
 
-   procedure Ghdl_Signal_Direct_Driver (Sign : Ghdl_Signal_Ptr;
-                                        Drv : Ghdl_Value_Ptr)
+   procedure Ghdl_Signal_Add_Direct_Driver (Sign : Ghdl_Signal_Ptr;
+                                            Drv : Ghdl_Value_Ptr)
    is
       Trans : Transaction_Acc;
       Trans1 : Transaction_Acc;
@@ -360,7 +361,7 @@ package body Grt.Signals is
                                  Val_Ptr => Drv);
       Sign.S.Drivers (Sign.S.Nbr_Drivers - 1).Last_Trans := Trans1;
       Trans.Next := Trans1;
-   end Ghdl_Signal_Direct_Driver;
+   end Ghdl_Signal_Add_Direct_Driver;
 
    procedure Append_Port (Targ : Ghdl_Signal_Ptr; Src : Ghdl_Signal_Ptr)
    is
@@ -505,6 +506,32 @@ package body Grt.Signals is
       return null;
    end Get_Driver;
 
+   --  Return TRUE iff SIG has a future transaction for the current time,
+   --  ie iff SIG will be active in the next delta cycle.  This is used to
+   --  recompute wether SIG must be in the active chain.  SIG must be a user
+   --  signal.
+   function Has_Transaction_In_Next_Delta (Sig : Ghdl_Signal_Ptr)
+                                          return Boolean  is
+   begin
+      if Sig.Is_Direct_Active then
+         return True;
+      end if;
+
+      for I in 1 .. Sig.S.Nbr_Drivers loop
+         declare
+            Trans : constant Transaction_Acc :=
+              Sig.S.Drivers (I - 1).First_Trans.Next;
+         begin
+            if Trans.Kind /= Trans_Direct
+              and then Trans.Time = Current_Time
+            then
+               return True;
+            end if;
+         end;
+      end loop;
+      return False;
+   end Has_Transaction_In_Next_Delta;
+
    --  Unused but well-known signal which always terminate
    --    ghdl_signal_active_chain.
    --  As a consequence, every element of the chain has a link field set to
@@ -707,7 +734,7 @@ package body Grt.Signals is
             --  the chain is simply linked), but that issue doesn't appear
             --  frequently.
             if Sign.Link /= null
-              and then Driver.First_Trans.Next.Time /= Current_Time
+              and then not Has_Transaction_In_Next_Delta (Sign)
             then
                if Ghdl_Signal_Active_Chain = Sign then
                   --  At the head of the chain.
@@ -767,6 +794,17 @@ package body Grt.Signals is
       Driver.Last_Trans := Trans;
    end Ghdl_Signal_Next_Assign;
 
+   procedure Ghdl_Signal_Direct_Assign (Sign : Ghdl_Signal_Ptr) is
+   begin
+      if Sign.Link = null then
+         Sign.Link := Grt.Threads.Atomic_Insert
+           (Ghdl_Signal_Active_Chain'access, Sign);
+      end if;
+
+      --  Must be always set (as Sign.Link may be set by a regular driver).
+      Sign.Is_Direct_Active := True;
+   end Ghdl_Signal_Direct_Assign;
+
    procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr;
                                               File : Ghdl_C_String;
                                               Line : Ghdl_I32)
@@ -2624,6 +2662,7 @@ package body Grt.Signals is
 
    Clear_List : Ghdl_Signal_Ptr := null;
 
+   --  Mark SIG as active and put it on Clear_List (if not already).
    procedure Mark_Active (Sig : Ghdl_Signal_Ptr);
    pragma Inline (Mark_Active);
 
@@ -3055,6 +3094,7 @@ package body Grt.Signals is
       --  1) Reset active flag.
       Reset_Active_Flag;
 
+      --  For each active signals
       Sig := Ghdl_Signal_Active_Chain;
       Ghdl_Signal_Active_Chain := Signal_End;
       while Sig.S.Mode_Sig /= Mode_End loop
@@ -3083,6 +3123,7 @@ package body Grt.Signals is
 
             when Net_One_Direct =>
                Mark_Active (Sig);
+               Sig.Is_Direct_Active := False;
 
                Trans := Sig.S.Drivers (0).Last_Trans;
                Direct_Assign (Sig.Driving_Value, Trans.Val_Ptr, Sig.Mode);
@@ -3092,6 +3133,7 @@ package body Grt.Signals is
             when Net_One_Resolved =>
                --  This signal is active.
                Mark_Active (Sig);
+               Sig.Is_Direct_Active := False;
 
                for J in 1 .. Sig.S.Nbr_Drivers loop
                   Trans := Sig.S.Drivers (J - 1).First_Trans.Next;
@@ -3112,6 +3154,7 @@ package body Grt.Signals is
                Internal_Error ("update_signals: no_signal_net");
 
             when others =>
+               Sig.Is_Direct_Active := False;
                if not Propagation.Table (Sig.Net).Updated then
                   Propagation.Table (Sig.Net).Updated := True;
                   Run_Propagation (Sig.Net + 1);
@@ -3324,6 +3367,7 @@ package body Grt.Signals is
                                      Event => False,
                                      Active => False,
                                      Has_Active => False,
+                                     Is_Direct_Active => False,
                                      Sig_Kind => Kind_Signal_No,
                                      Mode => Mode_B2,
 
diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads
index eac47a782..875d8769f 100644
--- a/translate/grt/grt-signals.ads
+++ b/translate/grt/grt-signals.ads
@@ -275,18 +275,13 @@ package Grt.Signals is
    pragma Pack (Ghdl_Signal_Flags);
 
    type Ghdl_Signal is record
-      --  Fields known by ghdl.
+      --  Fields known by the compilers.
       Value : Value_Union;
       Driving_Value : Value_Union;
       Last_Value : Value_Union;
       Last_Event : Std_Time;
       Last_Active : Std_Time;
 
-      --  Chain of signals.
-      --  Used to build nets.
-      --  This is also the simply linked list of future active signals.
-      Link : Ghdl_Signal_Ptr;
-
       Event : Boolean;
       Active : Boolean;
       --  If set, the activity of the signal is required by the user.
@@ -295,6 +290,9 @@ package Grt.Signals is
       --  Internal fields.
       --  NOTE: keep above fields (components) in sync with translation.
 
+      --  If set, the signal has an active direct driver.
+      Is_Direct_Active : Boolean;
+
       --  Kind of the signal (none, bus or register).
       Sig_Kind : Kind_Signal_Type;
 
@@ -307,7 +305,12 @@ package Grt.Signals is
       --  Net of the signal.
       Net : Signal_Net_Type;
 
-      --  Chain of signals whose active flag was set.  Used to clear it.
+      --  Chain of signals that will be active in the next delta-cycle.
+      --  (Also used to build nets).
+      Link : Ghdl_Signal_Ptr;
+
+      --  Chain of signals whose active flag was set.  Used to clear the active
+      --  flag at the end of the delta cycle.
       Alink : Ghdl_Signal_Ptr;
 
       --  Chain of signals that have a projected waveform in the real future.
@@ -530,6 +533,8 @@ package Grt.Signals is
                                             File : Ghdl_C_String;
                                             Line : Ghdl_I32);
 
+   procedure Ghdl_Signal_Direct_Assign (Sign : Ghdl_Signal_Ptr);
+
    procedure Ghdl_Signal_Set_Disconnect (Sign : Ghdl_Signal_Ptr;
                                          Time : Std_Time);
 
@@ -652,9 +657,15 @@ package Grt.Signals is
    --  Add a driver to SIGN for the current process.
    procedure Ghdl_Process_Add_Driver (Sign : Ghdl_Signal_Ptr);
 
-   --  Add a direct driver for the current process.
-   procedure Ghdl_Signal_Direct_Driver (Sign : Ghdl_Signal_Ptr;
-                                        Drv : Ghdl_Value_Ptr);
+   --  Add a direct driver for the current process.  This is an optimization
+   --  that could be used when a driver has no projected waveforms.
+   --
+   --  Assignment using direct driver:
+   --  * the driver value is set
+   --  * put the signal on the ghdl_signal_active_chain, if the signal will
+   --    be active and if not already on the chain.
+   procedure Ghdl_Signal_Add_Direct_Driver (Sign : Ghdl_Signal_Ptr;
+                                            Drv : Ghdl_Value_Ptr);
 
    --  Used for connexions:
    --  SRC is a source for TARG.
@@ -759,6 +770,9 @@ private
    pragma Export (C, Ghdl_Signal_Start_Assign_Null,
                   "__ghdl_signal_start_assign_null");
 
+   pragma Export (C, Ghdl_Signal_Direct_Assign,
+                  "__ghdl_signal_direct_assign");
+
    pragma Export (C, Ghdl_Signal_Set_Disconnect,
                   "__ghdl_signal_set_disconnect");
    pragma Export (C, Ghdl_Signal_Disconnect,
@@ -859,8 +873,8 @@ private
 
    pragma Export (C, Ghdl_Process_Add_Driver,
                   "__ghdl_process_add_driver");
-   pragma Export (C, Ghdl_Signal_Direct_Driver,
-                  "__ghdl_signal_direct_driver");
+   pragma Export (C, Ghdl_Signal_Add_Direct_Driver,
+                  "__ghdl_signal_add_direct_driver");
 
    pragma Export (C, Ghdl_Signal_Add_Source,
                   "__ghdl_signal_add_source");