diff options
Diffstat (limited to 'translate')
| -rw-r--r-- | translate/ghdldrv/ghdlrun.adb | 10 | ||||
| -rw-r--r-- | translate/ghdldrv/ghdlsimul.adb | 55 | ||||
| -rw-r--r-- | translate/grt/grt-signals.adb | 52 | ||||
| -rw-r--r-- | translate/grt/grt-signals.ads | 38 | ||||
| -rw-r--r-- | translate/trans_decls.ads | 9 | ||||
| -rw-r--r-- | translate/translation.adb | 313 |
6 files changed, 147 insertions, 330 deletions
diff --git a/translate/ghdldrv/ghdlrun.adb b/translate/ghdldrv/ghdlrun.adb index fb05df7..7dbce3d 100644 --- a/translate/ghdldrv/ghdlrun.adb +++ b/translate/ghdldrv/ghdlrun.adb @@ -304,13 +304,10 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Now, Grt.Types.Current_Time'Address); - Def (Trans_Decls.Ghdl_Signal_Active_Chain, - Grt.Signals.Ghdl_Signal_Active_Chain'Address); - Def (Trans_Decls.Ghdl_Process_Add_Driver, Grt.Signals.Ghdl_Process_Add_Driver'Address); - Def (Trans_Decls.Ghdl_Signal_Direct_Driver, - Grt.Signals.Ghdl_Signal_Direct_Driver'Address); + Def (Trans_Decls.Ghdl_Signal_Add_Direct_Driver, + Grt.Signals.Ghdl_Signal_Add_Direct_Driver'Address); Def (Trans_Decls.Ghdl_Signal_Add_Source, Grt.Signals.Ghdl_Signal_Add_Source'Address); @@ -366,6 +363,9 @@ package body Ghdlrun is Def (Trans_Decls.Ghdl_Signal_Start_Assign_Null, Grt.Signals.Ghdl_Signal_Start_Assign_Null'Address); + Def (Trans_Decls.Ghdl_Signal_Direct_Assign, + Grt.Signals.Ghdl_Signal_Direct_Assign'Address); + Def (Trans_Decls.Ghdl_Create_Signal_B2, Grt.Signals.Ghdl_Create_Signal_B2'Address); Def (Trans_Decls.Ghdl_Signal_Init_B2, diff --git a/translate/ghdldrv/ghdlsimul.adb b/translate/ghdldrv/ghdlsimul.adb index d2a7772..a3f20ae 100644 --- a/translate/ghdldrv/ghdlsimul.adb +++ b/translate/ghdldrv/ghdlsimul.adb @@ -48,6 +48,9 @@ with Grtlink; package body Ghdlsimul is + -- FIXME: reuse simulation.top_config + Top_Conf : Iir; + procedure Compile_Init (Analyze_Only : Boolean) is begin if Analyze_Only then @@ -72,6 +75,11 @@ package body Ghdlsimul is procedure Compile_Elab (Cmd_Name : String; Args : Argument_List; Opt_Arg : out Natural) is + use Name_Table; + use Types; + + First_Id : Name_Id; + Sec_Id : Name_Id; begin Extract_Elab_Unit (Cmd_Name, Args, Opt_Arg); @@ -82,6 +90,31 @@ package body Ghdlsimul is -- This may happen (bad entity for example). raise Compilation_Error; end if; + + First_Id := Get_Identifier (Prim_Name.all); + if Sec_Name = null then + Sec_Id := Null_Identifier; + else + Sec_Id := Get_Identifier (Sec_Name.all); + end if; + Top_Conf := Configuration.Configure (First_Id, Sec_Id); + if Top_Conf = Null_Iir then + raise Compilation_Error; + end if; + + -- Check (and possibly abandon) if entity can be at the top of the + -- hierarchy. + declare + Conf_Unit : constant Iir := Get_Library_Unit (Top_Conf); + Arch : constant Iir := + Get_Block_Specification (Get_Block_Configuration (Conf_Unit)); + Entity : constant Iir := Get_Entity (Arch); + begin + Configuration.Check_Entity_Declaration_Top (Entity); + if Nbr_Errors > 0 then + raise Compilation_Error; + end if; + end; end Compile_Elab; -- Set options. @@ -114,6 +147,8 @@ package body Ghdlsimul is Simulation.Trace_Simulation := True; elsif Arg.all = "--trace-stmt" then Execution.Trace_Statements := True; + elsif Arg.all = "--stats" then + Simulation.Disp_Stats := True; elsif Arg.all = "-i" then Simulation.Flag_Interractive := True; else @@ -133,26 +168,8 @@ package body Ghdlsimul is end loop; end Set_Run_Options; - procedure Run - is - use Name_Table; - use Types; - - First_Id : Name_Id; - Sec_Id : Name_Id; - Top_Conf : Iir; + procedure Run is begin - First_Id := Get_Identifier (Prim_Name.all); - if Sec_Name = null then - Sec_Id := Null_Identifier; - else - Sec_Id := Get_Identifier (Sec_Name.all); - end if; - Top_Conf := Configuration.Configure (First_Id, Sec_Id); - if Top_Conf = Null_Iir then - raise Compilation_Error; - end if; - Grtlink.Flag_String := Flags.Flag_String; Simulation.Simulation_Entity (Top_Conf); diff --git a/translate/grt/grt-signals.adb b/translate/grt/grt-signals.adb index dfcda96..8b8953e 100644 --- a/translate/grt/grt-signals.adb +++ b/translate/grt/grt-signals.adb @@ -173,6 +173,7 @@ package body Grt.Signals is Has_Active => False, Sig_Kind => Sig_Kind, + Is_Direct_Active => False, Mode => Mode, Flags => (Propag => Propag_None, Is_Dumped => False, @@ -336,8 +337,8 @@ package body Grt.Signals is end if; end Ghdl_Process_Add_Driver; - procedure Ghdl_Signal_Direct_Driver (Sign : Ghdl_Signal_Ptr; - Drv : Ghdl_Value_Ptr) + procedure Ghdl_Signal_Add_Direct_Driver (Sign : Ghdl_Signal_Ptr; + Drv : Ghdl_Value_Ptr) is Trans : Transaction_Acc; Trans1 : Transaction_Acc; @@ -360,7 +361,7 @@ package body Grt.Signals is Val_Ptr => Drv); Sign.S.Drivers (Sign.S.Nbr_Drivers - 1).Last_Trans := Trans1; Trans.Next := Trans1; - end Ghdl_Signal_Direct_Driver; + end Ghdl_Signal_Add_Direct_Driver; procedure Append_Port (Targ : Ghdl_Signal_Ptr; Src : Ghdl_Signal_Ptr) is @@ -505,6 +506,32 @@ package body Grt.Signals is return null; end Get_Driver; + -- Return TRUE iff SIG has a future transaction for the current time, + -- ie iff SIG will be active in the next delta cycle. This is used to + -- recompute wether SIG must be in the active chain. SIG must be a user + -- signal. + function Has_Transaction_In_Next_Delta (Sig : Ghdl_Signal_Ptr) + return Boolean is + begin + if Sig.Is_Direct_Active then + return True; + end if; + + for I in 1 .. Sig.S.Nbr_Drivers loop + declare + Trans : constant Transaction_Acc := + Sig.S.Drivers (I - 1).First_Trans.Next; + begin + if Trans.Kind /= Trans_Direct + and then Trans.Time = Current_Time + then + return True; + end if; + end; + end loop; + return False; + end Has_Transaction_In_Next_Delta; + -- Unused but well-known signal which always terminate -- ghdl_signal_active_chain. -- As a consequence, every element of the chain has a link field set to @@ -707,7 +734,7 @@ package body Grt.Signals is -- the chain is simply linked), but that issue doesn't appear -- frequently. if Sign.Link /= null - and then Driver.First_Trans.Next.Time /= Current_Time + and then not Has_Transaction_In_Next_Delta (Sign) then if Ghdl_Signal_Active_Chain = Sign then -- At the head of the chain. @@ -767,6 +794,17 @@ package body Grt.Signals is Driver.Last_Trans := Trans; end Ghdl_Signal_Next_Assign; + procedure Ghdl_Signal_Direct_Assign (Sign : Ghdl_Signal_Ptr) is + begin + if Sign.Link = null then + Sign.Link := Grt.Threads.Atomic_Insert + (Ghdl_Signal_Active_Chain'access, Sign); + end if; + + -- Must be always set (as Sign.Link may be set by a regular driver). + Sign.Is_Direct_Active := True; + end Ghdl_Signal_Direct_Assign; + procedure Ghdl_Signal_Simple_Assign_Error (Sign : Ghdl_Signal_Ptr; File : Ghdl_C_String; Line : Ghdl_I32) @@ -2624,6 +2662,7 @@ package body Grt.Signals is Clear_List : Ghdl_Signal_Ptr := null; + -- Mark SIG as active and put it on Clear_List (if not already). procedure Mark_Active (Sig : Ghdl_Signal_Ptr); pragma Inline (Mark_Active); @@ -3055,6 +3094,7 @@ package body Grt.Signals is -- 1) Reset active flag. Reset_Active_Flag; + -- For each active signals Sig := Ghdl_Signal_Active_Chain; Ghdl_Signal_Active_Chain := Signal_End; while Sig.S.Mode_Sig /= Mode_End loop @@ -3083,6 +3123,7 @@ package body Grt.Signals is when Net_One_Direct => Mark_Active (Sig); + Sig.Is_Direct_Active := False; Trans := Sig.S.Drivers (0).Last_Trans; Direct_Assign (Sig.Driving_Value, Trans.Val_Ptr, Sig.Mode); @@ -3092,6 +3133,7 @@ package body Grt.Signals is when Net_One_Resolved => -- This signal is active. Mark_Active (Sig); + Sig.Is_Direct_Active := False; for J in 1 .. Sig.S.Nbr_Drivers loop Trans := Sig.S.Drivers (J - 1).First_Trans.Next; @@ -3112,6 +3154,7 @@ package body Grt.Signals is Internal_Error ("update_signals: no_signal_net"); when others => + Sig.Is_Direct_Active := False; if not Propagation.Table (Sig.Net).Updated then Propagation.Table (Sig.Net).Updated := True; Run_Propagation (Sig.Net + 1); @@ -3324,6 +3367,7 @@ package body Grt.Signals is Event => False, Active => False, Has_Active => False, + Is_Direct_Active => False, Sig_Kind => Kind_Signal_No, Mode => Mode_B2, diff --git a/translate/grt/grt-signals.ads b/translate/grt/grt-signals.ads index eac47a7..875d876 100644 --- a/translate/grt/grt-signals.ads +++ b/translate/grt/grt-signals.ads @@ -275,18 +275,13 @@ package Grt.Signals is pragma Pack (Ghdl_Signal_Flags); type Ghdl_Signal is record - -- Fields known by ghdl. + -- Fields known by the compilers. Value : Value_Union; Driving_Value : Value_Union; Last_Value : Value_Union; Last_Event : Std_Time; Last_Active : Std_Time; - -- Chain of signals. - -- Used to build nets. - -- This is also the simply linked list of future active signals. - Link : Ghdl_Signal_Ptr; - Event : Boolean; Active : Boolean; -- If set, the activity of the signal is required by the user. @@ -295,6 +290,9 @@ package Grt.Signals is -- Internal fields. -- NOTE: keep above fields (components) in sync with translation. + -- If set, the signal has an active direct driver. + Is_Direct_Active : Boolean; + -- Kind of the signal (none, bus or register). Sig_Kind : Kind_Signal_Type; @@ -307,7 +305,12 @@ package Grt.Signals is -- Net of the signal. Net : Signal_Net_Type; - -- Chain of signals whose active flag was set. Used to clear it. + -- Chain of signals that will be active in the next delta-cycle. + -- (Also used to build nets). + Link : Ghdl_Signal_Ptr; + + -- Chain of signals whose active flag was set. Used to clear the active + -- flag at the end of the delta cycle. Alink : Ghdl_Signal_Ptr; -- Chain of signals that have a projected waveform in the real future. @@ -530,6 +533,8 @@ package Grt.Signals is File : Ghdl_C_String; Line : Ghdl_I32); + procedure Ghdl_Signal_Direct_Assign (Sign : Ghdl_Signal_Ptr); + procedure Ghdl_Signal_Set_Disconnect (Sign : Ghdl_Signal_Ptr; Time : Std_Time); @@ -652,9 +657,15 @@ package Grt.Signals is -- Add a driver to SIGN for the current process. procedure Ghdl_Process_Add_Driver (Sign : Ghdl_Signal_Ptr); - -- Add a direct driver for the current process. - procedure Ghdl_Signal_Direct_Driver (Sign : Ghdl_Signal_Ptr; - Drv : Ghdl_Value_Ptr); + -- Add a direct driver for the current process. This is an optimization + -- that could be used when a driver has no projected waveforms. + -- + -- Assignment using direct driver: + -- * the driver value is set + -- * put the signal on the ghdl_signal_active_chain, if the signal will + -- be active and if not already on the chain. + procedure Ghdl_Signal_Add_Direct_Driver (Sign : Ghdl_Signal_Ptr; + Drv : Ghdl_Value_Ptr); -- Used for connexions: -- SRC is a source for TARG. @@ -759,6 +770,9 @@ private pragma Export (C, Ghdl_Signal_Start_Assign_Null, "__ghdl_signal_start_assign_null"); + pragma Export (C, Ghdl_Signal_Direct_Assign, + "__ghdl_signal_direct_assign"); + pragma Export (C, Ghdl_Signal_Set_Disconnect, "__ghdl_signal_set_disconnect"); pragma Export (C, Ghdl_Signal_Disconnect, @@ -859,8 +873,8 @@ private pragma Export (C, Ghdl_Process_Add_Driver, "__ghdl_process_add_driver"); - pragma Export (C, Ghdl_Signal_Direct_Driver, - "__ghdl_signal_direct_driver"); + pragma Export (C, Ghdl_Signal_Add_Direct_Driver, + "__ghdl_signal_add_direct_driver"); pragma Export (C, Ghdl_Signal_Add_Source, "__ghdl_signal_add_source"); diff --git a/translate/trans_decls.ads b/translate/trans_decls.ads index eadba8b..23bd6d9 100644 --- a/translate/trans_decls.ads +++ b/translate/trans_decls.ads @@ -49,8 +49,9 @@ package Trans_Decls is -- Register a driver for a process. Ghdl_Process_Add_Driver : O_Dnode; + Ghdl_Signal_Add_Direct_Driver : O_Dnode; - -- NOW variables. + -- NOW variable. Ghdl_Now : O_Dnode; -- Protected variables. @@ -64,6 +65,7 @@ package Trans_Decls is Ghdl_Signal_Driving : O_Dnode; + Ghdl_Signal_Direct_Assign : O_Dnode; Ghdl_Signal_Simple_Assign_Error : O_Dnode; Ghdl_Signal_Start_Assign_Error : O_Dnode; @@ -72,8 +74,6 @@ package Trans_Decls is Ghdl_Signal_Start_Assign_Null : O_Dnode; Ghdl_Signal_Next_Assign_Null : O_Dnode; - Ghdl_Signal_Direct_Driver : O_Dnode; - Ghdl_Create_Signal_E8 : O_Dnode; Ghdl_Signal_Init_E8 : O_Dnode; Ghdl_Signal_Simple_Assign_E8 : O_Dnode; @@ -138,9 +138,6 @@ package Trans_Decls is Ghdl_Signal_Read_Driver : O_Dnode; Ghdl_Signal_Read_Port : O_Dnode; - -- Chain of to be active signals. - Ghdl_Signal_Active_Chain : O_Dnode; - -- Signal attribute. Ghdl_Create_Stable_Signal : O_Dnode; Ghdl_Create_Quiet_Signal : O_Dnode; diff --git a/translate/translation.adb b/translate/translation.adb index 4be924a..4c3360d 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -147,7 +147,6 @@ package body Translation is Ghdl_Signal_Last_Value_Field : O_Fnode; Ghdl_Signal_Last_Event_Field : O_Fnode; Ghdl_Signal_Last_Active_Field : O_Fnode; - Ghdl_Signal_Active_Chain_Field : O_Fnode; Ghdl_Signal_Event_Field : O_Fnode; Ghdl_Signal_Active_Field : O_Fnode; Ghdl_Signal_Has_Active_Field : O_Fnode; @@ -21264,6 +21263,7 @@ package body Translation is is Targ_Sig : Mnode; If_Blk : O_If_Block; + Constr : O_Assoc_List; Cond : O_Dnode; Drv : Mnode; begin @@ -21300,25 +21300,14 @@ package body Translation is -- Put signal into active list (if not already in the list). -- FIXME: this is not thread-safe! - Start_If_Stmt - (If_Blk, - New_Dyadic_Op - (ON_And, - New_Obj_Value (Cond), - New_Compare_Op - (ON_Eq, - New_Value (Chap14.Get_Signal_Field - (Targ_Sig, Ghdl_Signal_Active_Chain_Field)), - New_Lit (New_Null_Access (Ghdl_Signal_Ptr)), - Ghdl_Bool_Type))); - New_Assign_Stmt - (Chap14.Get_Signal_Field (Targ_Sig, Ghdl_Signal_Active_Chain_Field), - New_Obj_Value (Ghdl_Signal_Active_Chain)); - New_Assign_Stmt - (New_Obj (Ghdl_Signal_Active_Chain), - New_Convert_Ov (New_Value (M2Lv (Targ_Sig)), - Ghdl_Signal_Ptr)); + Start_If_Stmt (If_Blk, New_Obj_Value (Cond)); + Start_Association (Constr, Ghdl_Signal_Direct_Assign); + New_Association (Constr, + New_Convert_Ov (New_Value (M2Lv (Targ_Sig)), + Ghdl_Signal_Ptr)); + New_Procedure_Call (Constr); Finish_If_Stmt (If_Blk); + Close_Temp; end Gen_Signal_Direct_Assign_Non_Composite; @@ -22590,7 +22579,7 @@ package body Translation is pragma Unreferenced (Targ_Type); Constr : O_Assoc_List; begin - Start_Association (Constr, Ghdl_Signal_Direct_Driver); + Start_Association (Constr, Ghdl_Signal_Add_Direct_Driver); New_Association (Constr, New_Convert_Ov (New_Value (M2Lv (Targ)), Ghdl_Signal_Ptr)); New_Association @@ -22662,7 +22651,7 @@ package body Translation is -- pragma Unreferenced (Sig_Type); -- Constr : O_Assoc_List; -- begin --- Start_Association (Constr, Ghdl_Signal_Direct_Driver); +-- Start_Association (Constr, Ghdl_Signal_Add_Direct_Driver); -- New_Association -- (Constr, New_Convert_Ov (New_Value (M2Lv (Sig)), Ghdl_Signal_Ptr)); -- New_Association @@ -25298,225 +25287,22 @@ package body Translation is Pinfo.Ortho_Type (Mode_Value)); end Translate_Value_Attribute; - -- Current path for name attributes. - Path_Str : String_Acc := null; - Path_Maxlen : Natural := 0; - Path_Len : Natural; - Path_Instance : Iir; - - procedure Deallocate is new Ada.Unchecked_Deallocation - (Name => String_Acc, Object => String); - - procedure Path_Reset is - begin - Path_Len := 0; - Path_Instance := Null_Iir; - if Path_Maxlen = 0 then - Path_Maxlen := 256; - Path_Str := new String (1 .. Path_Maxlen); - end if; - end Path_Reset; - - procedure Path_Add (Str : String) - is - N_Len : Natural; - N_Path : String_Acc; - begin - N_Len := Path_Maxlen; - loop - exit when Path_Len + Str'Length <= N_Len; - N_Len := N_Len * 2; - end loop; - if N_Len /= Path_Maxlen then - N_Path := new String (1 .. N_Len); - N_Path (1 .. Path_Len) := Path_Str (1 .. Path_Len); - Deallocate (Path_Str); - Path_Str := N_Path; - Path_Maxlen := N_Len; - end if; - Path_Str (Path_Len + 1 .. Path_Len + Str'Length) := Str; - Path_Len := Path_Len + Str'Length; - end Path_Add; - - procedure Path_Add_Type_Name (Atype : Iir) - is - use Name_Table; - Adecl : Iir; - begin - Adecl := Get_Type_Declarator (Atype); - Image (Get_Identifier (Adecl)); - Path_Add (Name_Buffer (1 .. Name_Length)); - end Path_Add_Type_Name; - - procedure Path_Add_Signature (Subprg : Iir) - is - Chain : Iir; - begin - Path_Add ("["); - Chain := Get_Interface_Declaration_Chain (Subprg); - while Chain /= Null_Iir loop - Path_Add_Type_Name (Get_Type (Chain)); - Chain := Get_Chain (Chain); - if Chain /= Null_Iir then - Path_Add (","); - end if; - end loop; - - case Get_Kind (Subprg) is - when Iir_Kind_Function_Declaration - | Iir_Kind_Implicit_Function_Declaration => - Path_Add (" return "); - Path_Add_Type_Name (Get_Return_Type (Subprg)); - when others => - null; - end case; - Path_Add ("]"); - end Path_Add_Signature; - - procedure Path_Add_Name (N : Iir) - is - use Name_Table; - begin - Eval_Simple_Name (Get_Identifier (N)); - if Name_Buffer (1) /= 'P' then - -- Skip anonymous processes. - Path_Add (Name_Buffer (1 .. Name_Length)); - end if; - end Path_Add_Name; - - procedure Path_Add_Element (El : Iir; Is_Instance : Boolean) - is - begin - -- LRM 14.1 - -- E'INSTANCE_NAME - -- There is one full pah instance element for each component - -- instantiation, block statement, generate statemenent, process - -- statement, or subprogram body in the design hierarchy between - -- the top design entity and the named entity denoted by the - -- prefix. - -- - -- E'PATH_NAME - -- There is one path instance element for each component - -- instantiation, block statement, generate statement, process - -- statement, or subprogram body in the design hierarchy between - -- the root design entity and the named entity denoted by the - -- prefix. - case Get_Kind (El) is - when Iir_Kind_Library_Declaration => - Path_Add (":"); - Path_Add_Name (El); - Path_Add (":"); - when Iir_Kind_Package_Declaration => - Path_Add_Element - (Get_Library (Get_Design_File (Get_Design_Unit (El))), - Is_Instance); - Path_Add_Name (El); - Path_Add (":"); - when Iir_Kind_Entity_Declaration => - Path_Instance := El; - when Iir_Kind_Architecture_Declaration => - Path_Instance := El; - when Iir_Kind_Design_Unit => - Path_Add_Element (Get_Library_Unit (El), Is_Instance); - when Iir_Kind_Sensitized_Process_Statement - | Iir_Kind_Process_Statement - | Iir_Kind_Block_Statement => - Path_Add_Element (Get_Parent (El), Is_Instance); - Path_Add_Name (El); - Path_Add (":"); - when Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration => - Path_Add_Element (Get_Parent (El), Is_Instance); - Path_Add_Name (El); - if Flags.Vhdl_Std >= Vhdl_02 then - -- Add signature. - Path_Add_Signature (El); - end if; - Path_Add (":"); - when Iir_Kind_Procedure_Body => - Path_Add_Element (Get_Subprogram_Specification (El), - Is_Instance); - when Iir_Kind_Generate_Statement => - declare - Scheme : Iir; - begin - Scheme := Get_Generation_Scheme (El); - if Get_Kind (Scheme) = Iir_Kind_Iterator_Declaration then - Path_Instance := El; - else - Path_Add_Element (Get_Parent (El), Is_Instance); - Path_Add_Name (El); - Path_Add (":"); - end if; - end; - when Iir_Kinds_Sequential_Statement => - Path_Add_Element (Get_Parent (El), Is_Instance); - when others => - Error_Kind ("path_add_element", El); - end case; - end Path_Add_Element; - function Translate_Path_Instance_Name_Attribute (Attr : Iir) return O_Enode is - Prefix : Iir; + Name : constant Path_Instance_Name_Type := + Get_Path_Instance_Name_Suffix (Attr); Res : O_Dnode; Name_Cst : O_Dnode; Str_Cst : O_Cnode; Constr : O_Assoc_List; - Is_Instance : Boolean; + Is_Instance : constant Boolean := + Get_Kind (Attr) = Iir_Kind_Instance_Name_Attribute; begin - Prefix := Get_Prefix (Attr); - Is_Instance := Get_Kind (Attr) = Iir_Kind_Instance_Name_Attribute; - - Path_Reset; - - -- LRM 14.1 - -- E'PATH_NAME - -- The local item name in E'PATH_NAME equals E'SIMPLE_NAME, unless - -- E denotes a library, package, subprogram or label. In this - -- latter case, the package based path or instance based path, - -- as appropriate, will not contain a local item name. - -- - -- E'INSTANCE_NAME - -- The local item name in E'INSTANCE_NAME equals E'SIMPLE_NAME, - -- unless E denotes a library, package, subprogram, or label. In - -- this latter case, the package based path or full instance based - -- path, as appropriate, will not contain a local item name. - case Get_Kind (Prefix) is - when Iir_Kind_Constant_Declaration - | Iir_Kind_Constant_Interface_Declaration - | Iir_Kind_Iterator_Declaration - | Iir_Kind_Variable_Declaration - | Iir_Kind_Variable_Interface_Declaration - | Iir_Kind_Signal_Declaration - | Iir_Kind_Signal_Interface_Declaration - | Iir_Kind_File_Declaration - | Iir_Kind_File_Interface_Declaration - | Iir_Kind_Type_Declaration - | Iir_Kind_Subtype_Declaration => - Path_Add_Element (Get_Parent (Prefix), Is_Instance); - Path_Add_Name (Prefix); - when Iir_Kind_Library_Declaration - | Iir_Kind_Design_Unit - | Iir_Kind_Package_Declaration - | Iir_Kind_Function_Declaration - | Iir_Kind_Procedure_Declaration - | Iir_Kind_Implicit_Function_Declaration - | Iir_Kind_Implicit_Procedure_Declaration - | Iir_Kinds_Concurrent_Statement - | Iir_Kinds_Sequential_Statement => - Path_Add_Element (Prefix, Is_Instance); - when others => - Error_Kind ("translate_path_instance_name_attribute", Prefix); - end case; Create_Temp_Stack2_Mark; Res := Create_Temp (Std_String_Node); - Str_Cst := Create_String_Len (Path_Str (1 .. Path_Len), - Create_Uniq_Identifier); + Str_Cst := Create_String_Len (Name.Suffix, Create_Uniq_Identifier); New_Const_Decl (Name_Cst, Create_Uniq_Identifier, O_Storage_Private, Ghdl_Str_Len_Type_Node); Start_Const_Value (Name_Cst); @@ -25528,10 +25314,10 @@ package body Translation is end if; New_Association (Constr, New_Address (New_Obj (Res), Std_String_Ptr_Node)); - if Path_Instance = Null_Iir then + if Name.Path_Instance = Null_Iir then Rtis.Associate_Null_Rti_Context (Constr); else - Rtis.Associate_Rti_Context (Constr, Path_Instance); + Rtis.Associate_Rti_Context (Constr, Name.Path_Instance); end if; New_Association (Constr, New_Address (New_Obj (Name_Cst), @@ -29106,9 +28892,6 @@ package body Translation is New_Record_Field (Rec, Ghdl_Signal_Last_Active_Field, Get_Identifier ("last_active"), Time_Otype); - New_Record_Field (Rec, Ghdl_Signal_Active_Chain_Field, - Get_Identifier ("active_chain"), - Ghdl_Signal_Ptr); New_Record_Field (Rec, Ghdl_Signal_Event_Field, Get_Identifier ("event"), Std_Boolean_Type_Node); @@ -29124,11 +28907,6 @@ package body Translation is New_Type_Decl (Get_Identifier ("__ghdl_signal_ptr_ptr"), Ghdl_Signal_Ptr_Ptr); - New_Var_Decl (Ghdl_Signal_Active_Chain, - Get_Identifier ("__ghdl_signal_active_chain"), - O_Storage_External, - Ghdl_Signal_Ptr); - -- procedure __ghdl_signal_merge_rti -- (sig : ghdl_signal_ptr; rti : ghdl_rti_access) Start_Procedure_Decl @@ -29370,16 +29148,24 @@ package body Translation is New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); Finish_Subprogram_Decl (Interfaces, Ghdl_Process_Add_Driver); - -- procedure __ghdl_signal_direct_driver (sig : __ghdl_signal_ptr; - -- Drv : Ghdl_Ptr_type); + -- procedure __ghdl_signal_add_direct_driver (sig : __ghdl_signal_ptr; + -- Drv : Ghdl_Ptr_type); Start_Procedure_Decl - (Interfaces, Get_Identifier ("__ghdl_signal_direct_driver"), + (Interfaces, Get_Identifier ("__ghdl_signal_add_direct_driver"), O_Storage_External); New_Interface_Decl (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); New_Interface_Decl (Interfaces, Param, Get_Identifier ("drv"), Ghdl_Ptr_Type); - Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Direct_Driver); + Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Add_Direct_Driver); + + -- procedure __ghdl_signal_direct_assign (sig : __ghdl_signal_ptr); + Start_Procedure_Decl + (Interfaces, Get_Identifier ("__ghdl_signal_direct_assign"), + O_Storage_External); + New_Interface_Decl + (Interfaces, Param, Wki_Sig, Ghdl_Signal_Ptr); + Finish_Subprogram_Decl (Interfaces, Ghdl_Signal_Direct_Assign); declare procedure Create_Signal_Conversion (Name : String; Res : out O_Dnode) @@ -29925,47 +29711,6 @@ package body Translation is O_Storage_Public); end Gen_Setup_Info; - -- Return TRUE iff ENTITY can be at the top of a hierarchy, ie: - -- ENTITY has no generics or all generics have a default expression - -- ENTITY has no ports or all ports type are constrained. - procedure Check_Entity_Declaration_Top (Entity : Iir_Entity_Declaration) - is - Has_Error : Boolean := False; - - procedure Error (Msg : String; Loc : Iir) is - begin - if not Has_Error then - Error_Msg_Elab - (Disp_Node (Entity) & " cannot be at the top of a design"); - Has_Error := True; - end if; - Error_Msg_Elab (Msg, Loc); - end Error; - - El : Iir; - begin - -- Check generics. - El := Get_Generic_Chain (Entity); - while El /= Null_Iir loop - if Get_Default_Value (El) = Null_Iir then - Error ("(" & Disp_Node (El) & " has no default value)", El); - end if; - El := Get_Chain (El); - end loop; - - -- Check port. - El := Get_Port_Chain (Entity); - while El /= Null_Iir loop - if not Is_Fully_Constrained_Type (Get_Type (El)) - and then Get_Default_Value (El) = Null_Iir - then - Error ("(" & Disp_Node (El) - & " is unconstrained and has no default value)", El); - end if; - El := Get_Chain (El); - end loop; - end Check_Entity_Declaration_Top; - procedure Gen_Last_Arch (Entity : Iir_Entity_Declaration) is Entity_Info : Block_Info_Acc; |