-- 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.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); -- 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 Assign (Targ : out Value_Union; Val : Value_Union; 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 Assign; function Read_Value (Value_Ptr : Ghdl_Value_Ptr; Mode : Mode_Type) return Value_Union is begin case Mode is when Mode_B1 => return (Mode => Mode_B1, B1 => Value_Ptr.B1); when Mode_E8 => return (Mode => Mode_E8, E8 => Value_Ptr.E8); when Mode_E32 => return (Mode => Mode_E32, E32 => Value_Ptr.E32); when Mode_I32 => return (Mode => Mode_I32, I32 => Value_Ptr.I32); when Mode_I64 => return (Mode => Mode_I64, I64 => Value_Ptr.I64); when Mode_F64 => return (Mode => Mode_F64, F64 => Value_Ptr.F64); end case; end Read_Value; -- For direct drivers, only a pointer is available and it may not be -- aligned. Hence this version of Assign. procedure Assign (Targ : Ghdl_Value_Ptr; 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 Assign; procedure Assign (Targ : Ghdl_Value_Ptr; Val : Value_Union; 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 Assign; procedure Ghdl_Signal_Name_Rti (Sig : Ghdl_Rti_Access; Ctxt : Ghdl_Rti_Access; Addr : Address) is pragma Unreferenced (Ctxt); pragma Unreferenced (Addr); Sig_Rti : constant Ghdl_Rtin_Object_Acc := To_Ghdl_Rtin_Object_Acc (Sig); begin 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_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.Flags.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; Value_Ptr : Ghdl_Value_Ptr; 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); Init_Val : Value_Union; 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; Init_Val := Read_Value (Value_Ptr, Mode); Res := new Ghdl_Signal'(Value_Ptr => Value_Ptr, 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, Mode => Mode, Flags => (Propag => Propag_None, Sig_Kind => Sig_Kind, Is_Direct_Active => False, Is_Dumped => False, RO_Event => False, Seen => False), Net => No_Signal_Net, Link => null, Alink => null, Flink => null, Event_List => null, 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 Assign (Sig.Value_Ptr, Val, Sig.Mode); 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. Put (stderr, "for signal: "); Disp_Signals.Put_Signal_Name (stderr, Sig); New_Line (stderr); 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 Proc : constant Process_Acc := Get_Current_Process; 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; begin 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 => Read_Value (Sign.Value_Ptr, Sign.Mode)); 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 => Read_Value (Sign.Value_Ptr, Sign.Mode)); 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; -- Initialize driver value. Assign (Drv, Sign.Value_Ptr, Sign.Mode); 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; 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.Flags.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 that will be active in the next delta cycle. Ghdl_Signal_Active_Chain : aliased Ghdl_Signal_Ptr; -- List of implicit signals that will be active in the next cycle. -- They are put in a different chain (other than ghdl_signal_active_chain), -- because their handling is different. FIXME: try to merge them ? Ghdl_Implicit_Signal_Active_Chain : 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 Assign (Driver.Last_Trans.Val_Ptr, Trans.Val, Sign.Mode); 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.Flags.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 Assign (Sig.Value_Ptr, Val, Sig.Mode); Sig.Driving_Value := Val; end Ghdl_Signal_Associate; function Ghdl_Create_Signal_B1 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal (Mode_B1, Val_Ptr, 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_Ptr.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 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal (Mode_E8, Val_Ptr, 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_Ptr.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 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal (Mode_E32, Val_Ptr, 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_Ptr.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 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal (Mode_I32, Val_Ptr, 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_Ptr.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 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal (Mode_I64, Val_Ptr, 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_Ptr.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 (Val_Ptr : Ghdl_Value_Ptr; Resolv_Func : Resolver_Acc; Resolv_Inst : System.Address) return Ghdl_Signal_Ptr is begin return Create_Signal (Mode_F64, Val_Ptr, 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_Ptr.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; function Ghdl_Create_Signal_Attribute (Val_Ptr : Ghdl_Value_Ptr; Mode : Mode_Signal_Type; Time : Std_Time) return Ghdl_Signal_Ptr is Res : Ghdl_Signal_Ptr; begin -- Note: bit and boolean are both mode_b1. Val_Ptr.B1 := True; Res := Create_Signal (Mode_B1, Val_Ptr, Mode, null, Null_Address); 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 => (Mode => Mode_B1, B1 => True)); 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_Ptr : Ghdl_Value_Ptr; Val : Std_Time) return Ghdl_Signal_Ptr is begin return Ghdl_Create_Signal_Attribute (Val_Ptr, Mode_Stable, Val); end Ghdl_Create_Stable_Signal; function Ghdl_Create_Quiet_Signal (Val_Ptr : Ghdl_Value_Ptr; Val : Std_Time) return Ghdl_Signal_Ptr is begin return Ghdl_Create_Signal_Attribute (Val_Ptr, Mode_Quiet, Val); end Ghdl_Create_Quiet_Signal; function Ghdl_Create_Transaction_Signal (Val_Ptr : Ghdl_Value_Ptr) return Ghdl_Signal_Ptr is begin return Ghdl_Create_Signal_Attribute (Val_Ptr, 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; function Ghdl_Signal_Create_Guard (Val_Ptr : Ghdl_Value_Ptr; This : System.Address; Proc : Guard_Func_Acc) return Ghdl_Signal_Ptr is Res : Ghdl_Signal_Ptr; begin Val_Ptr.B1 := Proc.all (This); Res := Create_Signal (Mode_B1, Val_Ptr, Mode_Guard, null, Null_Address); 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_Ptr : Ghdl_Value_Ptr; Val : Std_Time) return Ghdl_Signal_Ptr is Res : Ghdl_Signal_Ptr; begin Assign (Val_Ptr, Sig.Value_Ptr, Sig.Mode); Res := Create_Signal (Sig.Mode, Val_Ptr, 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 => Read_Value (Val_Ptr, Sig.Mode)); 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; type Force_Value_Kind is (Force_Driving, Force_Effective); -- To add: Release_Driving, Release_Effective type Force_Value (Kind : Force_Value_Kind); type Force_Value_Acc is access Force_Value; type Force_Value (Kind : Force_Value_Kind) is record Next : Force_Value_Acc; Sig : Ghdl_Signal_Ptr; Val : aliased Value_Union; end record; procedure Free is new Ada.Unchecked_Deallocation (Force_Value, Force_Value_Acc); -- Chain of forced values for the next cycle. Force_Value_First : Force_Value_Acc; Force_Value_Last : Force_Value_Acc; procedure Append_Force_Value (F : Force_Value_Acc) is begin if Force_Value_First = null then Force_Value_First := F; else Force_Value_Last.Next := F; end if; Force_Value_Last := F; end Append_Force_Value; procedure Ghdl_Signal_Force_Driving_B1 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B1) is begin Append_Force_Value (new Force_Value'(Kind => Force_Driving, Next => null, Sig => Sig, Val => (Mode => Mode_B1, B1 => Val))); end Ghdl_Signal_Force_Driving_B1; procedure Ghdl_Signal_Force_Effective_B1 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_B1) is begin Append_Force_Value (new Force_Value'(Kind => Force_Effective, Next => null, Sig => Sig, Val => (Mode => Mode_B1, B1 => Val))); end Ghdl_Signal_Force_Effective_B1; procedure Ghdl_Signal_Force_Driving_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8) is begin Append_Force_Value (new Force_Value'(Kind => Force_Driving, Next => null, Sig => Sig, Val => (Mode => Mode_E8, E8 => Val))); end Ghdl_Signal_Force_Driving_E8; procedure Ghdl_Signal_Force_Effective_E8 (Sig : Ghdl_Signal_Ptr; Val : Ghdl_E8) is begin Append_Force_Value (new Force_Value'(Kind => Force_Effective, Next => null, Sig => Sig, Val => (Mode => Mode_E8, E8 => Val))); end Ghdl_Signal_Force_Effective_E8; -- Updated by Find_Next_Time to the list of signal that would be active -- at the time returned (if not current_time). Next_Signal_Active_Chain : Ghdl_Signal_Ptr; -- Remove all (but Signal_End) signals in the active chain. procedure Flush_Active_Chain is Sig : Ghdl_Signal_Ptr; Next_Sig : Ghdl_Signal_Ptr; begin -- Free active_chain. Sig := Next_Signal_Active_Chain; loop Next_Sig := Sig.Link; exit when Next_Sig = null; Sig.Link := null; Sig := Next_Sig; end loop; Next_Signal_Active_Chain := Sig; end Flush_Active_Chain; function Find_Next_Time (Tn : Std_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 -- Put to active list. Sig.Link := Next_Signal_Active_Chain; Next_Signal_Active_Chain := Sig; elsif Trans.Time < Res then Flush_Active_Chain; -- Put sig on the list. Sig.Link := Next_Signal_Active_Chain; Next_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 pragma Assert (Tn >= Current_Time); -- 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 Force_Value_First /= null then return Current_Time; end if; if Ghdl_Implicit_Signal_Active_Chain.Link /= null then return Current_Time; end if; Res := Tn; 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; procedure Update_Active_Chain is begin pragma Assert (Ghdl_Signal_Active_Chain.Link = null); Ghdl_Signal_Active_Chain := Next_Signal_Active_Chain; Next_Signal_Active_Chain := Signal_End; end Update_Active_Chain; -- 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.Flags.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 | Mode_Out => return True; when Mode_Linkage => -- 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 | Mode_Out => -- Effective value is driving value. Sig.Flags.Propag := Propag_Done; when Mode_Linkage => -- 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 and then Sig.Flags.Sig_Kind = Kind_Signal_No 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 Assign (Sig.S.Drivers (J - 1).First_Trans.Val, Trans.Val_Ptr.all, 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 : constant Ghdl_Signal_Ptr := Sig.Ports (0); Ntime : Std_Time; Trans : Transaction_Acc; Last : Transaction_Acc; Prev : Transaction_Acc; Val : Value_Union; begin if Pfx.Event then -- LRM 14.1 -- P: process (S) -- begin -- R <= transport S after T; -- end process; Ntime := Current_Time + Sig.S.Time; -- Find the last transaction. Last := Sig.S.Attr_Trans; Prev := Last; while Last.Next /= null loop Prev := Last; Last := Last.Next; end loop; -- The transaction are scheduled after the last one. pragma Assert (Last.Time <= Ntime); Val := Read_Value (Pfx.Value_Ptr, Pfx.Mode); if Last.Time = Ntime then -- Change the projected value. Last.Val := Val; else -- Create the transaction. Trans := new Transaction'(Kind => Trans_Value, Line => 0, Time => Ntime, Next => null, Val => Val); -- Append the transaction. Prev.Next := Trans; end if; 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 : Ghdl_Value_Ptr) is El : Action_List_Acc; begin case Sig.Mode is when Mode_B1 => if Sig.Value_Ptr.B1 = Val.B1 then return; end if; Sig.Last_Value.B1 := Sig.Value_Ptr.B1; Sig.Value_Ptr.B1 := Val.B1; when Mode_E8 => if Sig.Value_Ptr.E8 = Val.E8 then return; end if; Sig.Last_Value.E8 := Sig.Value_Ptr.E8; Sig.Value_Ptr.E8 := Val.E8; when Mode_E32 => if Sig.Value_Ptr.E32 = Val.E32 then return; end if; Sig.Last_Value.E32 := Sig.Value_Ptr.E32; Sig.Value_Ptr.E32 := Val.E32; when Mode_I32 => if Sig.Value_Ptr.I32 = Val.I32 then return; end if; Sig.Last_Value.I32 := Sig.Value_Ptr.I32; Sig.Value_Ptr.I32 := Val.I32; when Mode_I64 => if Sig.Value_Ptr.I64 = Val.I64 then return; end if; Sig.Last_Value.I64 := Sig.Value_Ptr.I64; Sig.Value_Ptr.I64 := Val.I64; when Mode_F64 => if Sig.Value_Ptr.F64 = Val.F64 then return; end if; Sig.Last_Value.F64 := Sig.Value_Ptr.F64; Sig.Value_Ptr.F64 := Val.F64; end case; Sig.Event := True; Sig.Last_Event := Current_Time; Sig.Flags.RO_Event := True; El := Sig.Event_List; while El /= null loop Resume_Process (El.Proc); El := El.Next; end loop; 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); Assign (First_Trans.Val, Trans.Val_Ptr.all, 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'Unrestricted_Access); 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'Unrestricted_Access); 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_Ptr); 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'Unrestricted_Access); 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'Unrestricted_Access); 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'Unrestricted_Access); 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. declare Val : aliased Value_Union; begin Sig := Propagation.Table (I).Sig; Val := (Mode => Mode_B1, B1 => not Sig.Value_Ptr.B1); for I in 0 .. Sig.Nbr_Ports - 1 loop if Sig.Ports (I).Active then Mark_Active (Sig); Set_Effective_Value (Sig, Val'Unrestricted_access); exit; end if; end loop; end; when Imp_Delayed => Sig := Propagation.Table (I).Sig; if Sig.Active then Set_Effective_Value (Sig, Sig.Driving_Value'Unrestricted_Access); 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; -- Forced signals. if Force_Value_First /= null then declare Fv : Force_Value_Acc; Next_Fv : Force_Value_Acc; begin Fv := Force_Value_First; while Fv /= null loop Sig := Fv.Sig; -- FIXME: Implement the full semantic of force: really force, -- only set driving/effective value, release... case Fv.Kind is when Force_Driving => Mark_Active (Sig); Sig.Driving_Value := Fv.Val; Set_Effective_Value (Sig, Sig.Driving_Value'Access); when Force_Effective => Mark_Active (Sig); Set_Effective_Value (Sig, Fv.Val'Access); end case; Next_Fv := Fv.Next; Free (Fv); Fv := Next_Fv; end loop; Force_Value_First := null; Force_Value_Last := null; end; end if; -- 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'Unrestricted_Access); when Net_One_Direct => Mark_Active (Sig); Sig.Flags.Is_Direct_Active := False; Trans := Sig.S.Drivers (0).Last_Trans; Assign (Sig.Driving_Value, Trans.Val_Ptr.all, Sig.Mode); Sig.S.Drivers (0).First_Trans.Val := Sig.Driving_Value; Set_Effective_Value (Sig, Sig.Driving_Value'Unrestricted_Access); when Net_One_Resolved => -- This signal is active. Mark_Active (Sig); Sig.Flags.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 Assign (Sig.S.Drivers (J - 1).First_Trans.Val, Trans.Val_Ptr.all, 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'Unrestricted_Access); when No_Signal_Net => Internal_Error ("update_signals: no_signal_net"); when others => Sig.Flags.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; Assign (Sig.Value_Ptr, Sig.Driving_Value, Sig.Mode); 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); Assign (Sig.Value_Ptr, Sig.Driving_Value, Sig.Mode); end loop; end; when Eff_Actual => Sig := Propagation.Table (I).Sig; Assign (Sig.Value_Ptr, Sig.S.Effective.Value_Ptr, Sig.Mode); 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); Assign (Sig.Value_Ptr, Sig.Driving_Value, Sig.Mode); 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); Assign (Sig.Value_Ptr, Sig.Driving_Value, Sig.Mode); 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_Ptr => null, 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, Mode => Mode_B1, Flags => (Propag => Propag_None, Sig_Kind => Kind_Signal_No, Is_Direct_Active => False, Is_Dumped => False, RO_Event => False, Seen => False), Net => No_Signal_Net, Link => null, Alink => null, Flink => null, Event_List => 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; Next_Signal_Active_Chain := Signal_End; end Init; end Grt.Signals;