diff options
| -rw-r--r-- | canon.adb | 39 | ||||
| -rw-r--r-- | doc/ghdl.texi | 12 | ||||
| -rw-r--r-- | flags.ads | 2 | ||||
| -rw-r--r-- | ieee-std_logic_1164.adb | 10 | ||||
| -rw-r--r-- | ieee-vital_timing.adb | 2 | ||||
| -rw-r--r-- | ortho/mcode/ortho_code-x86-insns.adb | 6 | ||||
| -rw-r--r-- | sem.adb | 96 | ||||
| -rw-r--r-- | std_package.adb | 55 | ||||
| -rw-r--r-- | translate/translation.adb | 18 |
9 files changed, 169 insertions, 71 deletions
@@ -43,11 +43,11 @@ package body Canon is -- if INTERFACE_LIST is null then returns null. -- if INTERFACE_LIST is not null, a default list is created. function Canon_Association_Chain - (Interface_Chain: Iir; Association_Chain: Iir) + (Interface_Chain: Iir; Association_Chain: Iir; Loc : Iir) return Iir; function Canon_Association_Chain_And_Actuals - (Interface_Chain : Iir; Association_Chain : Iir) + (Interface_Chain : Iir; Association_Chain : Iir; Loc : Iir) return Iir; -- Canonicalize block configuration CONF. @@ -391,7 +391,8 @@ package body Canon is if Get_Kind (Imp) /= Iir_Kind_Implicit_Function_Declaration then Assoc_Chain := Canon_Association_Chain_And_Actuals (Get_Interface_Declaration_Chain (Imp), - Get_Parameter_Association_Chain (Expr)); + Get_Parameter_Association_Chain (Expr), + Expr); Set_Parameter_Association_Chain (Expr, Assoc_Chain); else -- FIXME: @@ -511,7 +512,7 @@ package body Canon is -- reorder associations by name, -- create omitted association, function Canon_Association_Chain - (Interface_Chain : Iir; Association_Chain : Iir) + (Interface_Chain : Iir; Association_Chain : Iir; Loc : Iir) return Iir is -- The canon list of association. @@ -586,8 +587,7 @@ package body Canon is -- No association, use default expr. Assoc_El := Create_Iir (Iir_Kind_Association_Element_Open); Set_Artificial_Flag (Assoc_El, True); - -- FIXME: association_list can be null_iir_list! - --Location_Copy (Assoc_El, Association_List); + Location_Copy (Assoc_El, Loc); Set_Formal (Assoc_El, Inter); Sub_Chain_Append (N_Chain, Last, Assoc_El); @@ -615,12 +615,13 @@ package body Canon is end Canon_Association_Chain_Actuals; function Canon_Association_Chain_And_Actuals - (Interface_Chain : Iir; Association_Chain : Iir) + (Interface_Chain : Iir; Association_Chain : Iir; Loc : Iir) return Iir is Res : Iir; begin - Res := Canon_Association_Chain (Interface_Chain, Association_Chain); + Res := Canon_Association_Chain + (Interface_Chain, Association_Chain, Loc); Canon_Association_Chain_Actuals (Res); return Res; end Canon_Association_Chain_And_Actuals; @@ -634,7 +635,7 @@ package body Canon is Imp := Get_Implementation (Call); Inter_Chain := Get_Interface_Declaration_Chain (Imp); Assoc_Chain := Get_Parameter_Association_Chain (Call); - Assoc_Chain := Canon_Association_Chain (Inter_Chain, Assoc_Chain); + Assoc_Chain := Canon_Association_Chain (Inter_Chain, Assoc_Chain, Call); Set_Parameter_Association_Chain (Call, Assoc_Chain); return Assoc_Chain; end Canon_Subprogram_Call; @@ -714,7 +715,8 @@ package body Canon is begin Assoc_Chain := Canon_Association_Chain_And_Actuals (Get_Interface_Declaration_Chain (Get_Implementation (Call)), - Get_Parameter_Association_Chain (Call)); + Get_Parameter_Association_Chain (Call), + Call); Set_Parameter_Association_Chain (Call, Assoc_Chain); end Canon_Procedure_Call; @@ -1008,7 +1010,8 @@ package body Canon is Set_Procedure_Call (Call_Stmt, Call); Assoc_Chain := Canon_Association_Chain (Get_Interface_Declaration_Chain (Imp), - Get_Parameter_Association_Chain (Call)); + Get_Parameter_Association_Chain (Call), + Call); Set_Parameter_Association_Chain (Call, Assoc_Chain); Driver_List := Null_Iir_List; Assoc := Assoc_Chain; @@ -1319,12 +1322,14 @@ package body Canon is Inst := Get_Entity_From_Entity_Aspect (Inst); Assoc_Chain := Canon_Association_Chain (Get_Generic_Chain (Inst), - Get_Generic_Map_Aspect_Chain (El)); + Get_Generic_Map_Aspect_Chain (El), + El); Set_Generic_Map_Aspect_Chain (El, Assoc_Chain); Assoc_Chain := Canon_Association_Chain (Get_Port_Chain (Inst), - Get_Port_Map_Aspect_Chain (El)); + Get_Port_Map_Aspect_Chain (El), + El); Set_Port_Map_Aspect_Chain (El, Assoc_Chain); end; @@ -1350,7 +1355,7 @@ package body Canon is Chain := Get_Generic_Map_Aspect_Chain (Header); if Chain /= Null_Iir then Chain := Canon_Association_Chain - (Get_Generic_Chain (Header), Chain); + (Get_Generic_Chain (Header), Chain, Chain); else Chain := Canon_Default_Association_Chain (Get_Generic_Chain (Header)); @@ -1361,7 +1366,7 @@ package body Canon is Chain := Get_Port_Map_Aspect_Chain (Header); if Chain /= Null_Iir then Chain := Canon_Association_Chain - (Get_Port_Chain (Header), Chain); + (Get_Port_Chain (Header), Chain, Chain); else Chain := Canon_Default_Association_Chain (Get_Port_Chain (Header)); @@ -1485,7 +1490,7 @@ package body Canon is Map_Chain := Get_Default_Generic_Map_Aspect_Chain (Bind); else Map_Chain := Canon_Association_Chain - (Get_Generic_Chain (Entity), Map_Chain); + (Get_Generic_Chain (Entity), Map_Chain, Map_Chain); end if; Set_Generic_Map_Aspect_Chain (Bind, Map_Chain); @@ -1494,7 +1499,7 @@ package body Canon is Map_Chain := Get_Default_Port_Map_Aspect_Chain (Bind); else Map_Chain := Canon_Association_Chain - (Get_Port_Chain (Entity), Map_Chain); + (Get_Port_Chain (Entity), Map_Chain, Map_Chain); end if; Set_Port_Map_Aspect_Chain (Bind, Map_Chain); diff --git a/doc/ghdl.texi b/doc/ghdl.texi index f4cfdf145..e704221c9 100644 --- a/doc/ghdl.texi +++ b/doc/ghdl.texi @@ -947,10 +947,14 @@ is set by default. @item --warn-delayed-checks @cindex @option{--warn-delayed-checks} switch -Warns for checks that cannot be done during analysis time and are postponed to -elaboration time. These checks are checks for no wait statement in a procedure -called in a sensitized process. If the body of the procedure is not known -at analysis time, the check will be performed during elaboration. +Warns for checks that cannot be done during analysis time and are +postponed to elaboration time. This is because not all procedure +bodies are available during analysis (either because a package body +has not yet been analysed or because @code{GHDL} doesn't read not required +package bodies). + +These are checks for no wait statement in a procedure called in a +sensitized process and checks for pure rules of a function. @item --warn-body @cindex @option{--warn-body} switch @@ -164,7 +164,7 @@ package Flags is -- --warn-delayed-checks -- Emit warnings about delayed checks (checks performed at elaboration -- time). - Warn_Delayed_Checks : Boolean := True; + Warn_Delayed_Checks : Boolean := False; -- --warn-body -- Emit a warning when a package body is not required but is analyzed. diff --git a/ieee-std_logic_1164.adb b/ieee-std_logic_1164.adb index 625888a09..e7150964d 100644 --- a/ieee-std_logic_1164.adb +++ b/ieee-std_logic_1164.adb @@ -18,6 +18,7 @@ with Types; use Types; with Std_Names; use Std_Names; with Errorout; use Errorout; +with Std_Package; package body Ieee.Std_Logic_1164 is function Skip_Implicit (Decl : Iir) return Iir @@ -44,6 +45,15 @@ package body Ieee.Std_Logic_1164 is Decl := Get_Declaration_Chain (Pkg); + -- Skip a potential copyright constant. + if Decl /= Null_Iir + and then Get_Kind (Decl) = Iir_Kind_Constant_Declaration + and then (Get_Base_Type (Get_Type (Decl)) + = Std_Package.String_Type_Definition) + then + Decl := Get_Chain (Decl); + end if; + -- The first declaration should be type std_ulogic. if Decl = Null_Iir or else Get_Kind (Decl) /= Iir_Kind_Type_Declaration diff --git a/ieee-vital_timing.adb b/ieee-vital_timing.adb index 88f39bcf4..c3bdf98f3 100644 --- a/ieee-vital_timing.adb +++ b/ieee-vital_timing.adb @@ -1248,7 +1248,7 @@ package body Ieee.Vital_Timing is end if; if Flags.Warn_Vital_Generic then - Warning_Vital ("generic is not a VITAL generic", Decl); + Warning_Vital (Disp_Node (Decl) & " is not a VITAL generic", Decl); end if; end Check_Entity_Generic_Declaration; diff --git a/ortho/mcode/ortho_code-x86-insns.adb b/ortho/mcode/ortho_code-x86-insns.adb index 86fcb3cde..09dfdd7a4 100644 --- a/ortho/mcode/ortho_code-x86-insns.adb +++ b/ortho/mcode/ortho_code-x86-insns.adb @@ -1463,7 +1463,7 @@ package body Ortho_Code.X86.Insns is end if; Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum)); Link_Stmt (Stmt); - return Stmt; + return Reload (Stmt, Reg, Pnum); when Mode_U64 | Mode_I64 => Insert_Arg (Gen_Insn (Right, R_Irm, Num)); @@ -1519,8 +1519,8 @@ package body Ortho_Code.X86.Insns is return Stmt; when OE_Conv => declare - O_Mode : Mode_Type; - R_Mode : Mode_Type; + O_Mode : Mode_Type; -- Operand mode + R_Mode : Mode_Type; -- Result mode begin Left := Get_Expr_Operand (Stmt); O_Mode := Get_Expr_Mode (Left); @@ -1691,7 +1691,18 @@ package body Sem is end case; end Sem_Subprogram_Body; - procedure Update_And_Check_Pure_Wait (Subprg : Iir) + -- Status of Update_And_Check_Pure_Wait. + type Update_Pure_Status is + ( + -- The purity is computed and known. + Update_Pure_Done, + -- A missing body prevents from computing the purity. + Update_Pure_Missing, + -- Purity is unknown (recursion). + Update_Pure_Unknown + ); + function Update_And_Check_Pure_Wait (Subprg : Iir) + return Update_Pure_Status is procedure Error_Wait (Caller : Iir; Callee : Iir) is begin @@ -1715,20 +1726,11 @@ package body Sem is -- Current purity depth of SUBPRG. Depth : Iir_Int32; Depth_Callee : Iir_Int32; - Has_Unknown : Boolean; Has_Pure_Errors : Boolean := False; Has_Wait_Errors : Boolean := False; Npos : Natural; + Res, Res1 : Update_Pure_Status; begin - -- If the subprogram has no callee list, there is nothing to do. - if Callees_List = Null_Iir_List then - return; - end if; - - -- This subprogram is being considered. - -- To avoid infinite loop, suppress its callees list. - Set_Callees_List (Subprg, Null_Iir_List); - case Get_Kind (Subprg) is when Iir_Kind_Function_Declaration => Kind := K_Function; @@ -1746,7 +1748,8 @@ package body Sem is then -- No need to go further. Destroy_Iir_List (Callees_List); - return; + Set_Callees_List (Subprg, Null_Iir_List); + return Update_Pure_Done; end if; Subprg_Bod := Get_Subprogram_Body (Subprg); Subprg_Depth := Get_Subprogram_Depth (Subprg); @@ -1760,9 +1763,26 @@ package body Sem is Error_Kind ("update_and_check_pure_wait(1)", Subprg); end case; + -- If the subprogram has no callee list, there is nothing to do. + if Callees_List = Null_Iir_List then + -- There are two reasons why a callees_list is null: + -- * either because SUBPRG does not call any procedure + -- in this case, the status are already known and we should have + -- returned in the above case. + -- * or because of a recursion + -- in this case the status are still unknown here. + return Update_Pure_Unknown; + end if; + + -- By default we don't know the status. + Res := Update_Pure_Unknown; + + -- This subprogram is being considered. + -- To avoid infinite loop, suppress its callees list. + Set_Callees_List (Subprg, Null_Iir_List); + -- First loop: check without recursion. -- Second loop: recurse if necessary. - Has_Unknown := False; for J in 0 .. 1 loop Npos := 0; for I in Natural loop @@ -1782,13 +1802,16 @@ package body Sem is -- No body yet for the subprogram called. -- Nothing can be extracted from it, postpone the checks until -- elaboration. - Has_Unknown := True; + Res := Update_Pure_Missing; else -- Second loop: recurse if a state is not known. if J = 1 and then (Get_Purity_State (Callee) = Unknown or else Get_Wait_State (Callee) = Unknown) then - Update_And_Check_Pure_Wait (Callee); + Res1 := Update_And_Check_Pure_Wait (Callee); + if Res1 = Update_Pure_Missing then + Res := Update_Pure_Missing; + end if; end if; -- Check purity only if the subprogram is not impure. @@ -1857,6 +1880,7 @@ package body Sem is Set_Wait_State (Subprg, False); end if; end if; + Res := Update_Pure_Done; exit; else Set_Nbr_Elements (Callees_List, Npos); @@ -1864,8 +1888,35 @@ package body Sem is end loop; Set_Callees_List (Subprg, Callees_List); + + return Res; end Update_And_Check_Pure_Wait; + function Root_Update_And_Check_Pure_Wait (Subprg : Iir) return Boolean + is + Res : Update_Pure_Status; + begin + Res := Update_And_Check_Pure_Wait (Subprg); + case Res is + when Update_Pure_Done => + return True; + when Update_Pure_Missing => + return False; + when Update_Pure_Unknown => + -- The purity/wait is unknown, but all callee were walked. + -- This means there are recursive calls but without violations. + if Get_Kind (Subprg) = Iir_Kind_Procedure_Declaration then + if Get_Purity_State (Subprg) = Unknown then + Set_Purity_State (Subprg, Maybe_Impure); + end if; + if Get_Wait_State (Subprg) = Unknown then + Set_Wait_State (Subprg, False); + end if; + end if; + return True; + end case; + end Root_Update_And_Check_Pure_Wait; + procedure Sem_Analysis_Checks_List (Unit : Iir_Design_Unit; Emit_Warnings : Boolean) is @@ -1887,10 +1938,13 @@ package body Sem is case Get_Kind (El) is when Iir_Kind_Function_Declaration => -- FIXME: remove from list if fully tested ? - Update_And_Check_Pure_Wait (El); - Callees := Get_Callees_List (El); - if Callees /= Null_Iir_List then + if not Root_Update_And_Check_Pure_Wait (El) then + Keep := True; if Emit_Warnings then + Callees := Get_Callees_List (El); + if Callees = Null_Iir_List then + raise Internal_Error; + end if; Warning_Msg_Sem ("can't assert that all calls in " & Disp_Node (El) & " are pure or have not wait; " @@ -1903,17 +1957,15 @@ package body Sem is ("(first such call is to " & Disp_Node (Callee) & ")", Callee); end if; - Keep := True; end if; when Iir_Kind_Sensitized_Process_Statement => - Update_And_Check_Pure_Wait (El); - if Get_Callees_List (El) /= Null_Iir_List then + if not Root_Update_And_Check_Pure_Wait (El) then + Keep := True; if Emit_Warnings then Warning_Msg_Sem ("can't assert that " & Disp_Node (El) & " has not wait; will be checked at elaboration", El); end if; - Keep := True; end if; when others => Error_Kind ("sem_analysis_checks_list", El); diff --git a/std_package.adb b/std_package.adb index 2f3832aa2..ba6e256cc 100644 --- a/std_package.adb +++ b/std_package.adb @@ -46,6 +46,15 @@ package body Std_Package is return Res; end Create_Std_Iir; + function Create_Std_Decl (Kind : Iir_Kind) return Iir + is + Res : Iir; + begin + Res := Create_Std_Iir (Kind); + Set_Parent (Res, Standard_Package); + return Res; + end Create_Std_Decl; + procedure Create_First_Nodes is begin @@ -139,7 +148,7 @@ package body Std_Package is Res : Iir_Enumeration_Literal; List : Iir_List; begin - Res := Create_Std_Iir (Iir_Kind_Enumeration_Literal); + Res := Create_Std_Decl (Iir_Kind_Enumeration_Literal); List := Get_Enumeration_Literal_List (Sub_Type); Set_Std_Identifier (Res, Name); Set_Type (Res, Sub_Type); @@ -189,7 +198,7 @@ package body Std_Package is Set_Signal_Type_Flag (Type_Definition, True); Set_Has_Signal_Flag (Type_Definition, not Flags.Flag_Whole_Analyze); - Type_Decl := Create_Std_Iir (Iir_Kind_Anonymous_Type_Declaration); + Type_Decl := Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); Set_Identifier (Type_Decl, Type_Name); Set_Type (Type_Decl, Type_Definition); Set_Type_Declarator (Type_Definition, Type_Decl); @@ -218,7 +227,7 @@ package body Std_Package is not Flags.Flag_Whole_Analyze); -- type is - Subtype_Decl := Create_Std_Iir (Iir_Kind_Subtype_Declaration); + Subtype_Decl := Create_Std_Decl (Iir_Kind_Subtype_Declaration); Set_Std_Identifier (Subtype_Decl, Get_Identifier (Type_Decl)); Set_Type (Subtype_Decl, Subtype_Definition); Set_Type_Declarator (Subtype_Definition, Subtype_Decl); @@ -279,7 +288,7 @@ package body Std_Package is not Flags.Flag_Whole_Analyze); -- type boolean is - Boolean_Type := Create_Std_Iir (Iir_Kind_Type_Declaration); + Boolean_Type := Create_Std_Decl (Iir_Kind_Type_Declaration); Set_Std_Identifier (Boolean_Type, Name_Boolean); Set_Type (Boolean_Type, Boolean_Type_Definition); Add_Decl (Boolean_Type); @@ -308,7 +317,7 @@ package body Std_Package is not Flags.Flag_Whole_Analyze); -- type bit is - Bit_Type := Create_Std_Iir (Iir_Kind_Type_Declaration); + Bit_Type := Create_Std_Decl (Iir_Kind_Type_Declaration); Set_Std_Identifier (Bit_Type, Name_Bit); Set_Type (Bit_Type, Bit_Type_Definition); Add_Decl (Bit_Type); @@ -352,7 +361,7 @@ package body Std_Package is not Flags.Flag_Whole_Analyze); -- type character is - Character_Type := Create_Std_Iir (Iir_Kind_Type_Declaration); + Character_Type := Create_Std_Decl (Iir_Kind_Type_Declaration); Set_Std_Identifier (Character_Type, Name_Character); Set_Type (Character_Type, Character_Type_Definition); Add_Decl (Character_Type); @@ -388,7 +397,7 @@ package body Std_Package is not Flags.Flag_Whole_Analyze); -- type severity_level is - Severity_Level_Type := Create_Std_Iir (Iir_Kind_Type_Declaration); + Severity_Level_Type := Create_Std_Decl (Iir_Kind_Type_Declaration); Set_Std_Identifier (Severity_Level_Type, Name_Severity_Level); Set_Type (Severity_Level_Type, Severity_Level_Type_Definition); Add_Decl (Severity_Level_Type); @@ -435,7 +444,7 @@ package body Std_Package is Set_Has_Signal_Flag (Universal_Real_Type_Definition, False); Universal_Real_Type := - Create_Std_Iir (Iir_Kind_Anonymous_Type_Declaration); + Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); Set_Identifier (Universal_Real_Type, Name_Universal_Real); Set_Type (Universal_Real_Type, Universal_Real_Type_Definition); Set_Type_Declarator (Universal_Real_Type_Definition, @@ -457,7 +466,7 @@ package body Std_Package is -- type is Universal_Real_Subtype := - Create_Std_Iir (Iir_Kind_Subtype_Declaration); + Create_Std_Decl (Iir_Kind_Subtype_Declaration); Set_Identifier (Universal_Real_Subtype, Name_Universal_Real); Set_Type (Universal_Real_Subtype, Universal_Real_Subtype_Definition); Set_Type_Declarator (Universal_Real_Subtype_Definition, @@ -492,7 +501,7 @@ package body Std_Package is Set_Has_Signal_Flag (Convertible_Real_Type_Definition, False); Convertible_Real_Type := - Create_Std_Iir (Iir_Kind_Anonymous_Type_Declaration); + Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); Set_Identifier (Convertible_Real_Type, Name_Convertible_Real); Set_Type (Convertible_Real_Type, Convertible_Real_Type_Definition); Set_Type_Declarator (Convertible_Real_Type_Definition, @@ -531,7 +540,7 @@ package body Std_Package is Set_Has_Signal_Flag (Real_Type_Definition, not Flags.Flag_Whole_Analyze); - Real_Type := Create_Std_Iir (Iir_Kind_Anonymous_Type_Declaration); + Real_Type := Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); Set_Identifier (Real_Type, Name_Real); Set_Type (Real_Type, Real_Type_Definition); Set_Type_Declarator (Real_Type_Definition, Real_Type); @@ -552,7 +561,7 @@ package body Std_Package is Set_Has_Signal_Flag (Real_Subtype_Definition, not Flags.Flag_Whole_Analyze); - Real_Subtype := Create_Std_Iir (Iir_Kind_Subtype_Declaration); + Real_Subtype := Create_Std_Decl (Iir_Kind_Subtype_Declaration); Set_Std_Identifier (Real_Subtype, Name_Real); Set_Type (Real_Subtype, Real_Subtype_Definition); Set_Type_Declarator (Real_Subtype_Definition, Real_Subtype); @@ -579,7 +588,7 @@ package body Std_Package is Set_Has_Signal_Flag (Natural_Subtype_Definition, not Flags.Flag_Whole_Analyze); - Natural_Subtype := Create_Std_Iir (Iir_Kind_Subtype_Declaration); + Natural_Subtype := Create_Std_Decl (Iir_Kind_Subtype_Declaration); Set_Std_Identifier (Natural_Subtype, Name_Natural); Set_Type (Natural_Subtype, Natural_Subtype_Definition); Add_Decl (Natural_Subtype); @@ -605,7 +614,7 @@ package body Std_Package is Set_Has_Signal_Flag (Positive_Subtype_Definition, not Flags.Flag_Whole_Analyze); - Positive_Subtype := Create_Std_Iir (Iir_Kind_Subtype_Declaration); + Positive_Subtype := Create_Std_Decl (Iir_Kind_Subtype_Declaration); Set_Std_Identifier (Positive_Subtype, Name_Positive); Set_Type (Positive_Subtype, Positive_Subtype_Definition); Add_Decl (Positive_Subtype); @@ -628,7 +637,7 @@ package body Std_Package is Set_Has_Signal_Flag (String_Type_Definition, not Flags.Flag_Whole_Analyze); - String_Type := Create_Std_Iir (Iir_Kind_Type_Declaration); + String_Type := Create_Std_Decl (Iir_Kind_Type_Declaration); Set_Std_Identifier (String_Type, Name_String); Set_Type (String_Type, String_Type_Definition); Add_Decl (String_Type); @@ -653,7 +662,7 @@ package body Std_Package is Set_Has_Signal_Flag (Bit_Vector_Type_Definition, not Flags.Flag_Whole_Analyze); - Bit_Vector_Type := Create_Std_Iir (Iir_Kind_Type_Declaration); + Bit_Vector_Type := Create_Std_Decl (Iir_Kind_Type_Declaration); Set_Std_Identifier (Bit_Vector_Type, Name_Bit_Vector); Set_Type (Bit_Vector_Type, Bit_Vector_Type_Definition); Add_Decl (Bit_Vector_Type); @@ -748,7 +757,7 @@ package body Std_Package is Create_Unit (Time_Hr_Unit, 60, Time_Min_Unit, Name_Hr); -- type is - Time_Type := Create_Std_Iir (Iir_Kind_Anonymous_Type_Declaration); + Time_Type := Create_Std_Decl (Iir_Kind_Anonymous_Type_Declaration); Set_Identifier (Time_Type, Name_Time); Set_Type (Time_Type, Time_Type_Definition); Set_Type_Declarator (Time_Type_Definition, Time_Type); @@ -773,7 +782,7 @@ package body Std_Package is not Flags.Flag_Whole_Analyze); -- subtype - Time_Subtype := Create_Std_Iir (Iir_Kind_Subtype_Declaration); + Time_Subtype := Create_Std_Decl (Iir_Kind_Subtype_Declaration); Set_Std_Identifier (Time_Subtype, Name_Time); Set_Type (Time_Subtype, Time_Subtype_Definition); Set_Type_Declarator (Time_Subtype_Definition, Time_Subtype); @@ -824,7 +833,7 @@ package body Std_Package is not Flags.Flag_Whole_Analyze); Delay_Length_Subtype := - Create_Std_Iir (Iir_Kind_Subtype_Declaration); + Create_Std_Decl (Iir_Kind_Subtype_Declaration); Set_Std_Identifier (Delay_Length_Subtype, Name_Delay_Length); Set_Type (Delay_Length_Subtype, Delay_Length_Subtype_Definition); Set_Type_Declarator @@ -844,7 +853,7 @@ package body Std_Package is Function_Now : Iir_Implicit_Function_Declaration; begin Function_Now := - Create_Std_Iir (Iir_Kind_Implicit_Function_Declaration); + Create_Std_Decl (Iir_Kind_Implicit_Function_Declaration); Set_Std_Identifier (Function_Now, Std_Names.Name_Now); if Flags.Vhdl_Std = Vhdl_87 then Set_Return_Type (Function_Now, Time_Subtype_Definition); @@ -883,7 +892,7 @@ package body Std_Package is not Flags.Flag_Whole_Analyze); -- type file_open_kind is - File_Open_Kind_Type := Create_Std_Iir (Iir_Kind_Type_Declaration); + File_Open_Kind_Type := Create_Std_Decl (Iir_Kind_Type_Declaration); Set_Std_Identifier (File_Open_Kind_Type, Name_File_Open_Kind); Set_Type (File_Open_Kind_Type, File_Open_Kind_Type_Definition); Add_Decl (File_Open_Kind_Type); @@ -925,7 +934,7 @@ package body Std_Package is not Flags.Flag_Whole_Analyze); -- type file_open_kind is - File_Open_Status_Type := Create_Std_Iir (Iir_Kind_Type_Declaration); + File_Open_Status_Type := Create_Std_Decl (Iir_Kind_Type_Declaration); Set_Std_Identifier (File_Open_Status_Type, Name_File_Open_Status); Set_Type (File_Open_Status_Type, File_Open_Status_Type_Definition); Add_Decl (File_Open_Status_Type); @@ -946,7 +955,7 @@ package body Std_Package is -- VHDL93: -- attribute FOREIGN: string; if Flags.Vhdl_Std >= Vhdl_93c then - Foreign_Attribute := Create_Std_Iir (Iir_Kind_Attribute_Declaration); + Foreign_Attribute := Create_Std_Decl (Iir_Kind_Attribute_Declaration); Set_Std_Identifier (Foreign_Attribute, Name_Foreign); Set_Type (Foreign_Attribute, String_Type_Definition); Add_Decl (Foreign_Attribute); diff --git a/translate/translation.adb b/translate/translation.adb index 9241f366c..051adc793 100644 --- a/translate/translation.adb +++ b/translate/translation.adb @@ -11877,6 +11877,24 @@ package body Translation is if Get_Whole_Association_Flag (Assoc) then Elab_Unconstrained_Port (Formal, Get_Actual (Assoc)); end if; + when Iir_Kind_Association_Element_Open => + Open_Temp; + declare + Actual_Type : Iir; + Tinfo : Type_Info_Acc; + Bounds : Mnode; + Formal_Node : Mnode; + begin + Actual_Type := Get_Type (Get_Default_Value (Formal)); + Chap3.Create_Array_Subtype (Actual_Type, True); + Tinfo := Get_Info (Actual_Type); + Bounds := Chap3.Get_Array_Type_Bounds (Actual_Type); + Formal_Node := Chap6.Translate_Name (Formal); + New_Assign_Stmt + (M2Lp (Chap3.Get_Array_Bounds (Formal_Node)), + M2Addr (Bounds)); + end; + Close_Temp; when Iir_Kind_Association_Element_By_Individual => Open_Temp; declare |