diff options
Diffstat (limited to 'translate/grt/grt-signals.adb')
| -rw-r--r-- | translate/grt/grt-signals.adb | 3400 |
1 files changed, 0 insertions, 3400 deletions
diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb deleted file mode 100644 index 9698d81..0000000 --- a/translate/grt/grt-signals.adb +++ /dev/null @@ -1,3400 +0,0 @@ --- GHDL Run Time (GRT) - signals management. --- Copyright (C) 2002 - 2014 Tristan Gingold --- --- 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. --- --- As a special exception, if other files instantiate generics from this --- unit, or you link this unit with other files to produce an executable, --- this unit does not by itself cause the resulting executable to be --- covered by the GNU General Public License. This exception does not --- however invalidate any other reasons why the executable file might be --- covered by the GNU Public License. -with System; use System; -with System.Storage_Elements; -- Work around GNAT bug. -pragma Unreferenced (System.Storage_Elements); -with Ada.Unchecked_Deallocation; -with Grt.Errors; use Grt.Errors; -with Grt.Processes; use Grt.Processes; -with Grt.Options; use Grt.Options; -with Grt.Rtis_Types; use Grt.Rtis_Types; -with Grt.Disp_Signals; -with Grt.Astdio; -with Grt.Stdio; -with Grt.Threads; use Grt.Threads; - -package body Grt.Signals is - procedure Free is new Ada.Unchecked_Deallocation - (Object => Transaction, Name => Transaction_Acc); - - procedure Free_In (Trans : Transaction_Acc) - is - Ntrans : Transaction_Acc; - begin - Ntrans := Trans; - Free (Ntrans); - end Free_In; - pragma Inline (Free_In); - - -- RTI for the current signal. - Sig_Rti : Ghdl_Rtin_Object_Acc; - - -- Signal mode (and flags) for the current signal. - Sig_Mode : Mode_Signal_Type; - Sig_Has_Active : Boolean; - Sig_Kind : Kind_Signal_Type; - - -- Last created implicit signal. This is used to add dependencies on - -- the prefix. - Last_Implicit_Signal : Ghdl_Signal_Ptr; - - -- Current signal resolver. - Current_Resolv : Resolved_Signal_Acc := null; - - function Get_Current_Mode_Signal return Mode_Signal_Type is - begin - return Sig_Mode; - end Get_Current_Mode_Signal; - - procedure Ghdl_Signal_Name_Rti (Sig : Ghdl_Rti_Access; - Ctxt : Ghdl_Rti_Access; - Addr : Address) - is - pragma Unreferenced (Ctxt); - pragma Unreferenced (Addr); - begin - Sig_Rti := To_Ghdl_Rtin_Object_Acc (Sig); - Sig_Mode := Mode_Signal_Type'Val - (Sig.Mode and Ghdl_Rti_Signal_Mode_Mask); - Sig_Kind := Kind_Signal_Type'Val - ((Sig.Mode and Ghdl_Rti_Signal_Kind_Mask) - / Ghdl_Rti_Signal_Kind_Offset); - Sig_Has_Active := - (Sig_Rti.Common.Mode and Ghdl_Rti_Signal_Has_Active) /= 0; - end Ghdl_Signal_Name_Rti; - - procedure Ghdl_Signal_Set_Mode (Mode : Mode_Signal_Type; - Kind : Kind_Signal_Type; - Has_Active : Boolean) is - begin - Sig_Rti := null; - Sig_Mode := Mode; - Sig_Kind := Kind; - Sig_Has_Active := Has_Active; - end Ghdl_Signal_Set_Mode; - - function Is_Signal_Guarded (Sig : Ghdl_Signal_Ptr) return Boolean is - begin - return Sig.Sig_Kind /= Kind_Signal_No; - end Is_Signal_Guarded; - - function To_Address is new Ada.Unchecked_Conversion - (Source => Ghdl_Signal_Ptr, Target => Address); - - function Create_Signal - (Mode : Mode_Type; - Init_Val : Value_Union; - Mode_Sig : Mode_Signal_Type; - Resolv_Proc : Resolver_Acc; - Resolv_Inst : System.Address) - return Ghdl_Signal_Ptr - is - Res : Ghdl_Signal_Ptr; - Resolv : Resolved_Signal_Acc; - S : Ghdl_Signal_Data (Mode_Sig); - begin - Sig_Table.Increment_Last; - - if Current_Resolv = null then - if Resolv_Proc /= null then - Resolv := new Resolved_Signal_Type' - (Resolv_Proc => Resolv_Proc, - Resolv_Inst => Resolv_Inst, - Resolv_Ptr => Null_Address, - Sig_Range => (Sig_Table.Last, Sig_Table.Last), - Disconnect_Time => Bad_Time); - else - Resolv := null; - end if; - else - if Resolv_Proc /= null then - -- Only one resolution function is allowed! - Internal_Error ("create_signal"); - end if; - Resolv := Current_Resolv; - if Current_Resolv.Sig_Range.Last = Sig_Table.Last then - Current_Resolv := null; - end if; - end if; - - case Mode_Sig is - when Mode_Signal_User => - S.Nbr_Drivers := 0; - S.Drivers := null; - S.Effective := null; - S.Resolv := Resolv; - when Mode_Conv_In - | Mode_Conv_Out => - S.Conv := null; - when Mode_Stable - | Mode_Quiet - | Mode_Delayed => - S.Time := 0; - when Mode_Guard => - S.Guard_Func := null; - S.Guard_Instance := System.Null_Address; - when Mode_Transaction - | Mode_End => - null; - end case; - - Res := new Ghdl_Signal'(Value => Init_Val, - Driving_Value => Init_Val, - Last_Value => Init_Val, - -- Note: use -Std_Time'last instead of - -- Std_Time'First so that NOW - x'last_event - -- returns time'high at initialization! - Last_Event => -Std_Time'Last, - Last_Active => -Std_Time'Last, - Event => False, - Active => False, - Has_Active => False, - Sig_Kind => Sig_Kind, - - Is_Direct_Active => False, - Mode => Mode, - Flags => (Propag => Propag_None, - Is_Dumped => False, - Cyc_Event => False, - Seen => False), - - Net => No_Signal_Net, - Link => null, - Alink => null, - Flink => null, - - Event_List => null, - Rti => Sig_Rti, - - Nbr_Ports => 0, - Ports => null, - - S => S); - - if Resolv /= null and then Resolv.Resolv_Ptr = System.Null_Address then - Resolv.Resolv_Ptr := To_Address (Res); - end if; - - case Flag_Activity is - when Activity_All => - Res.Has_Active := True; - when Activity_Minimal => - Res.Has_Active := Sig_Has_Active; - when Activity_None => - Res.Has_Active := False; - end case; - - -- Put the signal in the table. - Sig_Table.Table (Sig_Table.Last) := Res; - - return Res; - end Create_Signal; - - procedure Ghdl_Signal_Init (Sig : Ghdl_Signal_Ptr; Val : Value_Union) is - begin - Sig.Value := Val; - Sig.Driving_Value := Val; - Sig.Last_Value := Val; - end Ghdl_Signal_Init; - - procedure Ghdl_Signal_Merge_Rti (Sig : Ghdl_Signal_Ptr; - Rti : Ghdl_Rti_Access) - is - S_Rti : Ghdl_Rtin_Object_Acc; - begin - S_Rti := To_Ghdl_Rtin_Object_Acc (Rti); - if Flag_Activity = Activity_Minimal then - if (S_Rti.Common.Mode and Ghdl_Rti_Signal_Has_Active) /= 0 then - Sig.Has_Active := True; - end if; - end if; - end Ghdl_Signal_Merge_Rti; - - procedure Ghdl_Signal_Create_Resolution (Proc : Resolver_Acc; - Instance : System.Address; - Sig : System.Address; - Nbr_Sig : Ghdl_Index_Type) - is - begin - if Current_Resolv /= null then - Internal_Error ("Ghdl_Signal_Create_Resolution"); - end if; - Current_Resolv := new Resolved_Signal_Type' - (Resolv_Proc => Proc, - Resolv_Inst => Instance, - Resolv_Ptr => Sig, - Sig_Range => (First => Sig_Table.Last + 1, - Last => Sig_Table.Last + Sig_Table_Index (Nbr_Sig)), - Disconnect_Time => Bad_Time); - end Ghdl_Signal_Create_Resolution; - - procedure Check_New_Source (Sig : Ghdl_Signal_Ptr) - is - use Grt.Stdio; - use Grt.Astdio; - begin - if Sig.S.Nbr_Drivers + Sig.Nbr_Ports > 0 then - if Sig.S.Resolv = null then - -- LRM 4.3.1.2 Signal Declaration - -- It is an error if, after the elaboration of a description, a - -- signal has multiple sources and it is not a resolved signal. - if Sig.Rti /= null then - Put ("for signal: "); - Disp_Signals.Put_Signal_Name (stderr, Sig); - New_Line (stderr); - end if; - Error ("several sources for unresolved signal"); - elsif Sig.S.Mode_Sig = Mode_Buffer and False then - -- LRM 1.1.1.2 Ports - -- A BUFFER port may have at most one source. - - -- FIXME: this is not true with VHDL-02. - -- With VHDL-87/93, should also check that: any actual associated - -- with a formal buffer port may have at most one source. - Error ("buffer port which more than one source"); - end if; - end if; - end Check_New_Source; - - -- Return TRUE if already present. - function Ghdl_Signal_Add_Driver (Sign : Ghdl_Signal_Ptr; - Trans : Transaction_Acc) - return Boolean - is - type Size_T is mod 2**Standard'Address_Size; - - function Malloc (Size : Size_T) return Driver_Arr_Ptr; - pragma Import (C, Malloc); - - function Realloc (Ptr : Driver_Arr_Ptr; Size : Size_T) - return Driver_Arr_Ptr; - pragma Import (C, Realloc); - - function Size (N : Ghdl_Index_Type) return Size_T is - begin - return Size_T (N * Driver_Fat_Array'Component_Size - / System.Storage_Unit); - end Size; - - Proc : Process_Acc; - begin - Proc := Get_Current_Process; - if Sign.S.Nbr_Drivers = 0 then - Check_New_Source (Sign); - Sign.S.Drivers := Malloc (Size (1)); - Sign.S.Nbr_Drivers := 1; - else - -- Do not create a driver twice. - for I in 0 .. Sign.S.Nbr_Drivers - 1 loop - if Sign.S.Drivers (I).Proc = Proc then - return True; - end if; - end loop; - Check_New_Source (Sign); - Sign.S.Nbr_Drivers := Sign.S.Nbr_Drivers + 1; - Sign.S.Drivers := Realloc (Sign.S.Drivers, Size (Sign.S.Nbr_Drivers)); - end if; - Sign.S.Drivers (Sign.S.Nbr_Drivers - 1) := - (First_Trans => Trans, - Last_Trans => Trans, - Proc => Proc); - return False; - end Ghdl_Signal_Add_Driver; - - procedure Ghdl_Process_Add_Driver (Sign : Ghdl_Signal_Ptr) - is - Trans : Transaction_Acc; - begin - Trans := new Transaction'(Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Sign.Value); - if Ghdl_Signal_Add_Driver (Sign, Trans) then - Free (Trans); - end if; - end Ghdl_Process_Add_Driver; - - procedure Ghdl_Signal_Add_Direct_Driver (Sign : Ghdl_Signal_Ptr; - Drv : Ghdl_Value_Ptr) - is - Trans : Transaction_Acc; - Trans1 : Transaction_Acc; - begin - -- Create transaction for current driving value. - Trans := new Transaction'(Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Sign.Value); - if Ghdl_Signal_Add_Driver (Sign, Trans) then - Free (Trans); - return; - end if; - -- Create transaction for the next driving value. - Trans1 := new Transaction'(Kind => Trans_Direct, - Line => 0, - Time => 0, - Next => null, - Val_Ptr => Drv); - Sign.S.Drivers (Sign.S.Nbr_Drivers - 1).Last_Trans := Trans1; - Trans.Next := Trans1; - end Ghdl_Signal_Add_Direct_Driver; - - procedure Append_Port (Targ : Ghdl_Signal_Ptr; Src : Ghdl_Signal_Ptr) - is - type Size_T is new Integer; - - function Malloc (Size : Size_T) return Signal_Arr_Ptr; - pragma Import (C, Malloc); - - function Realloc (Ptr : Signal_Arr_Ptr; Size : Size_T) - return Signal_Arr_Ptr; - pragma Import (C, Realloc); - - function Size (N : Ghdl_Index_Type) return Size_T is - begin - return Size_T (N * Ghdl_Signal_Ptr'Size / System.Storage_Unit); - end Size; - begin - if Targ.Nbr_Ports = 0 then - Targ.Ports := Malloc (Size (1)); - Targ.Nbr_Ports := 1; - else - Targ.Nbr_Ports := Targ.Nbr_Ports + 1; - Targ.Ports := Realloc (Targ.Ports, Size (Targ.Nbr_Ports)); - end if; - Targ.Ports (Targ.Nbr_Ports - 1) := Src; - end Append_Port; - - -- Add SRC to port list of TARG, but only if not already in this list. - procedure Add_Port (Targ : Ghdl_Signal_Ptr; Src : Ghdl_Signal_Ptr) - is - begin - for I in 1 .. Targ.Nbr_Ports loop - if Targ.Ports (I - 1) = Src then - return; - end if; - end loop; - Append_Port (Targ, Src); - end Add_Port; - - procedure Ghdl_Signal_Add_Source (Targ : Ghdl_Signal_Ptr; - Src : Ghdl_Signal_Ptr) - is - begin - Check_New_Source (Targ); - Append_Port (Targ, Src); - end Ghdl_Signal_Add_Source; - - procedure Ghdl_Signal_Set_Disconnect (Sign : Ghdl_Signal_Ptr; - Time : Std_Time) is - begin - if Sign.S.Resolv = null then - Internal_Error ("ghdl_signal_set_disconnect: not resolved"); - end if; - if Sign.S.Resolv.Disconnect_Time /= Bad_Time then - Error ("disconnection already specified for signal"); - end if; - if Time < 0 then - Error ("disconnection time is negative"); - end if; - Sign.S.Resolv.Disconnect_Time := Time; - end Ghdl_Signal_Set_Disconnect; - - procedure Direct_Assign - (Targ : out Value_Union; Val : Ghdl_Value_Ptr; Mode : Mode_Type) - is - begin - case Mode is - when Mode_B1 => - Targ.B1 := Val.B1; - when Mode_E8 => - Targ.E8 := Val.E8; - when Mode_E32 => - Targ.E32 := Val.E32; - when Mode_I32 => - Targ.I32 := Val.I32; - when Mode_I64 => - Targ.I64 := Val.I64; - when Mode_F64 => - Targ.F64 := Val.F64; - end case; - end Direct_Assign; - - function Value_Equal (Left, Right : Value_Union; Mode : Mode_Type) - return Boolean - is - begin - case Mode is - when Mode_B1 => - return Left.B1 = Right.B1; - when Mode_E8 => - return Left.E8 = Right.E8; - when Mode_E32 => - return Left.E32 = Right.E32; - when Mode_I32 => - return Left.I32 = Right.I32; - when Mode_I64 => - return Left.I64 = Right.I64; - when Mode_F64 => - return Left.F64 = Right.F64; - end case; - end Value_Equal; - - procedure Error_Trans_Error (Trans : Transaction_Acc) is - begin - Error_C ("range check error on signal at "); - Error_C (Trans.File); - Error_C (":"); - Error_C (Natural (Trans.Line)); - Error_E (""); - end Error_Trans_Error; - pragma No_Return (Error_Trans_Error); - - function Find_Driver (Sig : Ghdl_Signal_Ptr) return Ghdl_Index_Type - is - Proc : Process_Acc; - begin - if Sig.S.Drivers = null then - Error ("assignment to a signal without any driver"); - end if; - Proc := Get_Current_Process; - for I in 0 .. Sig.S.Nbr_Drivers - 1 loop - if Sig.S.Drivers (I).Proc = Proc then - return I; - end if; - end loop; - Error ("assignment to a signal without a driver for the process"); - end Find_Driver; - - function Get_Driver (Sig : Ghdl_Signal_Ptr) return Driver_Acc - is - Proc : Process_Acc; - begin - if Sig.S.Drivers = null then - return null; - end if; - Proc := Get_Current_Process; - for I in 0 .. Sig.S.Nbr_Drivers - 1 loop - if Sig.S.Drivers (I).Proc = Proc then - return Sig.S.Drivers (I)'Access; - end if; - end loop; - 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 - -- a non-null value (this is of course not true for SIGNAL_END). This may - -- be used to quickly check if a signal is in the list. - -- This signal is not in the signal table. - Signal_End : Ghdl_Signal_Ptr; - - -- List of signals which have projected waveforms in the future (beyond - -- the next delta cycle). - Future_List : aliased Ghdl_Signal_Ptr; - - procedure Ghdl_Signal_Start_Assign (Sign : Ghdl_Signal_Ptr; - Reject : Std_Time; - Trans : Transaction_Acc; - After : Std_Time) - is - Assign_Time : Std_Time; - Drv : constant Ghdl_Index_Type := Find_Driver (Sign); - Drv_Ptr : constant Driver_Arr_Ptr := Sign.S.Drivers; - Driver : Driver_Type renames Drv_Ptr (Drv); - begin - -- LRM93 8.4.1 - -- It is an error if the time expression in a waveform element - -- evaluates to a negative value. - if After < 0 then - Error ("negative time expression in signal assignment"); - end if; - - if After = 0 then - -- Put SIGN on the active list if the transaction is scheduled - -- for the next delta cycle. - if Sign.Link = null then - Sign.Link := Grt.Threads.Atomic_Insert - (Ghdl_Signal_Active_Chain'access, Sign); - end if; - else - -- AFTER > 0. - -- Put SIGN on the future list. - if Sign.Flink = null then - Sign.Flink := Grt.Threads.Atomic_Insert (Future_List'access, Sign); - end if; - end if; - - Assign_Time := Current_Time + After; - if Assign_Time < 0 then - -- Beyond the future - Free_In (Trans); - return; - end if; - - -- Handle sign as direct driver. - if Driver.Last_Trans.Kind = Trans_Direct then - if After /= 0 then - Internal_Error ("direct assign with non-0 after"); - end if; - -- FIXME: can be a bound-error too! - if Trans.Kind = Trans_Value then - case Sign.Mode is - when Mode_B1 => - Driver.Last_Trans.Val_Ptr.B1 := Trans.Val.B1; - when Mode_E8 => - Driver.Last_Trans.Val_Ptr.E8 := Trans.Val.E8; - when Mode_E32 => - Driver.Last_Trans.Val_Ptr.E32 := Trans.Val.E32; - when Mode_I32 => - Driver.Last_Trans.Val_Ptr.I32 := Trans.Val.I32; - when Mode_I64 => - Driver.Last_Trans.Val_Ptr.I64 := Trans.Val.I64; - when Mode_F64 => - Driver.Last_Trans.Val_Ptr.F64 := Trans.Val.F64; - end case; - Free_In (Trans); - elsif Trans.Kind = Trans_Error then - Error_Trans_Error (Trans); - else - Internal_Error ("direct assign with non-value"); - end if; - return; - end if; - - -- LRM93 8.4.1 - -- 1. All old transactions that are projected to occur at or after the - -- time at which the earliest new transaction is projected to occur - -- are deleted from the projected output waveform. - if Driver.Last_Trans.Time >= Assign_Time then - declare - -- LAST is the last transaction to keep. - Last : Transaction_Acc; - Next : Transaction_Acc; - begin - Last := Driver.First_Trans; - -- Find the first transaction to be deleted. - Next := Last.Next; - while Next /= null and then Next.Time < Assign_Time loop - Last := Next; - Next := Next.Next; - end loop; - -- Delete old transactions. - if Next /= null then - -- Set the last transaction of the driver. - Driver.Last_Trans := Last; - -- Cut the chain. This is not strickly necessary, since - -- it will be overriden below, by appending TRANS to the - -- driver. - Last.Next := null; - -- Free removed transactions. - loop - Last := Next.Next; - Free (Next); - exit when Last = null; - Next := Last; - end loop; - end if; - end; - end if; - - -- 2. The new transaction are then appended to the projected output - -- waveform in the order of their projected occurence. - Trans.Time := Assign_Time; - Driver.Last_Trans.Next := Trans; - Driver.Last_Trans := Trans; - - -- If the initial delay is inertial delay according to the definitions - -- of section 8.4, the projected output waveform is further modified - -- as follows: - -- 1. All of the new transactions are marked. - -- 2. An old transaction is marked if the time at which it is projected - -- to occur is less than the time at which the first new transaction - -- is projected to occur minus the pulse rejection limit. - -- 3. For each remaining unmarked, old transaction, the old transaction - -- is marked if it immediatly precedes a marked transaction and its - -- value component is the same as that of the marked transaction; - -- 4. The transaction that determines the current value of the driver - -- is marked. - -- 5. All unmarked transactions (all of which are old transactions) are - -- deleted from the projected output waveform. - -- - -- GHDL: only transactions that are projected to occur at [T-R, T[ - -- can be deleted (R is the reject time, T is now + after time). - if Reject > 0 then - -- LRM93 8.4 - -- It is an error if the pulse rejection limit for any inertially - -- delayed signal assignment statement is [...] or greater than the - -- time expression associated with the first waveform element. - if Reject > After then - Error ("pulse rejection greater than first waveform delay"); - end if; - - declare - Prev : Transaction_Acc; - Next : Transaction_Acc; - begin - -- Find the first transaction after the project time less the - -- rejection time. - -- PREV will be the last old transaction which is projected to - -- occur before T - R. - Prev := Driver.First_Trans; - loop - Next := Prev.Next; - exit when Next.Time >= Assign_Time - Reject; - Prev := Next; - end loop; - - -- Scan every transaction until TRANS. If a transaction value is - -- different from the TRANS value, then delete all previous - -- transactions (from T - R to the currently scanned transaction), - -- since they are not marked. - while Next /= Trans loop - if Next.Kind /= Trans.Kind - or else - (Trans.Kind = Trans_Value - and then not Value_Equal (Next.Val, Trans.Val, Sign.Mode)) - then - -- NEXT is different from TRANS. - -- Delete ]PREV;NEXT]. - declare - D, N : Transaction_Acc; - begin - D := Prev.Next; - Next := Next.Next; - Prev.Next := Next; - loop - N := D.Next; - Free (D); - exit when N = Next; - D := N; - end loop; - end; - else - Next := Next.Next; - end if; - end loop; - - -- A previous assignment (with a 0 after time) may have put this - -- signal on the active chain. But maybe this previous - -- transaction has been removed (due to rejection) and therefore - -- this signal won't be active at the next delta. So remove it - -- from the active chain. This is a little bit costly (because - -- the chain is simply linked), but that issue doesn't appear - -- frequently. - if Sign.Link /= null - and then not Has_Transaction_In_Next_Delta (Sign) - then - if Ghdl_Signal_Active_Chain = Sign then - -- At the head of the chain. - -- FIXME: this is not atomic. - Ghdl_Signal_Active_Chain := Sign.Link; - else - -- In the middle of the chain. - declare - Prev : Ghdl_Signal_Ptr := Ghdl_Signal_Active_Chain; - begin - while Prev.Link /= Sign loop - Prev := Prev.Link; - end loop; - Prev.Link := Sign.Link; - end; - end if; - Sign.Link := null; - end if; - end; - elsif Reject /= 0 then - -- LRM93 8.4 - -- It is an error if the pulse rejection limit for any inertially - -- delayed signal assignment statement is either negative or [...]. - Error ("pulse rejection is negative"); - end if; - - -- Do some checks. - if Driver.Last_Trans.Next /= null then - Error ("ghdl_signal_start_assign internal_error"); - end if; - end Ghdl_Signal_Start_Assign; - - procedure Ghdl_Signal_Next_Assign (Sign : Ghdl_Signal_Ptr; - Val : Value_Union; - After : Std_Time) - is - Drv_Ptr : constant Driver_Arr_Ptr := Sign.S.Drivers; - Driver : Driver_Type renames Drv_Ptr (Find_Driver (Sign)); - - Trans : Transaction_Acc; - begin - if After > 0 and then Sign.Flink = null then - -- Put SIGN on the future list. - Sign.Flink := Future_List; - Future_List := Sign; - end if; - - Trans := new Transaction'(Kind => Trans_Value, - Line => 0, - Time => Current_Time + After, - Next => null, - Val => Val); - if Trans.Time <= Driver.Last_Trans.Time then - Error ("transactions not in ascending order"); - end if; - Driver.Last_Trans.Next := Trans; - 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) - is - Trans : Transaction_Acc; - begin - Trans := new Transaction'(Kind => Trans_Error, - Line => Line, - Time => 0, - Next => null, - File => File); - Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0); - end Ghdl_Signal_Simple_Assign_Error; - - procedure Ghdl_Signal_Start_Assign_Error (Sign : Ghdl_Signal_Ptr; - Rej : Std_Time; - After : Std_Time; - File : Ghdl_C_String; - Line : Ghdl_I32) - is - Trans : Transaction_Acc; - begin - Trans := new Transaction'(Kind => Trans_Error, - Line => Line, - Time => 0, - Next => null, - File => File); - Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); - end Ghdl_Signal_Start_Assign_Error; - - procedure Ghdl_Signal_Next_Assign_Error (Sign : Ghdl_Signal_Ptr; - After : Std_Time; - File : Ghdl_C_String; - Line : Ghdl_I32) - is - Drv_Ptr : constant Driver_Arr_Ptr := Sign.S.Drivers; - Driver : Driver_Type renames Drv_Ptr (Find_Driver (Sign)); - - Trans : Transaction_Acc; - begin - if After > 0 and then Sign.Flink = null then - -- Put SIGN on the future list. - Sign.Flink := Future_List; - Future_List := Sign; - end if; - - Trans := new Transaction'(Kind => Trans_Error, - Line => Line, - Time => Current_Time + After, - Next => null, - File => File); - if Trans.Time <= Driver.Last_Trans.Time then - Error ("transactions not in ascending order"); - end if; - Driver.Last_Trans.Next := Trans; - Driver.Last_Trans := Trans; - end Ghdl_Signal_Next_Assign_Error; - - procedure Ghdl_Signal_Start_Assign_Null (Sign : Ghdl_Signal_Ptr; - Rej : Std_Time; - After : Std_Time) - is - Trans : Transaction_Acc; - begin - if not Is_Signal_Guarded (Sign) then - Error ("null transaction for a non-guarded target"); - end if; - Trans := new Transaction'(Kind => Trans_Null, - Line => 0, - Time => 0, - Next => null); - Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); - end Ghdl_Signal_Start_Assign_Null; - - procedure Ghdl_Signal_Disconnect (Sign : Ghdl_Signal_Ptr) - is - Trans : Transaction_Acc; - Time : Std_Time; - begin - if not Is_Signal_Guarded (Sign) then - Error ("null transaction for a non-guarded target"); - end if; - Trans := new Transaction'(Kind => Trans_Null, - Line => 0, - Time => 0, - Next => null); - Time := Sign.S.Resolv.Disconnect_Time; - Ghdl_Signal_Start_Assign (Sign, Time, Trans, Time); - end Ghdl_Signal_Disconnect; - - procedure Ghdl_Signal_Associate (Sig : Ghdl_Signal_Ptr; Val : Value_Union) - is - begin - Sig.Value := Val; - Sig.Driving_Value := Val; - end Ghdl_Signal_Associate; - - function Ghdl_Create_Signal_B1 - (Init_Val : Ghdl_B1; - Resolv_Func : Resolver_Acc; - Resolv_Inst : System.Address) - return Ghdl_Signal_Ptr - is - begin - return Create_Signal - (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); - end Ghdl_Create_Signal_B1; - - procedure Ghdl_Signal_Init_B1 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_B1) is - begin - Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_B1, B1 => Init_Val)); - end Ghdl_Signal_Init_B1; - - procedure Ghdl_Signal_Associate_B1 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B1) is - begin - Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_B1, B1 => Val)); - end Ghdl_Signal_Associate_B1; - - procedure Ghdl_Signal_Simple_Assign_B1 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_B1) - is - Trans : Transaction_Acc; - begin - if not Sign.Has_Active - and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.B1 - and then Sign.S.Drivers (0).First_Trans.Next = null - then - return; - end if; - - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_B1, B1 => Val)); - - Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0); - end Ghdl_Signal_Simple_Assign_B1; - - procedure Ghdl_Signal_Start_Assign_B1 (Sign : Ghdl_Signal_Ptr; - Rej : Std_Time; - Val : Ghdl_B1; - After : Std_Time) - is - Trans : Transaction_Acc; - begin - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_B1, B1 => Val)); - Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); - end Ghdl_Signal_Start_Assign_B1; - - procedure Ghdl_Signal_Next_Assign_B1 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_B1; - After : Std_Time) - is - begin - Ghdl_Signal_Next_Assign - (Sign, Value_Union'(Mode => Mode_B1, B1 => Val), After); - end Ghdl_Signal_Next_Assign_B1; - - function Ghdl_Create_Signal_E8 - (Init_Val : Ghdl_E8; - Resolv_Func : Resolver_Acc; - Resolv_Inst : System.Address) - return Ghdl_Signal_Ptr - is - begin - return Create_Signal - (Mode_E8, Value_Union'(Mode => Mode_E8, E8 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); - end Ghdl_Create_Signal_E8; - - procedure Ghdl_Signal_Init_E8 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E8) is - begin - Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_E8, E8 => Init_Val)); - end Ghdl_Signal_Init_E8; - - procedure Ghdl_Signal_Associate_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8) is - begin - Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E8, E8 => Val)); - end Ghdl_Signal_Associate_E8; - - procedure Ghdl_Signal_Simple_Assign_E8 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_E8) - is - Trans : Transaction_Acc; - begin - if not Sign.Has_Active - and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.E8 - and then Sign.S.Drivers (0).First_Trans.Next = null - then - return; - end if; - - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_E8, E8 => Val)); - - Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0); - end Ghdl_Signal_Simple_Assign_E8; - - procedure Ghdl_Signal_Start_Assign_E8 (Sign : Ghdl_Signal_Ptr; - Rej : Std_Time; - Val : Ghdl_E8; - After : Std_Time) - is - Trans : Transaction_Acc; - begin - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_E8, E8 => Val)); - Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); - end Ghdl_Signal_Start_Assign_E8; - - procedure Ghdl_Signal_Next_Assign_E8 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_E8; - After : Std_Time) - is - begin - Ghdl_Signal_Next_Assign - (Sign, Value_Union'(Mode => Mode_E8, E8 => Val), After); - end Ghdl_Signal_Next_Assign_E8; - - function Ghdl_Create_Signal_E32 - (Init_Val : Ghdl_E32; - Resolv_Func : Resolver_Acc; - Resolv_Inst : System.Address) - return Ghdl_Signal_Ptr - is - begin - return Create_Signal - (Mode_E32, Value_Union'(Mode => Mode_E32, E32 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); - end Ghdl_Create_Signal_E32; - - procedure Ghdl_Signal_Init_E32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_E32) - is - begin - Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_E32, E32 => Init_Val)); - end Ghdl_Signal_Init_E32; - - procedure Ghdl_Signal_Associate_E32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E32) - is - begin - Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_E32, E32 => Val)); - end Ghdl_Signal_Associate_E32; - - procedure Ghdl_Signal_Simple_Assign_E32 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_E32) - is - Trans : Transaction_Acc; - begin - if not Sign.Has_Active - and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.E32 - and then Sign.S.Drivers (0).First_Trans.Next = null - then - return; - end if; - - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_E32, E32 => Val)); - - Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0); - end Ghdl_Signal_Simple_Assign_E32; - - procedure Ghdl_Signal_Start_Assign_E32 (Sign : Ghdl_Signal_Ptr; - Rej : Std_Time; - Val : Ghdl_E32; - After : Std_Time) - is - Trans : Transaction_Acc; - begin - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_E32, E32 => Val)); - Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); - end Ghdl_Signal_Start_Assign_E32; - - procedure Ghdl_Signal_Next_Assign_E32 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_E32; - After : Std_Time) - is - begin - Ghdl_Signal_Next_Assign - (Sign, Value_Union'(Mode => Mode_E32, E32 => Val), After); - end Ghdl_Signal_Next_Assign_E32; - - function Ghdl_Create_Signal_I32 - (Init_Val : Ghdl_I32; - Resolv_Func : Resolver_Acc; - Resolv_Inst : System.Address) - return Ghdl_Signal_Ptr - is - begin - return Create_Signal - (Mode_I32, Value_Union'(Mode => Mode_I32, I32 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); - end Ghdl_Create_Signal_I32; - - procedure Ghdl_Signal_Init_I32 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I32) - is - begin - Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_I32, I32 => Init_Val)); - end Ghdl_Signal_Init_I32; - - procedure Ghdl_Signal_Associate_I32 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I32) - is - begin - Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_I32, I32 => Val)); - end Ghdl_Signal_Associate_I32; - - procedure Ghdl_Signal_Simple_Assign_I32 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_I32) - is - Trans : Transaction_Acc; - begin - if not Sign.Has_Active - and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.I32 - and then Sign.S.Drivers (0).First_Trans.Next = null - then - return; - end if; - - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_I32, I32 => Val)); - - Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0); - end Ghdl_Signal_Simple_Assign_I32; - - procedure Ghdl_Signal_Start_Assign_I32 (Sign : Ghdl_Signal_Ptr; - Rej : Std_Time; - Val : Ghdl_I32; - After : Std_Time) - is - Trans : Transaction_Acc; - begin - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_I32, I32 => Val)); - Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); - end Ghdl_Signal_Start_Assign_I32; - - procedure Ghdl_Signal_Next_Assign_I32 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_I32; - After : Std_Time) - is - begin - Ghdl_Signal_Next_Assign - (Sign, Value_Union'(Mode => Mode_I32, I32 => Val), After); - end Ghdl_Signal_Next_Assign_I32; - - function Ghdl_Create_Signal_I64 - (Init_Val : Ghdl_I64; - Resolv_Func : Resolver_Acc; - Resolv_Inst : System.Address) - return Ghdl_Signal_Ptr - is - begin - return Create_Signal - (Mode_I64, Value_Union'(Mode => Mode_I64, I64 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); - end Ghdl_Create_Signal_I64; - - procedure Ghdl_Signal_Init_I64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_I64) - is - begin - Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_I64, I64 => Init_Val)); - end Ghdl_Signal_Init_I64; - - procedure Ghdl_Signal_Associate_I64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_I64) - is - begin - Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_I64, I64 => Val)); - end Ghdl_Signal_Associate_I64; - - procedure Ghdl_Signal_Simple_Assign_I64 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_I64) - is - Trans : Transaction_Acc; - begin - if not Sign.Has_Active - and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.I64 - and then Sign.S.Drivers (0).First_Trans.Next = null - then - return; - end if; - - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_I64, I64 => Val)); - - Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0); - end Ghdl_Signal_Simple_Assign_I64; - - procedure Ghdl_Signal_Start_Assign_I64 (Sign : Ghdl_Signal_Ptr; - Rej : Std_Time; - Val : Ghdl_I64; - After : Std_Time) - is - Trans : Transaction_Acc; - begin - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_I64, I64 => Val)); - Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); - end Ghdl_Signal_Start_Assign_I64; - - procedure Ghdl_Signal_Next_Assign_I64 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_I64; - After : Std_Time) - is - begin - Ghdl_Signal_Next_Assign - (Sign, Value_Union'(Mode => Mode_I64, I64 => Val), After); - end Ghdl_Signal_Next_Assign_I64; - - function Ghdl_Create_Signal_F64 - (Init_Val : Ghdl_F64; - Resolv_Func : Resolver_Acc; - Resolv_Inst : System.Address) - return Ghdl_Signal_Ptr - is - begin - return Create_Signal - (Mode_F64, Value_Union'(Mode => Mode_F64, F64 => Init_Val), - Get_Current_Mode_Signal, - Resolv_Func, Resolv_Inst); - end Ghdl_Create_Signal_F64; - - procedure Ghdl_Signal_Init_F64 (Sig : Ghdl_Signal_Ptr; Init_Val : Ghdl_F64) - is - begin - Ghdl_Signal_Init (Sig, Value_Union'(Mode => Mode_F64, F64 => Init_Val)); - end Ghdl_Signal_Init_F64; - - procedure Ghdl_Signal_Associate_F64 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_F64) - is - begin - Ghdl_Signal_Associate (Sig, Value_Union'(Mode => Mode_F64, F64 => Val)); - end Ghdl_Signal_Associate_F64; - - procedure Ghdl_Signal_Simple_Assign_F64 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_F64) - is - Trans : Transaction_Acc; - begin - if not Sign.Has_Active - and then Sign.Net = Net_One_Driver - and then Val = Sign.Value.F64 - and then Sign.S.Drivers (0).First_Trans.Next = null - then - return; - end if; - - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_F64, F64 => Val)); - - Ghdl_Signal_Start_Assign (Sign, 0, Trans, 0); - end Ghdl_Signal_Simple_Assign_F64; - - procedure Ghdl_Signal_Start_Assign_F64 (Sign : Ghdl_Signal_Ptr; - Rej : Std_Time; - Val : Ghdl_F64; - After : Std_Time) - is - Trans : Transaction_Acc; - begin - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Value_Union'(Mode => Mode_F64, F64 => Val)); - Ghdl_Signal_Start_Assign (Sign, Rej, Trans, After); - end Ghdl_Signal_Start_Assign_F64; - - procedure Ghdl_Signal_Next_Assign_F64 (Sign : Ghdl_Signal_Ptr; - Val : Ghdl_F64; - After : Std_Time) - is - begin - Ghdl_Signal_Next_Assign - (Sign, Value_Union'(Mode => Mode_F64, F64 => Val), After); - end Ghdl_Signal_Next_Assign_F64; - - procedure Ghdl_Signal_Internal_Checks - is - Sig : Ghdl_Signal_Ptr; - begin - for I in Sig_Table.First .. Sig_Table.Last loop - Sig := Sig_Table.Table (I); - - -- Check drivers. - case Sig.S.Mode_Sig is - when Mode_Signal_User => - for J in 1 .. Sig.S.Nbr_Drivers loop - declare - Trans : Transaction_Acc; - begin - Trans := Sig.S.Drivers (J - 1).First_Trans; - while Trans.Next /= null loop - if Trans.Next.Time < Trans.Time then - Internal_Error ("ghdl_signal_internal_checks: " - & "bad transaction order"); - end if; - Trans := Trans.Next; - end loop; - if Trans /= Sig.S.Drivers (J - 1).Last_Trans then - Internal_Error ("ghdl_signal_internal_checks: " - & "last transaction mismatch"); - end if; - end; - end loop; - when others => - null; - end case; - end loop; - end Ghdl_Signal_Internal_Checks; - - procedure Ghdl_Signal_Effective_Value (Targ : Ghdl_Signal_Ptr; - Src : Ghdl_Signal_Ptr) - is - begin - if Targ.S.Effective /= null then - Error ("internal error: already effective value"); - end if; - Targ.S.Effective := Src; - end Ghdl_Signal_Effective_Value; - - Bit_Signal_Rti : aliased Ghdl_Rtin_Object := - (Common => (Kind => Ghdl_Rtik_Signal, - Depth => 0, - Mode => Ghdl_Rti_Signal_Mode_None, - Max_Depth => 0), - Name => null, - Loc => Null_Rti_Loc, - Obj_Type => null); - - Boolean_Signal_Rti : aliased Ghdl_Rtin_Object := - (Common => (Kind => Ghdl_Rtik_Signal, - Depth => 0, - Mode => Ghdl_Rti_Signal_Mode_None, - Max_Depth => 0), - Name => null, - Loc => Null_Rti_Loc, - Obj_Type => null); - - function Ghdl_Create_Signal_Attribute - (Mode : Mode_Signal_Type; Time : Std_Time) - return Ghdl_Signal_Ptr - is - Res : Ghdl_Signal_Ptr; --- Sig_Type : Ghdl_Desc_Ptr; - begin - case Mode is - when Mode_Transaction => - Sig_Rti := To_Ghdl_Rtin_Object_Acc - (To_Ghdl_Rti_Access (Bit_Signal_Rti'Address)); - when Mode_Quiet - | Mode_Stable => - Sig_Rti := To_Ghdl_Rtin_Object_Acc - (To_Ghdl_Rti_Access (Boolean_Signal_Rti'Address)); - when others => - Internal_Error ("ghdl_create_signal_attribute"); - end case; - -- Note: bit and boolean are both mode_b1. - Res := Create_Signal - (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => True), - Mode, null, Null_Address); - Sig_Rti := null; - Last_Implicit_Signal := Res; - - if Mode /= Mode_Transaction then - Res.S.Time := Time; - Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Res.Value); - end if; - - if Time > 0 then - Res.Flink := Future_List; - Future_List := Res; - end if; - - return Res; - end Ghdl_Create_Signal_Attribute; - - function Ghdl_Create_Stable_Signal (Val : Std_Time) return Ghdl_Signal_Ptr - is - begin - return Ghdl_Create_Signal_Attribute (Mode_Stable, Val); - end Ghdl_Create_Stable_Signal; - - function Ghdl_Create_Quiet_Signal (Val : Std_Time) return Ghdl_Signal_Ptr - is - begin - return Ghdl_Create_Signal_Attribute (Mode_Quiet, Val); - end Ghdl_Create_Quiet_Signal; - - function Ghdl_Create_Transaction_Signal return Ghdl_Signal_Ptr - is - begin - return Ghdl_Create_Signal_Attribute (Mode_Transaction, 0); - end Ghdl_Create_Transaction_Signal; - - procedure Ghdl_Signal_Attribute_Register_Prefix (Sig : Ghdl_Signal_Ptr) - is - begin - Add_Port (Last_Implicit_Signal, Sig); - end Ghdl_Signal_Attribute_Register_Prefix; - - --Guard_String : constant String := "guard"; - --Guard_Name : constant Ghdl_Str_Len_Address_Type := - -- (Len => 5, Str => Guard_String'Address); - --function To_Ghdl_Str_Len_Ptr is new Ada.Unchecked_Conversion - -- (Source => System.Address, Target => Ghdl_Str_Len_Ptr); - - Guard_Rti : aliased constant Ghdl_Rtin_Object := - (Common => (Kind => Ghdl_Rtik_Signal, - Depth => 0, - Mode => Ghdl_Rti_Signal_Mode_None, - Max_Depth => 0), - Name => null, - Loc => Null_Rti_Loc, - Obj_Type => Std_Standard_Boolean_RTI_Ptr); - - function Ghdl_Signal_Create_Guard (This : System.Address; - Proc : Guard_Func_Acc) - return Ghdl_Signal_Ptr - is - Res : Ghdl_Signal_Ptr; - begin - Sig_Rti := To_Ghdl_Rtin_Object_Acc - (To_Ghdl_Rti_Access (Guard_Rti'Address)); - Res := Create_Signal - (Mode_B1, Value_Union'(Mode => Mode_B1, B1 => Proc.all (This)), - Mode_Guard, null, Null_Address); - Sig_Rti := null; - Res.S.Guard_Func := Proc; - Res.S.Guard_Instance := This; - Last_Implicit_Signal := Res; - return Res; - end Ghdl_Signal_Create_Guard; - - procedure Ghdl_Signal_Guard_Dependence (Sig : Ghdl_Signal_Ptr) - is - begin - Add_Port (Last_Implicit_Signal, Sig); - Sig.Has_Active := True; - end Ghdl_Signal_Guard_Dependence; - - function Ghdl_Create_Delayed_Signal (Sig : Ghdl_Signal_Ptr; Val : Std_Time) - return Ghdl_Signal_Ptr - is - Res : Ghdl_Signal_Ptr; - begin - Res := Create_Signal (Sig.Mode, Sig.Value, - Mode_Delayed, null, Null_Address); - Res.S.Time := Val; - if Val > 0 then - Res.Flink := Future_List; - Future_List := Res; - end if; - Res.S.Attr_Trans := new Transaction'(Kind => Trans_Value, - Line => 0, - Time => 0, - Next => null, - Val => Res.Value); - Append_Port (Res, Sig); - return Res; - end Ghdl_Create_Delayed_Signal; - - function Signal_Ptr_To_Index (Ptr : Ghdl_Signal_Ptr) return Sig_Table_Index - is - begin - -- Note: we may start from ptr.instance_name.sig_index, but - -- instance_name is *not* set for conversion signals. - for I in reverse Sig_Table.First .. Sig_Table.Last loop - if Sig_Table.Table (I) = Ptr then - return I; - end if; - end loop; - return -1; - end Signal_Ptr_To_Index; - - function Ghdl_Signal_Get_Nbr_Ports (Sig : Ghdl_Signal_Ptr) - return Ghdl_Index_Type is - begin - return Sig.Nbr_Ports; - end Ghdl_Signal_Get_Nbr_Ports; - - function Ghdl_Signal_Get_Nbr_Drivers (Sig : Ghdl_Signal_Ptr) - return Ghdl_Index_Type is - begin - return Sig.S.Nbr_Drivers; - end Ghdl_Signal_Get_Nbr_Drivers; - - function Ghdl_Signal_Read_Port - (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type) - return Ghdl_Value_Ptr - is - begin - if Index >= Sig.Nbr_Ports then - Internal_Error ("ghdl_signal_read_port: bad index"); - end if; - return To_Ghdl_Value_Ptr (Sig.Ports (Index).Driving_Value'Address); - end Ghdl_Signal_Read_Port; - - function Ghdl_Signal_Read_Driver - (Sig : Ghdl_Signal_Ptr; Index : Ghdl_Index_Type) - return Ghdl_Value_Ptr - is - Trans : Transaction_Acc; - begin - if Index >= Sig.S.Nbr_Drivers then - Internal_Error ("ghdl_signal_read_driver: bad index"); - end if; - Trans := Sig.S.Drivers (Index).First_Trans; - case Trans.Kind is - when Trans_Value => - return To_Ghdl_Value_Ptr (Trans.Val'Address); - when Trans_Direct => - Internal_Error ("ghdl_signal_read_driver: trans_direct"); - when Trans_Null => - return null; - when Trans_Error => - Error_Trans_Error (Trans); - end case; - end Ghdl_Signal_Read_Driver; - - procedure Ghdl_Signal_Conversion (Func : System.Address; - Instance : System.Address; - Src : Ghdl_Signal_Ptr; - Src_Len : Ghdl_Index_Type; - Dst : Ghdl_Signal_Ptr; - Dst_Len : Ghdl_Index_Type; - Mode : Mode_Signal_Type) - is - Data : Sig_Conversion_Acc; - Sig : Ghdl_Signal_Ptr; - begin - Data := new Sig_Conversion_Type'(Func => Func, - Instance => Instance, - Src => (-1, -1), - Dest => (-1, -1)); - Data.Src.First := Signal_Ptr_To_Index (Src); - Data.Src.Last := Data.Src.First + Sig_Table_Index (Src_Len) - 1; - - Data.Dest.First := Signal_Ptr_To_Index (Dst); - Data.Dest.Last := Data.Dest.First + Sig_Table_Index (Dst_Len) - 1; - - -- Convert DEST to new mode. - for I in Data.Dest.First .. Data.Dest.Last loop - Sig := Sig_Table.Table (I); - case Mode is - when Mode_Conv_In => - Sig.S := (Mode_Sig => Mode_Conv_In, - Conv => Data); - when Mode_Conv_Out => - Sig.S := (Mode_Sig => Mode_Conv_Out, - Conv => Data); - when others => - Internal_Error ("ghdl_signal_conversion"); - end case; - end loop; - end Ghdl_Signal_Conversion; - - procedure Ghdl_Signal_In_Conversion (Func : System.Address; - Instance : System.Address; - Src : Ghdl_Signal_Ptr; - Src_Len : Ghdl_Index_Type; - Dst : Ghdl_Signal_Ptr; - Dst_Len : Ghdl_Index_Type) - is - begin - Ghdl_Signal_Conversion - (Func, Instance, Src, Src_Len, Dst, Dst_Len, Mode_Conv_In); - end Ghdl_Signal_In_Conversion; - - procedure Ghdl_Signal_Out_Conversion (Func : System.Address; - Instance : System.Address; - Src : Ghdl_Signal_Ptr; - Src_Len : Ghdl_Index_Type; - Dst : Ghdl_Signal_Ptr; - Dst_Len : Ghdl_Index_Type) - is - begin - Ghdl_Signal_Conversion - (Func, Instance, Src, Src_Len, Dst, Dst_Len, Mode_Conv_Out); - end Ghdl_Signal_Out_Conversion; - - function Ghdl_Signal_Driving (Sig : Ghdl_Signal_Ptr) return Ghdl_B1 - is - Drv : Driver_Acc; - begin - Drv := Get_Driver (Sig); - if Drv = null then - -- FIXME: disp signal and process. - Error ("'driving error: no driver in process for signal"); - end if; - if Drv.First_Trans.Kind /= Trans_Null then - return True; - else - return False; - end if; - end Ghdl_Signal_Driving; - - function Ghdl_Signal_Driving_Value_B1 (Sig : Ghdl_Signal_Ptr) return Ghdl_B1 - is - Drv : Driver_Acc; - begin - Drv := Get_Driver (Sig); - if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then - Error ("'driving_value: no active driver in process for signal"); - else - return Drv.First_Trans.Val.B1; - end if; - end Ghdl_Signal_Driving_Value_B1; - - function Ghdl_Signal_Driving_Value_E8 (Sig : Ghdl_Signal_Ptr) - return Ghdl_E8 - is - Drv : Driver_Acc; - begin - Drv := Get_Driver (Sig); - if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then - Error ("'driving_value: no active driver in process for signal"); - else - return Drv.First_Trans.Val.E8; - end if; - end Ghdl_Signal_Driving_Value_E8; - - function Ghdl_Signal_Driving_Value_E32 (Sig : Ghdl_Signal_Ptr) - return Ghdl_E32 - is - Drv : Driver_Acc; - begin - Drv := Get_Driver (Sig); - if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then - Error ("'driving_value: no active driver in process for signal"); - else - return Drv.First_Trans.Val.E32; - end if; - end Ghdl_Signal_Driving_Value_E32; - - function Ghdl_Signal_Driving_Value_I32 (Sig : Ghdl_Signal_Ptr) - return Ghdl_I32 - is - Drv : Driver_Acc; - begin - Drv := Get_Driver (Sig); - if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then - Error ("'driving_value: no active driver in process for signal"); - else - return Drv.First_Trans.Val.I32; - end if; - end Ghdl_Signal_Driving_Value_I32; - - function Ghdl_Signal_Driving_Value_I64 (Sig : Ghdl_Signal_Ptr) - return Ghdl_I64 - is - Drv : Driver_Acc; - begin - Drv := Get_Driver (Sig); - if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then - Error ("'driving_value: no active driver in process for signal"); - else - return Drv.First_Trans.Val.I64; - end if; - end Ghdl_Signal_Driving_Value_I64; - - function Ghdl_Signal_Driving_Value_F64 (Sig : Ghdl_Signal_Ptr) - return Ghdl_F64 - is - Drv : Driver_Acc; - begin - Drv := Get_Driver (Sig); - if Drv = null or else Drv.First_Trans.Kind /= Trans_Value then - Error ("'driving_value: no active driver in process for signal"); - else - return Drv.First_Trans.Val.F64; - end if; - end Ghdl_Signal_Driving_Value_F64; - - Ghdl_Implicit_Signal_Active_Chain : Ghdl_Signal_Ptr; - - procedure Flush_Active_List - is - Sig : Ghdl_Signal_Ptr; - Next_Sig : Ghdl_Signal_Ptr; - begin - -- Free active_chain. - Sig := Ghdl_Signal_Active_Chain; - loop - Next_Sig := Sig.Link; - exit when Next_Sig = null; - Sig.Link := null; - Sig := Next_Sig; - end loop; - Ghdl_Signal_Active_Chain := Sig; - end Flush_Active_List; - - function Find_Next_Time return Std_Time - is - Res : Std_Time; - Sig : Ghdl_Signal_Ptr; - - procedure Check_Transaction (Trans : Transaction_Acc) - is - begin - if Trans = null or else Trans.Kind = Trans_Direct then - -- Activity of direct drivers is done through link. - return; - end if; - - if Trans.Time = Res and Sig.Link = null then - Sig.Link := Ghdl_Signal_Active_Chain; - Ghdl_Signal_Active_Chain := Sig; - elsif Trans.Time < Res then - Flush_Active_List; - - -- Put sig on the list. - Sig.Link := Ghdl_Signal_Active_Chain; - Ghdl_Signal_Active_Chain := Sig; - - Res := Trans.Time; - end if; - if Res = Current_Time then - -- Must have been in the active list. - Internal_Error ("find_next_time(2)"); - end if; - end Check_Transaction; - begin - -- If there is signals in the active list, then next cycle is a delta - -- cycle, so next time is current_time. - if Ghdl_Signal_Active_Chain.Link /= null then - return Current_Time; - end if; - if Ghdl_Implicit_Signal_Active_Chain.Link /= null then - return Current_Time; - end if; - Res := Std_Time'Last; - - Sig := Future_List; - while Sig.Flink /= null loop - case Sig.S.Mode_Sig is - when Mode_Signal_User => - for J in 1 .. Sig.S.Nbr_Drivers loop - Check_Transaction (Sig.S.Drivers (J - 1).First_Trans.Next); - end loop; - when Mode_Delayed - | Mode_Stable - | Mode_Quiet => - Check_Transaction (Sig.S.Attr_Trans.Next); - when others => - Internal_Error ("find_next_time(3)"); - end case; - Sig := Sig.Flink; - end loop; - return Res; - end Find_Next_Time; - --- function Get_Nbr_Non_Null_Source (Sig : Ghdl_Signal_Ptr) --- return Natural --- is --- Length : Natural; --- begin --- Length := Sig.Nbr_Ports; --- for I in 0 .. Sig.Nbr_Drivers - 1 loop --- case Sig.Drivers (I).First_Trans.Kind is --- when Trans_Value => --- Length := Length + 1; --- when Trans_Null => --- null; --- when Trans_Error => --- Error ("range check error"); --- end case; --- end loop; --- return Length; --- end Get_Nbr_Non_Null_Source; - - function To_Resolver_Acc is new Ada.Unchecked_Conversion - (Source => System.Address, Target => Resolver_Acc); - - procedure Compute_Resolved_Signal (Resolv : Resolved_Signal_Acc) - is - Sig : constant Ghdl_Signal_Ptr := - Sig_Table.Table (Resolv.Sig_Range.First); - Length : Ghdl_Index_Type; - type Bool_Array_Type is array (1 .. Sig.S.Nbr_Drivers) of Boolean; - Vec : Bool_Array_Type; - begin - -- Compute number of non-null drivers. - Length := 0; - for I in 1 .. Sig.S.Nbr_Drivers loop - case Sig.S.Drivers (I - 1).First_Trans.Kind is - when Trans_Value => - Length := Length + 1; - Vec (I) := True; - when Trans_Null => - Vec (I) := False; - when Trans_Error => - Error ("range check error"); - when Trans_Direct => - Internal_Error ("compute_resolved_signal: trans_direct"); - end case; - end loop; - - -- Check driving condition on all signals. - for J in Resolv.Sig_Range.First + 1.. Resolv.Sig_Range.Last loop - for I in 1 .. Sig.S.Nbr_Drivers loop - if (Sig_Table.Table (J).S.Drivers (I - 1).First_Trans.Kind - /= Trans_Null) - xor Vec (I) - then - Error ("null-transaction required"); - end if; - end loop; - end loop; - - -- if no driving sources and register, exit. - if Length = 0 - and then Sig.Nbr_Ports = 0 - and then Sig.Sig_Kind = Kind_Signal_Register - then - return; - end if; - - -- Call the procedure. - Resolv.Resolv_Proc.all (Resolv.Resolv_Inst, - Resolv.Resolv_Ptr, - Vec'Address, - Length, - Sig.S.Nbr_Drivers, - Sig.Nbr_Ports); - end Compute_Resolved_Signal; - - procedure Call_Conversion_Function (Conv : Sig_Conversion_Acc) - is - F : Conversion_Func_Acc; - begin - F := To_Conversion_Func_Acc (Conv.Func); - F.all (Conv.Instance); - end Call_Conversion_Function; - - procedure Resume_Process_If_Event - (Sig : Ghdl_Signal_Ptr; Proc : Process_Acc) - is - El : Action_List_Acc; - begin - El := new Action_List'(Dynamic => False, - Proc => Proc, - Next => Sig.Event_List); - Sig.Event_List := El; - end Resume_Process_If_Event; - - -- Order of signals: - -- To be computed: driving value or/and effective value - -- To be considered: ports, signals, implicit signals, resolution, - -- conversion - -- - - procedure Add_Propagation (P : Propagation_Type) is - begin - Propagation.Increment_Last; - Propagation.Table (Propagation.Last) := P; - end Add_Propagation; - - procedure Add_Forward_Propagation (Sig : Ghdl_Signal_Ptr) - is - begin - for I in 1 .. Sig.Nbr_Ports loop - Add_Propagation - ((Kind => Imp_Forward_Build, - Forward => new Forward_Build_Type'(Src => Sig.Ports (I - 1), - Targ => Sig))); - end loop; - end Add_Forward_Propagation; - - -- Put SIG in PROPAGATION table until ORDER level. - procedure Order_Signal (Sig : Ghdl_Signal_Ptr; Order : Propag_Order_Flag); - - -- Return TRUE is the effective value of SIG is the driving value of SIG. - function Is_Eff_Drv (Sig : Ghdl_Signal_Ptr) return Boolean - is - begin - case Sig.S.Mode_Sig is - when Mode_Signal - | Mode_Buffer => - return True; - when Mode_Linkage - | Mode_Out => - -- No effective value. - return False; - when Mode_Inout - | Mode_In => - if Sig.S.Effective = null then - if Sig.S.Nbr_Drivers > 0 or Sig.Nbr_Ports > 0 then - -- Only for inout. - return True; - else - return False; - end if; - else - return False; - end if; - when Mode_Conv_In - | Mode_Conv_Out => - return False; - when Mode_Stable - | Mode_Guard - | Mode_Quiet - | Mode_Transaction - | Mode_Delayed => - return True; - when Mode_End => - return False; - end case; - end Is_Eff_Drv; - - procedure Order_Signal_List (Sig : Ghdl_Signal_Ptr; - Order : Propag_Order_Flag) - is - begin - for I in 1 .. Sig.Nbr_Ports loop - Order_Signal (Sig.Ports (I - 1), Order); - end loop; - end Order_Signal_List; - - -- Put SIG in PROPAGATION table until ORDER level. - procedure Order_Signal (Sig : Ghdl_Signal_Ptr; Order : Propag_Order_Flag) - is - begin - if Sig = null then - return; - end if; - - -- Catch infinite loops, which must never happen. - -- Also exit if the signal is already fully ordered. - case Sig.Flags.Propag is - when Propag_None => - null; - when Propag_Being_Driving => - Internal_Error ("order_signal: being driving"); - when Propag_Being_Effective => - Internal_Error ("order_signal: being effective"); - when Propag_Driving => - null; - when Propag_Done => - -- If sig was already handled, nothing to do! - return; - end case; - - -- First, the driving value. - if Sig.Flags.Propag = Propag_None then - case Sig.S.Mode_Sig is - when Mode_Signal_User => - if Sig.S.Nbr_Drivers = 0 and Sig.Nbr_Ports = 0 then - -- No source. - Sig.Flags.Propag := Propag_Driving; - elsif Sig.S.Resolv = null then - -- Not resolved (so at most one source). - if Sig.S.Nbr_Drivers = 1 then - -- Not resolved, 1 source : a driver. - if Is_Eff_Drv (Sig) then - Add_Propagation ((Kind => Eff_One_Driver, Sig => Sig)); - Sig.Flags.Propag := Propag_Done; - else - Add_Propagation ((Kind => Drv_One_Driver, Sig => Sig)); - Sig.Flags.Propag := Propag_Driving; - end if; - else - Sig.Flags.Propag := Propag_Being_Driving; - -- not resolved, 1 source : Source is a port. - Order_Signal (Sig.Ports (0), Propag_Driving); - if Is_Eff_Drv (Sig) then - Add_Propagation ((Kind => Eff_One_Port, Sig => Sig)); - Sig.Flags.Propag := Propag_Done; - else - Add_Propagation ((Kind => Drv_One_Port, Sig => Sig)); - Sig.Flags.Propag := Propag_Driving; - end if; - end if; - else - -- Resolved signal. - declare - Resolv : Resolved_Signal_Acc; - S : Ghdl_Signal_Ptr; - begin - -- Compute driving value of brothers. - Resolv := Sig.S.Resolv; - for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last - loop - S := Sig_Table.Table (I); - if S.Flags.Propag /= Propag_None then - Internal_Error ("order_signal(1)"); - end if; - S.Flags.Propag := Propag_Being_Driving; - end loop; - for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last - loop - S := Sig_Table.Table (I); - -- Compute driving value of the sources. - for J in 1 .. S.Nbr_Ports loop - Order_Signal (S.Ports (J - 1), Propag_Driving); - end loop; - end loop; - for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last - loop - S := Sig_Table.Table (I); - S.Flags.Propag := Propag_Driving; - end loop; - - if Is_Eff_Drv (Sig) then - if Resolv.Sig_Range.First = Resolv.Sig_Range.Last then - Add_Propagation ((Kind => Eff_One_Resolved, - Sig => Sig)); - else - Add_Propagation ((Kind => Eff_Multiple, - Resolv => Resolv)); - end if; - else - if Resolv.Sig_Range.First = Resolv.Sig_Range.Last then - Add_Propagation ((Kind => Drv_One_Resolved, - Sig => Sig)); - else - Add_Propagation ((Kind => Drv_Multiple, - Resolv => Resolv)); - end if; - end if; - end; - end if; - when Mode_Signal_Implicit => - Sig.Flags.Propag := Propag_Being_Driving; - Order_Signal_List (Sig, Propag_Done); - Sig.Flags.Propag := Propag_Done; - if Sig.S.Mode_Sig in Mode_Signal_Forward then - Add_Forward_Propagation (Sig); - end if; - case Mode_Signal_Implicit (Sig.S.Mode_Sig) is - when Mode_Guard => - Add_Propagation ((Kind => Imp_Guard, Sig => Sig)); - when Mode_Stable => - Add_Propagation ((Kind => Imp_Stable, Sig => Sig)); - when Mode_Quiet => - Add_Propagation ((Kind => Imp_Quiet, Sig => Sig)); - when Mode_Transaction => - Add_Propagation ((Kind => Imp_Transaction, Sig => Sig)); - when Mode_Delayed => - Add_Propagation ((Kind => Imp_Delayed, Sig => Sig)); - end case; - return; - when Mode_Conv_In => - -- In conversion signals have no driving value - null; - when Mode_Conv_Out => - declare - Conv : Sig_Conversion_Acc; - begin - Conv := Sig.S.Conv; - for I in Conv.Dest.First .. Conv.Dest.Last loop - Sig_Table.Table (I).Flags.Propag := Propag_Being_Driving; - end loop; - for I in Conv.Src.First .. Conv.Src.Last loop - Order_Signal (Sig_Table.Table (I), Propag_Driving); - end loop; - Add_Propagation ((Kind => Out_Conversion, Conv => Conv)); - for I in Conv.Dest.First .. Conv.Dest.Last loop - Sig_Table.Table (I).Flags.Propag := Propag_Done; - end loop; - end; - when Mode_End => - Internal_Error ("order_signal: mode_end"); - end case; - end if; - - -- Effective value. - if Order = Propag_Driving then - -- Will be done later. - return; - end if; - - case Sig.S.Mode_Sig is - when Mode_Signal - | Mode_Buffer => - -- Effective value is driving value. - Sig.Flags.Propag := Propag_Done; - when Mode_Linkage - | Mode_Out => - -- No effective value. - Sig.Flags.Propag := Propag_Done; - when Mode_Inout - | Mode_In => - if Sig.S.Effective = null then - -- Effective value is driving value or initial value. - null; - else - Sig.Flags.Propag := Propag_Being_Effective; - Order_Signal (Sig.S.Effective, Propag_Done); - Add_Propagation ((Kind => Eff_Actual, Sig => Sig)); - Sig.Flags.Propag := Propag_Done; - end if; - when Mode_Stable - | Mode_Guard - | Mode_Quiet - | Mode_Transaction - | Mode_Delayed => - -- Sig.Propag is already set to PROPAG_DONE. - null; - when Mode_Conv_In => - declare - Conv : Sig_Conversion_Acc; - begin - Conv := Sig.S.Conv; - for I in Conv.Dest.First .. Conv.Dest.Last loop - Sig_Table.Table (I).Flags.Propag := Propag_Being_Effective; - end loop; - for I in Conv.Src.First .. Conv.Src.Last loop - Order_Signal (Sig_Table.Table (I), Propag_Done); - end loop; - Add_Propagation ((Kind => In_Conversion, Conv => Conv)); - for I in Conv.Dest.First .. Conv.Dest.Last loop - Sig_Table.Table (I).Flags.Propag := Propag_Done; - end loop; - end; - when Mode_Conv_Out => - -- No effective value. - null; - when Mode_End => - Internal_Error ("order_signal: mode_end"); - end case; - end Order_Signal; - - procedure Set_Net (Sig : Ghdl_Signal_Ptr; - Net : Signal_Net_Type; - Link : Ghdl_Signal_Ptr) - is - use Astdio; - use Stdio; - begin - if Sig = null then - return; - end if; - - if Boolean'(False) then - Put ("set_net "); - Put_I32 (stdout, Ghdl_I32 (Net)); - Put (" on "); - Put (stdout, Sig.all'Address); - Put (" "); - Disp_Signals.Disp_Mode_Signal (Sig.S.Mode_Sig); - New_Line; - end if; - - if Sig.Net /= No_Signal_Net then - if Sig.Net /= Net then - -- Renumber. - if Boolean'(False) then - Put ("set_net renumber "); - Put_I32 (stdout, Ghdl_I32 (Net)); - Put (" on "); - Put (stdout, Sig.all'Address); - New_Line; - end if; - - declare - S : Ghdl_Signal_Ptr; - Old : constant Signal_Net_Type := Sig.Net; - begin - -- Merge the old net into NET. - S := Sig; - loop - S.Net := Net; - S := S.Link; - exit when S = Sig; - end loop; - - -- Add to the ring. - S := Sig.Link; - Sig.Link := Link.Link; - Link.Link := S; - - -- Check. - for I in Sig_Table.First .. Sig_Table.Last loop - if Sig_Table.Table (I).Net = Old then --- Disp_Signals.Disp_Signals_Table; --- Disp_Signals.Disp_Signals_Map; - - Internal_Error ("set_net: link corrupted"); - end if; - end loop; - end; - end if; - return; - end if; - - Sig.Net := Net; - - -- Add SIG in the LINK ring. - -- Note: this works even if LINK is not a ring (ie, LINK.link = null). - if Link.Link = null and then Sig /= Link then - Internal_Error ("set_net: bad link"); - end if; - Sig.Link := Link.Link; - Link.Link := Sig; - - -- Dependences. - case Sig.S.Mode_Sig is - when Mode_Signal_User => - for I in 1 .. Sig.Nbr_Ports loop - Set_Net (Sig.Ports (I - 1), Net, Link); - end loop; - Set_Net (Sig.S.Effective, Net, Link); - if Sig.S.Resolv /= null then - for I in Sig.S.Resolv.Sig_Range.First - .. Sig.S.Resolv.Sig_Range.Last - loop - Set_Net (Sig_Table.Table (I), Net, Link); - end loop; - end if; - when Mode_Signal_Forward => - null; - when Mode_Transaction - | Mode_Guard => - for I in 1 .. Sig.Nbr_Ports loop - Set_Net (Sig.Ports (I - 1), Net, Link); - end loop; - when Mode_Conv_In - | Mode_Conv_Out => - declare - S : Ghdl_Signal_Ptr; - Conv : Sig_Conversion_Acc; - begin - Conv := Sig.S.Conv; - S := Sig_Table.Table (Conv.Src.First); - if Sig = S or else S.Net /= Net then - for J in Conv.Src.First .. Conv.Src.Last loop - Set_Net (Sig_Table.Table (J), Net, Link); - end loop; - for J in Conv.Dest.First .. Conv.Dest.Last loop - Set_Net (Sig_Table.Table (J), Net, Link); - end loop; - end if; - end; - when Mode_End => - Internal_Error ("set_net"); - end case; - end Set_Net; - - function Get_Propagation_Net (P : Signal_Net_Type) return Signal_Net_Type - is - begin - case Propagation.Table (P).Kind is - when Drv_Multiple - | Eff_Multiple => - return Sig_Table.Table - (Propagation.Table (P).Resolv.Sig_Range.First).Net; - when In_Conversion - | Out_Conversion => - return Sig_Table.Table - (Propagation.Table (P).Conv.Src.First).Net; - when Imp_Forward_Build => - return Propagation.Table (P).Forward.Src.Net; - when others => - return Propagation.Table (P).Sig.Net; - end case; - end Get_Propagation_Net; - - Last_Signal_Net : Signal_Net_Type; - - -- Create a net for SIG, or if one of its dependences has already a net, - -- merge SIG in this net. - procedure Merge_Net (Sig : Ghdl_Signal_Ptr) - is - begin - if Sig.S.Mode_Sig in Mode_Signal_User then - if Sig.S.Resolv = null - and then Sig.Nbr_Ports = 0 - and then Sig.S.Effective = null - then - Internal_Error ("merge_net(1)"); - end if; - - if Sig.S.Effective /= null - and then Sig.S.Effective.Net /= No_Signal_Net - then - -- Avoid to create a net, just merge. - Set_Net (Sig, Sig.S.Effective.Net, Sig.S.Effective); - return; - end if; - end if; - - if Sig.Nbr_Ports >= 1 - and then Sig.Ports (0).Net /= No_Signal_Net - then - -- Avoid to create a net, just merge. - Set_Net (Sig, Sig.Ports (0).Net, Sig.Ports (0)); - else - Last_Signal_Net := Last_Signal_Net + 1; - Set_Net (Sig, Last_Signal_Net, Sig); - end if; - end Merge_Net; - - -- Create nets. - -- For all signals, set the net field. - procedure Create_Nets - is - Sig : Ghdl_Signal_Ptr; - begin - Last_Signal_Net := No_Signal_Net; - - for I in reverse Propagation.First .. Propagation.Last loop - case Propagation.Table (I).Kind is - when Drv_Error - | Prop_End => - null; - when Drv_One_Driver - | Eff_One_Driver => - null; - when Eff_One_Resolved => - Sig := Propagation.Table (I).Sig; - -- Do not create a net if the signal has no dependences. - if Sig.Net = No_Signal_Net - and then (Sig.S.Effective /= null or Sig.Nbr_Ports /= 0) - then - Merge_Net (Sig); - end if; - when Drv_One_Port - | Eff_One_Port - | Imp_Guard - | Imp_Transaction - | Eff_Actual - | Drv_One_Resolved => - Sig := Propagation.Table (I).Sig; - if Sig.Net = No_Signal_Net then - Merge_Net (Sig); - end if; - when Imp_Forward => - -- Should not yet appear. - Internal_Error ("create_nets - forward"); - when Imp_Forward_Build => - Sig := Propagation.Table (I).Forward.Src; - if Sig.Net = No_Signal_Net then - -- Create a new net with only sig. - Last_Signal_Net := Last_Signal_Net + 1; - Set_Net (Sig, Last_Signal_Net, Sig); - end if; - when Imp_Quiet - | Imp_Stable - | Imp_Delayed => - Sig := Propagation.Table (I).Sig; - if Sig.Net = No_Signal_Net then - -- Create a new net with only sig. - Last_Signal_Net := Last_Signal_Net + 1; - Sig.Net := Last_Signal_Net; - Sig.Link := Sig; - end if; - when Drv_Multiple - | Eff_Multiple => - declare - Resolv : Resolved_Signal_Acc; - Link : Ghdl_Signal_Ptr; - begin - Last_Signal_Net := Last_Signal_Net + 1; - Resolv := Propagation.Table (I).Resolv; - Link := Sig_Table.Table (Resolv.Sig_Range.First); - for J in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop - Set_Net (Sig_Table.Table (J), Last_Signal_Net, Link); - end loop; - end; - when In_Conversion - | Out_Conversion => - declare - Conv : Sig_Conversion_Acc; - Link : Ghdl_Signal_Ptr; - begin - Conv := Propagation.Table (I).Conv; - Link := Sig_Table.Table (Conv.Src.First); - if Link.Net = No_Signal_Net then - Last_Signal_Net := Last_Signal_Net + 1; - Set_Net (Link, Last_Signal_Net, Link); - end if; - end; - end case; - end loop; - - -- Reorder propagation table. - declare - type Off_Array is array (Signal_Net_Type range <>) of Signal_Net_Type; - Offs : Off_Array (0 .. Last_Signal_Net) := (others => 0); - - Last_Off : Signal_Net_Type; - Num : Signal_Net_Type; - --- procedure Disp_Offs --- is --- use Grt.Astdio; --- use Grt.Stdio; --- begin --- for I in Offs'Range loop --- if Offs (I) /= 0 then --- Put_I32 (stdout, Ghdl_I32 (I)); --- Put (": "); --- Put_I32 (stdout, Ghdl_I32 (Offs (I))); --- New_Line; --- end if; --- end loop; --- end Disp_Offs; - - type Propag_Array is array (Signal_Net_Type range <>) - of Propagation_Type; - - procedure Deallocate is new Ada.Unchecked_Deallocation - (Object => Forward_Build_Type, Name => Forward_Build_Acc); - - Net : Signal_Net_Type; - begin - -- 1) Count number of propagation cell per net. - for I in Propagation.First .. Propagation.Last loop - Net := Get_Propagation_Net (I); - Offs (Net) := Offs (Net) + 1; - end loop; - - -- 2) Convert numbers to offsets. - Last_Off := 1; - for I in 1 .. Last_Signal_Net loop - Num := Offs (I); - if Num /= 0 then - -- Reserve one slot for a prepended 'prop_end'. - Offs (I) := Last_Off + 1; - Last_Off := Last_Off + 1 + Num; - end if; - end loop; - Offs (0) := Last_Off + 1; - - declare - Propag : Propag_Array (1 .. Last_Off); -- := (others => 0); - begin - for I in Propagation.First .. Propagation.Last loop - Net := Get_Propagation_Net (I); - if Net /= No_Signal_Net then - Propag (Offs (Net)) := Propagation.Table (I); - Offs (Net) := Offs (Net) + 1; - end if; - end loop; - Propagation.Set_Last (Last_Off); - Propagation.Release; - for I in Propagation.First .. Propagation.Last loop - if Propag (I).Kind = Imp_Forward_Build then - Propagation.Table (I) := (Kind => Imp_Forward, - Sig => Propag (I).Forward.Targ); - Deallocate (Propag (I).Forward); - else - Propagation.Table (I) := Propag (I); - end if; - end loop; - end; - for I in 1 .. Last_Signal_Net loop - -- Ignore holes. - if Offs (I) /= 0 then - Propagation.Table (Offs (I)) := - (Kind => Prop_End, Updated => True); - end if; - end loop; - Propagation.Table (1) := (Kind => Prop_End, Updated => True); - - -- 4) Convert back from offset to start position (on the prop_end - -- cell). - Offs (0) := 1; - Last_Off := 1; - for I in 1 .. Last_Signal_Net loop - if Offs (I) /= 0 then - Num := Offs (I); - Offs (I) := Last_Off; - Last_Off := Num; - end if; - end loop; - - -- 5) Re-map the nets to cell indexes. - for I in Sig_Table.First .. Sig_Table.Last loop - Sig := Sig_Table.Table (I); - if Sig.Net = No_Signal_Net then - if Sig.S.Resolv /= null then - Sig.Net := Net_One_Resolved; - elsif Sig.S.Nbr_Drivers = 1 then - if Sig.S.Drivers (0).Last_Trans.Kind = Trans_Direct then - Sig.Net := Net_One_Direct; - else - Sig.Net := Net_One_Driver; - end if; - end if; - else - Sig.Net := Offs (Sig.Net); - end if; - Sig.Link := null; - end loop; - end; - end Create_Nets; - - function Get_Nbr_Future return Ghdl_I32 - is - Res : Ghdl_I32; - Sig : Ghdl_Signal_Ptr; - begin - Res := 0; - Sig := Future_List; - while Sig.Flink /= null loop - Res := Res + 1; - Sig := Sig.Flink; - end loop; - return Res; - end Get_Nbr_Future; - - -- Check every scalar subelement of a resolved signal has a driver - -- in the same process. - procedure Check_Resolved_Driver (Resolv : Resolved_Signal_Acc) - is - First_Sig : Ghdl_Signal_Ptr; - Nbr : Ghdl_Index_Type; - begin - First_Sig := Sig_Table.Table (Resolv.Sig_Range.First); - Nbr := First_Sig.S.Nbr_Drivers; - for I in Resolv.Sig_Range.First + 1 .. Resolv.Sig_Range.Last loop - if Sig_Table.Table (I).S.Nbr_Drivers /= Nbr then - -- FIXME: provide more information (signal name, process name). - Error ("missing drivers for subelement of a resolved signal"); - end if; - end loop; - end Check_Resolved_Driver; - - Ieee_Std_Logic_1164_Resolved_Resolv_Ptr : Address; - pragma Import (C, Ieee_Std_Logic_1164_Resolved_Resolv_Ptr, - "ieee__std_logic_1164__resolved_RESOLV_ptr"); - - procedure Free is new Ada.Unchecked_Deallocation - (Name => Resolved_Signal_Acc, Object => Resolved_Signal_Type); - - procedure Order_All_Signals - is - Sig : Ghdl_Signal_Ptr; - Resolv : Resolved_Signal_Acc; - begin - -- Do checks and optimization. - for I in Sig_Table.First .. Sig_Table.Last loop - Sig := Sig_Table.Table (I); - - -- LRM 5.3 - -- If, by the above rules, no disconnection specification applies to - -- the drivers of a guarded, scalar signal S whose type mark is T - -- (including a scalar subelement of a composite signal), then the - -- following default disconnection specification is implicitly - -- assumed: - -- disconnect S : T after 0 ns; - if Sig.S.Mode_Sig in Mode_Signal_User then - Resolv := Sig.S.Resolv; - if Resolv /= null and then Resolv.Disconnect_Time = Bad_Time then - Resolv.Disconnect_Time := 0; - end if; - - if Resolv /= null - and then Resolv.Sig_Range.First = I - and then Resolv.Sig_Range.Last > I - then - -- Check every scalar subelement of a resolved signal - -- has a driver in the same process. - Check_Resolved_Driver (Resolv); - end if; - - if Resolv /= null - and then Resolv.Sig_Range.First = I - and then Resolv.Sig_Range.Last = I - and then - (Resolv.Resolv_Proc - = To_Resolver_Acc (Ieee_Std_Logic_1164_Resolved_Resolv_Ptr)) - and then Sig.S.Nbr_Drivers + Sig.Nbr_Ports <= 1 - then - -- Optimization: remove resolver if there is at most one - -- source. - Free (Sig.S.Resolv); - end if; - end if; - end loop; - - -- Really order them. - for I in Sig_Table.First .. Sig_Table.Last loop - Order_Signal (Sig_Table.Table (I), Propag_Driving); - end loop; - for I in Sig_Table.First .. Sig_Table.Last loop - Order_Signal (Sig_Table.Table (I), Propag_Done); - end loop; - - Create_Nets; - end Order_All_Signals; - - -- Add SIG in active_chain. - procedure Add_Active_Chain (Sig : Ghdl_Signal_Ptr); - pragma Inline (Add_Active_Chain); - - procedure Add_Active_Chain (Sig : Ghdl_Signal_Ptr) - is - begin - if Sig.Link = null then - Sig.Link := Ghdl_Signal_Active_Chain; - Ghdl_Signal_Active_Chain := Sig; - end if; - end Add_Active_Chain; - - 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); - - procedure Mark_Active (Sig : Ghdl_Signal_Ptr) - is - begin - if not Sig.Active then - Sig.Active := True; - Sig.Last_Active := Current_Time; - Sig.Alink := Clear_List; - Clear_List := Sig; - end if; - end Mark_Active; - - procedure Set_Guard_Activity (Sig : Ghdl_Signal_Ptr) is - begin - for I in 1 .. Sig.Nbr_Ports loop - if Sig.Ports (I - 1).Active then - Mark_Active (Sig); - return; - end if; - end loop; - end Set_Guard_Activity; - - procedure Set_Stable_Quiet_Activity - (Mode : Propagation_Kind_Type; Sig : Ghdl_Signal_Ptr) is - begin - case Mode is - when Imp_Stable => - for I in 0 .. Sig.Nbr_Ports - 1 loop - if Sig.Ports (I).Event then - Mark_Active (Sig); - return; - end if; - end loop; - when Imp_Quiet - | Imp_Transaction => - for I in 0 .. Sig.Nbr_Ports - 1 loop - if Sig.Ports (I).Active then - Mark_Active (Sig); - return; - end if; - end loop; - when others => - Internal_Error ("set_stable_quiet_activity"); - end case; - end Set_Stable_Quiet_Activity; - - function Get_Resolved_Activity (Sig : Ghdl_Signal_Ptr) return Boolean - is - Trans : Transaction_Acc; - Res : Boolean := False; - begin - for J in 1 .. Sig.S.Nbr_Drivers loop - Trans := Sig.S.Drivers (J - 1).First_Trans.Next; - if Trans /= null then - if Trans.Kind = Trans_Direct then - Direct_Assign (Sig.S.Drivers (J - 1).First_Trans.Val, - Trans.Val_Ptr, Sig.Mode); - -- In fact we knew the signal was active! - Res := True; - elsif Trans.Time = Current_Time then - Free (Sig.S.Drivers (J - 1).First_Trans); - Sig.S.Drivers (J - 1).First_Trans := Trans; - Res := True; - end if; - end if; - end loop; - if Res then - return True; - end if; - for J in 1 .. Sig.Nbr_Ports loop - if Sig.Ports (J - 1).Active then - return True; - end if; - end loop; - return False; - end Get_Resolved_Activity; - - procedure Set_Conversion_Activity (Conv : Sig_Conversion_Acc) - is - Active : Boolean := False; - begin - for I in Conv.Src.First .. Conv.Src.Last loop - Active := Active or Sig_Table.Table (I).Active; - end loop; - if Active then - Call_Conversion_Function (Conv); - end if; - for I in Conv.Dest.First .. Conv.Dest.Last loop - Sig_Table.Table (I).Active := Active; - end loop; - end Set_Conversion_Activity; - - procedure Delayed_Implicit_Process (Sig : Ghdl_Signal_Ptr) - is - Pfx : Ghdl_Signal_Ptr; - Trans : Transaction_Acc; - Last : Transaction_Acc; - Prev : Transaction_Acc; - begin - Pfx := Sig.Ports (0); - if Pfx.Event then - -- LRM 14.1 - -- P: process (S) - -- begin - -- R <= transport S after T; - -- end process; - Trans := new Transaction'(Kind => Trans_Value, - Line => 0, - Time => Current_Time + Sig.S.Time, - Next => null, - Val => Pfx.Value); - -- Find the last transaction. - Last := Sig.S.Attr_Trans; - Prev := Last; - while Last.Next /= null loop - Prev := Last; - Last := Last.Next; - end loop; - -- Maybe, remove it. - if Last.Time > Trans.Time then - Internal_Error ("delayed time"); - elsif Last.Time = Trans.Time then - if Prev /= Last then - Free (Last); - else - -- No transaction. - if Last.Time /= 0 then - -- This can happen only at time = 0. - Internal_Error ("delayed"); - end if; - end if; - else - Prev := Last; - end if; - -- Append the transaction. - Prev.Next := Trans; - if Sig.S.Time = 0 then - Add_Active_Chain (Sig); - end if; - end if; - end Delayed_Implicit_Process; - - -- Set the effective value of signal SIG to VAL. - -- If the value is different from the previous one, resume processes. - procedure Set_Effective_Value (Sig : Ghdl_Signal_Ptr; Val : Value_Union) - is - El : Action_List_Acc; - begin - if not Value_Equal (Sig.Value, Val, Sig.Mode) then - Sig.Last_Value := Sig.Value; - Sig.Value := Val; - Sig.Event := True; - Sig.Last_Event := Current_Time; - Sig.Flags.Cyc_Event := True; - - El := Sig.Event_List; - while El /= null loop - Resume_Process (El.Proc); - El := El.Next; - end loop; - end if; - end Set_Effective_Value; - - procedure Run_Propagation (Start : Signal_Net_Type) - is - I : Signal_Net_Type; - Sig : Ghdl_Signal_Ptr; - Trans : Transaction_Acc; - First_Trans : Transaction_Acc; - begin - I := Start; - loop - -- First: the driving value. - case Propagation.Table (I).Kind is - when Drv_One_Driver - | Eff_One_Driver => - Sig := Propagation.Table (I).Sig; - First_Trans := Sig.S.Drivers (0).First_Trans; - Trans := First_Trans.Next; - if Trans /= null then - if Trans.Kind = Trans_Direct then - -- Note: already or will be marked as active in - -- update_signals. - Mark_Active (Sig); - Direct_Assign (First_Trans.Val, - Trans.Val_Ptr, Sig.Mode); - Sig.Driving_Value := First_Trans.Val; - elsif Trans.Time = Current_Time then - Mark_Active (Sig); - Free (First_Trans); - Sig.S.Drivers (0).First_Trans := Trans; - case Trans.Kind is - when Trans_Value => - Sig.Driving_Value := Trans.Val; - when Trans_Direct => - Internal_Error ("run_propagation: trans_direct"); - when Trans_Null => - Error ("null transaction"); - when Trans_Error => - Error_Trans_Error (Trans); - end case; - end if; - end if; - when Drv_One_Resolved - | Eff_One_Resolved => - Sig := Propagation.Table (I).Sig; - if Get_Resolved_Activity (Sig) then - Mark_Active (Sig); - Compute_Resolved_Signal (Propagation.Table (I).Sig.S.Resolv); - end if; - when Drv_One_Port - | Eff_One_Port => - Sig := Propagation.Table (I).Sig; - if Sig.Ports (0).Active then - Mark_Active (Sig); - Sig.Driving_Value := Sig.Ports (0).Driving_Value; - end if; - when Eff_Actual => - Sig := Propagation.Table (I).Sig; - -- Note: the signal may have drivers (inout ports). - if Sig.S.Effective.Active and not Sig.Active then - Mark_Active (Sig); - end if; - when Drv_Multiple - | Eff_Multiple => - declare - Active : Boolean := False; - Resolv : Resolved_Signal_Acc; - begin - Resolv := Propagation.Table (I).Resolv; - for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop - Sig := Sig_Table.Table (I); - Active := Active or Get_Resolved_Activity (Sig); - end loop; - if Active then - -- Mark the first signal as active (since only this one - -- will be checked to set effective value). - for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last - loop - Mark_Active (Sig_Table.Table (I)); - end loop; - Compute_Resolved_Signal (Resolv); - end if; - end; - when Imp_Guard - | Imp_Stable - | Imp_Quiet - | Imp_Transaction - | Imp_Forward_Build => - null; - when Imp_Forward => - Sig := Propagation.Table (I).Sig; - if Sig.Link = null then - Sig.Link := Ghdl_Implicit_Signal_Active_Chain; - Ghdl_Implicit_Signal_Active_Chain := Sig; - end if; - when Imp_Delayed => - Sig := Propagation.Table (I).Sig; - Trans := Sig.S.Attr_Trans.Next; - if Trans /= null and then Trans.Time = Current_Time then - Mark_Active (Sig); - Free (Sig.S.Attr_Trans); - Sig.S.Attr_Trans := Trans; - Sig.Driving_Value := Trans.Val; - end if; - when In_Conversion => - null; - when Out_Conversion => - Set_Conversion_Activity (Propagation.Table (I).Conv); - when Prop_End => - return; - when Drv_Error => - Internal_Error ("update signals"); - end case; - - -- Second: the effective value. - case Propagation.Table (I).Kind is - when Drv_One_Driver - | Drv_One_Port - | Drv_One_Resolved - | Drv_Multiple => - null; - when Eff_One_Driver - | Eff_One_Port - | Eff_One_Resolved => - Sig := Propagation.Table (I).Sig; - if Sig.Active then - Set_Effective_Value (Sig, Sig.Driving_Value); - end if; - when Eff_Multiple => - declare - Resolv : Resolved_Signal_Acc; - begin - Resolv := Propagation.Table (I).Resolv; - if Sig_Table.Table (Resolv.Sig_Range.First).Active then - -- If one signal is active, all are active. - for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last - loop - Sig := Sig_Table.Table (I); - Set_Effective_Value (Sig, Sig.Driving_Value); - end loop; - end if; - end; - when Eff_Actual => - Sig := Propagation.Table (I).Sig; - if Sig.Active then - Set_Effective_Value (Sig, Sig.S.Effective.Value); - end if; - when Imp_Forward - | Imp_Forward_Build => - null; - when Imp_Guard => - -- Guard signal is active iff one of its dependence is active. - Sig := Propagation.Table (I).Sig; - Set_Guard_Activity (Sig); - if Sig.Active then - Sig.Driving_Value.B1 := - Sig.S.Guard_Func.all (Sig.S.Guard_Instance); - Set_Effective_Value (Sig, Sig.Driving_Value); - end if; - when Imp_Stable - | Imp_Quiet => - Sig := Propagation.Table (I).Sig; - Set_Stable_Quiet_Activity (Propagation.Table (I).Kind, Sig); - if Sig.Active then - Sig.Driving_Value := - Value_Union'(Mode => Mode_B1, B1 => False); - -- Set driver. - Trans := new Transaction' - (Kind => Trans_Value, - Line => 0, - Time => Current_Time + Sig.S.Time, - Next => null, - Val => Value_Union'(Mode => Mode_B1, B1 => True)); - if Sig.S.Attr_Trans.Next /= null then - Free (Sig.S.Attr_Trans.Next); - end if; - Sig.S.Attr_Trans.Next := Trans; - Set_Effective_Value (Sig, Sig.Driving_Value); - if Sig.S.Time = 0 then - Add_Active_Chain (Sig); - end if; - else - Trans := Sig.S.Attr_Trans.Next; - if Trans /= null and then Trans.Time = Current_Time then - Mark_Active (Sig); - Free (Sig.S.Attr_Trans); - Sig.S.Attr_Trans := Trans; - Sig.Driving_Value := Trans.Val; - Set_Effective_Value (Sig, Sig.Driving_Value); - end if; - end if; - when Imp_Transaction => - -- LRM 12.6.3 Updating Implicit Signals - -- Finally, for any implicit signal S'Transaction, the current - -- value of the signal is modified if and only if S is active. - -- If signal S is active, then S'Transaction is updated by - -- assigning the value of the expression (not S'Transaction) - -- to the variable representing the current value of - -- S'Transaction. - Sig := Propagation.Table (I).Sig; - for I in 0 .. Sig.Nbr_Ports - 1 loop - if Sig.Ports (I).Active then - Mark_Active (Sig); - Set_Effective_Value - (Sig, Value_Union'(Mode => Mode_B1, - B1 => not Sig.Value.B1)); - exit; - end if; - end loop; - when Imp_Delayed => - Sig := Propagation.Table (I).Sig; - if Sig.Active then - Set_Effective_Value (Sig, Sig.Driving_Value); - end if; - Delayed_Implicit_Process (Sig); - when In_Conversion => - Set_Conversion_Activity (Propagation.Table (I).Conv); - when Out_Conversion => - null; - when Prop_End => - null; - when Drv_Error => - Internal_Error ("run_propagation(2)"); - end case; - I := I + 1; - end loop; - end Run_Propagation; - - procedure Reset_Active_Flag - is - Sig : Ghdl_Signal_Ptr; - begin - -- 1) Reset active flag. - Sig := Clear_List; - Clear_List := null; - while Sig /= null loop - if Options.Flag_Stats then - if Sig.Active then - Nbr_Active := Nbr_Active + 1; - end if; - if Sig.Event then - Nbr_Events := Nbr_Events + 1; - end if; - end if; - Sig.Active := False; - Sig.Event := False; - - Sig := Sig.Alink; - end loop; - --- for I in Sig_Table.First .. Sig_Table.Last loop --- Sig := Sig_Table.Table (I); --- if Sig.Active or Sig.Event then --- Internal_Error ("reset_active_flag"); --- end if; --- end loop; - end Reset_Active_Flag; - - procedure Update_Signals - is - Sig : Ghdl_Signal_Ptr; - Next_Sig : Ghdl_Signal_Ptr; - Trans : Transaction_Acc; - begin - -- LRM93 12.6.2 - -- 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 - Next_Sig := Sig.Link; - Sig.Link := null; - - case Sig.Net is - when Net_One_Driver => - -- This signal is active. - Mark_Active (Sig); - - Trans := Sig.S.Drivers (0).First_Trans.Next; - Free (Sig.S.Drivers (0).First_Trans); - Sig.S.Drivers (0).First_Trans := Trans; - case Trans.Kind is - when Trans_Value => - Sig.Driving_Value := Trans.Val; - when Trans_Direct => - Internal_Error ("update_signals: trans_direct"); - when Trans_Null => - Error ("null transaction"); - when Trans_Error => - Error_Trans_Error (Trans); - end case; - Set_Effective_Value (Sig, Sig.Driving_Value); - - 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); - Sig.S.Drivers (0).First_Trans.Val := Sig.Driving_Value; - Set_Effective_Value (Sig, Sig.Driving_Value); - - 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; - if Trans /= null then - if Trans.Kind = Trans_Direct then - Direct_Assign (Sig.S.Drivers (J - 1).First_Trans.Val, - Trans.Val_Ptr, Sig.Mode); - elsif Trans.Time = Current_Time then - Free (Sig.S.Drivers (J - 1).First_Trans); - Sig.S.Drivers (J - 1).First_Trans := Trans; - end if; - end if; - end loop; - Compute_Resolved_Signal (Sig.S.Resolv); - Set_Effective_Value (Sig, Sig.Driving_Value); - - when No_Signal_Net => - 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); - - -- Put it on the list, so that updated flag will be cleared. - Add_Active_Chain (Sig); - end if; - end case; - - Sig := Next_Sig; - end loop; - - -- Implicit signals (forwarded). - loop - Sig := Ghdl_Implicit_Signal_Active_Chain; - exit when Sig.Link = null; - Ghdl_Implicit_Signal_Active_Chain := Sig.Link; - Sig.Link := null; - - if not Propagation.Table (Sig.Net).Updated then - Propagation.Table (Sig.Net).Updated := True; - Run_Propagation (Sig.Net + 1); - - -- Put it on the list, so that updated flag will be cleared. - Add_Active_Chain (Sig); - end if; - end loop; - - -- Un-mark updated. - Sig := Ghdl_Signal_Active_Chain; - Ghdl_Signal_Active_Chain := Signal_End; - while Sig.Link /= null loop - Propagation.Table (Sig.Net).Updated := False; - Next_Sig := Sig.Link; - Sig.Link := null; - - -- Maybe put SIG in the active list, if it will be active during - -- the next cycle. - -- This can happen only for 'quiet, 'stable or 'delayed. - case Sig.S.Mode_Sig is - when Mode_Stable - | Mode_Quiet - | Mode_Delayed => - declare - Trans : Transaction_Acc; - begin - Trans := Sig.S.Attr_Trans.Next; - if Trans /= null and then Trans.Time = Current_Time then - Sig.Link := Ghdl_Implicit_Signal_Active_Chain; - Ghdl_Implicit_Signal_Active_Chain := Sig; - end if; - end; - when others => - null; - end case; - - Sig := Next_Sig; - end loop; - end Update_Signals; - - procedure Run_Propagation_Init (Start : Signal_Net_Type) - is - I : Signal_Net_Type; - Sig : Ghdl_Signal_Ptr; - begin - I := Start; - loop - -- First: the driving value. - case Propagation.Table (I).Kind is - when Drv_One_Driver - | Eff_One_Driver => - -- Nothing to do: drivers were already created. - null; - when Drv_One_Resolved - | Eff_One_Resolved => - -- Execute the resolution function. - Sig := Propagation.Table (I).Sig; - if Sig.Nbr_Ports > 0 then - Compute_Resolved_Signal (Sig.S.Resolv); - end if; - when Drv_One_Port - | Eff_One_Port => - -- Copy value. - Sig := Propagation.Table (I).Sig; - Sig.Driving_Value := Sig.Ports (0).Driving_Value; - when Eff_Actual => - null; - when Drv_Multiple - | Eff_Multiple => - Compute_Resolved_Signal (Propagation.Table (I).Resolv); - when Imp_Guard - | Imp_Stable - | Imp_Quiet - | Imp_Transaction - | Imp_Forward - | Imp_Forward_Build => - null; - when Imp_Delayed => - -- LRM 14.1 - -- Assuming that the initial value of R is the same as the - -- initial value of S, [...] - Sig := Propagation.Table (I).Sig; - Sig.Driving_Value := Sig.Ports (0).Driving_Value; - when In_Conversion => - null; - when Out_Conversion => - Call_Conversion_Function (Propagation.Table (I).Conv); - when Prop_End => - return; - when Drv_Error => - Internal_Error ("init_signals"); - end case; - - -- Second: the effective value. - case Propagation.Table (I).Kind is - when Drv_One_Driver - | Drv_One_Port - | Drv_One_Resolved - | Drv_Multiple => - null; - when Eff_One_Driver - | Eff_One_Port - | Eff_One_Resolved - | Imp_Delayed => - Sig := Propagation.Table (I).Sig; - Sig.Value := Sig.Driving_Value; - when Eff_Multiple => - declare - Resolv : Resolved_Signal_Acc; - begin - Resolv := Propagation.Table (I).Resolv; - for I in Resolv.Sig_Range.First .. Resolv.Sig_Range.Last loop - Sig := Sig_Table.Table (I); - Sig.Value := Sig.Driving_Value; - end loop; - end; - when Eff_Actual => - Sig := Propagation.Table (I).Sig; - Sig.Value := Sig.S.Effective.Value; - when Imp_Guard => - -- Guard signal is active iff one of its dependence is active. - Sig := Propagation.Table (I).Sig; - Sig.Driving_Value.B1 := - Sig.S.Guard_Func.all (Sig.S.Guard_Instance); - Sig.Value := Sig.Driving_Value; - when Imp_Stable - | Imp_Quiet - | Imp_Transaction - | Imp_Forward - | Imp_Forward_Build => - -- Already initialized during creation. - null; - when In_Conversion => - Call_Conversion_Function (Propagation.Table (I).Conv); - when Out_Conversion => - null; - when Prop_End => - null; - when Drv_Error => - Internal_Error ("init_signals(2)"); - end case; - - I := I + 1; - end loop; - end Run_Propagation_Init; - - procedure Init_Signals - is - Sig : Ghdl_Signal_Ptr; - begin - for I in Sig_Table.First .. Sig_Table.Last loop - Sig := Sig_Table.Table (I); - - case Sig.Net is - when Net_One_Driver - | Net_One_Direct => - -- Nothing to do: drivers were already created. - null; - - when Net_One_Resolved => - Sig.Has_Active := True; - if Sig.S.Nbr_Drivers + Sig.Nbr_Ports > 0 then - Compute_Resolved_Signal (Sig.S.Resolv); - Sig.Value := Sig.Driving_Value; - end if; - - when No_Signal_Net => - null; - - when others => - if Propagation.Table (Sig.Net).Updated then - Propagation.Table (Sig.Net).Updated := False; - Run_Propagation_Init (Sig.Net + 1); - end if; - end case; - end loop; - - end Init_Signals; - - procedure Init is - begin - Signal_End := new Ghdl_Signal'(Value => (Mode => Mode_B1, - B1 => False), - Driving_Value => (Mode => Mode_B1, - B1 => False), - Last_Value => (Mode => Mode_B1, - B1 => False), - Last_Event => 0, - Last_Active => 0, - Event => False, - Active => False, - Has_Active => False, - Is_Direct_Active => False, - Sig_Kind => Kind_Signal_No, - Mode => Mode_B1, - - Flags => (Propag => Propag_None, - Is_Dumped => False, - Cyc_Event => False, - Seen => False), - - Net => No_Signal_Net, - Link => null, - Alink => null, - Flink => null, - - Event_List => null, - Rti => null, - - Nbr_Ports => 0, - Ports => null, - - S => (Mode_Sig => Mode_End)); - - Ghdl_Signal_Active_Chain := Signal_End; - Ghdl_Implicit_Signal_Active_Chain := Signal_End; - Future_List := Signal_End; - - Boolean_Signal_Rti.Obj_Type := Std_Standard_Boolean_RTI_Ptr; - Bit_Signal_Rti.Obj_Type := Std_Standard_Bit_RTI_Ptr; - end Init; - -end Grt.Signals; |