diff options
| -rw-r--r-- | sem.adb | 21 | ||||
| -rw-r--r-- | sem_decls.adb | 18 | ||||
| -rw-r--r-- | sem_decls.ads | 5 | ||||
| -rw-r--r-- | sem_expr.adb | 94 | ||||
| -rw-r--r-- | sem_expr.ads | 5 | ||||
| -rw-r--r-- | sem_names.adb | 4 | ||||
| -rw-r--r-- | sem_specs.ads | 3 | ||||
| -rw-r--r-- | sem_stmts.adb | 13 | ||||
| -rw-r--r-- | sem_stmts.ads | 7 | ||||
| -rw-r--r-- | sem_types.adb | 12 |
10 files changed, 109 insertions, 73 deletions
@@ -53,7 +53,6 @@ package body Sem is procedure Sem_Entity_Declaration (Entity: Iir_Entity_Declaration) is Unit : Iir_Design_Unit; - Implicit : Implicit_Signal_Declaration_Type; begin Unit := Get_Design_Unit (Entity); Xrefs.Xref_Decl (Entity); @@ -73,17 +72,9 @@ package body Sem is -- Sem ports. Sem_Interface_Chain (Get_Port_Chain (Entity), Interface_Port); - -- entity declarative part. - Push_Signals_Declarative_Part (Implicit, Entity); - Sem_Declaration_Chain (Entity, not Flags.Flag_Whole_Analyze); - Sem_Specification_Chain (Entity, Null_Iir); - - -- Check for missing subprogram bodies. - Check_Full_Declaration (Entity, Entity); + -- Entity declarative part and concurrent statements. + Sem_Block (Entity, True); - -- statements. - Sem_Concurrent_Statement_Chain (Entity, True); - Pop_Signals_Declarative_Part (Implicit); Close_Declarative_Region; Set_Is_Within_Flag (Entity, False); end Sem_Entity_Declaration; @@ -578,7 +569,7 @@ package body Sem is Add_Context_Clauses (Entity_Design); Sem_Scopes.Add_Entity_Declarations (Get_Library_Unit (Entity_Design)); - Sem_Declaration_Chain (Decl, False); + Sem_Declaration_Chain (Decl); -- GHDL: no need to check for missing subprogram bodies, since they are -- not allowed in configuration declarations. @@ -2152,6 +2143,8 @@ package body Sem is when Iir_Kind_Attribute_Declaration | Iir_Kind_Attribute_Specification => null; + when Iir_Kind_Disconnection_Specification => + null; when Iir_Kind_Use_Clause => null; when Iir_Kind_Component_Declaration => @@ -2197,7 +2190,7 @@ package body Sem is Push_Signals_Declarative_Part (Implicit, Decl); - Sem_Declaration_Chain (Decl, not Flags.Flag_Whole_Analyze); + Sem_Declaration_Chain (Decl); -- GHDL: subprogram bodies appear in package body. Pop_Signals_Declarative_Part (Implicit); @@ -2254,7 +2247,7 @@ package body Sem is Sem_Scopes.Add_Package_Declarations (Package_Decl); - Sem_Declaration_Chain (Decl, False); + Sem_Declaration_Chain (Decl); Check_Full_Declaration (Decl, Decl); Check_Full_Declaration (Package_Decl, Decl); diff --git a/sem_decls.adb b/sem_decls.adb index 2b04ab8..83d2448 100644 --- a/sem_decls.adb +++ b/sem_decls.adb @@ -2357,16 +2357,26 @@ package body Sem_Decls is Sem_Scopes.Name_Visible (Decl); end Sem_Branch_Quantity_Declaration; - -- Semantize every declaration of DECLS_PARENT. - -- STMTS is the concurrent statement list associated with DECLS_PARENT - -- if any, or null_iir. This is used for specification. - procedure Sem_Declaration_Chain (Parent : Iir; Is_Global : Boolean) + procedure Sem_Declaration_Chain (Parent : Iir) is Decl: Iir; Last_Decl : Iir; Attr_Spec_Chain : Iir; Kind : Iir_Kind; + + -- If IS_GLOBAL is set, then declarations may be seen outside of unit. + -- This must be set for entities and packages (except when + -- Flags.Flag_Whole_Analyze is set). + Is_Global : Boolean; begin + case Get_Kind (Parent) is + when Iir_Kind_Entity_Declaration + | Iir_Kind_Package_Declaration => + Is_Global := not Flags.Flag_Whole_Analyze; + when others => + Is_Global := False; + end case; + -- Due to implicit declarations, the list can grow during sem. Decl := Get_Declaration_Chain (Parent); Last_Decl := Null_Iir; diff --git a/sem_decls.ads b/sem_decls.ads index da4020b..dcc114b 100644 --- a/sem_decls.ads +++ b/sem_decls.ads @@ -32,10 +32,7 @@ package Sem_Decls is (Decl : Iir; Is_Std_Standard : Boolean := False); -- Semantize declarations of PARENT. - -- If IS_GLOBAL is set, then declarations may be seen outside of the units. - -- This must be set for entities and packages (except when - -- Flags.Flag_Whole_Analyze is set). - procedure Sem_Declaration_Chain (Parent : Iir; Is_Global : Boolean); + procedure Sem_Declaration_Chain (Parent : Iir); -- Check all declarations of DECLS_PARENT are complete -- This checks subprograms, deferred constants, incomplete types and diff --git a/sem_expr.adb b/sem_expr.adb index a9e592b..47c29f8 100644 --- a/sem_expr.adb +++ b/sem_expr.adb @@ -170,6 +170,7 @@ package body Sem_Expr is | Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute | Iir_Kind_Element_Declaration + | Iir_Kind_Attribute_Declaration | Iir_Kind_Psl_Declaration => Error_Msg_Sem (Disp_Node (Expr) & " not allowed in an expression", Loc); @@ -431,34 +432,12 @@ package body Sem_Expr is end if; end Compatibility_Types; - function Sem_Type_Range (Expr : Iir; A_Type : Iir) return Iir - is - Expr_Type : Iir; - begin - Expr_Type := Get_Type (Expr); - if Expr_Type = Null_Iir then - return A_Type; - end if; - if Get_Kind (Expr_Type) in Iir_Kinds_Scalar_Type_Definition then - return Expr_Type; - end if; - Expr_Type := Find_Declaration (Expr_Type, Decl_Type); - if A_Type /= Null_Iir and then A_Type /= Expr_Type then - -- This can happend when EXPR is an array subtype index subtype - -- and A_TYPE is the array index type. - Error_Msg_Sem ("subtype " & Disp_Node (Expr_Type) - & " doesn't match expected type " - & Disp_Node (A_Type), Expr); - end if; - return Expr_Type; - end Sem_Type_Range; - -- Semantize the range expression EXPR. -- If A_TYPE is not null_iir, EXPR is expected to be of type A_TYPE. -- LRM93 3.2.1.1 -- FIXME: avoid to run it on an already semantized node, be careful -- with range_type_expr. - function Sem_Range_Expression + function Sem_Simple_Range_Expression (Expr: Iir_Range_Expression; A_Type: Iir; Any_Dir : Boolean) return Iir_Range_Expression is @@ -466,13 +445,31 @@ package body Sem_Expr is Left, Right: Iir; Expr_Type : Iir; begin - Expr_Type := Sem_Type_Range (Expr, A_Type); + Expr_Type := Get_Type (Expr); + + if Expr_Type = Null_Iir then + -- EXPR has the form: 'range L to/downto R' + Expr_Type := A_Type; + elsif Get_Kind (Expr_Type) not in Iir_Kinds_Scalar_Type_Definition then + -- EXPR has the form: 'NAME range L to/downto R', but NAME may + -- have already be analyzed. + Expr_Type := Find_Declaration (Expr_Type, Decl_Type); + if A_Type /= Null_Iir and then A_Type /= Expr_Type then + -- This can happend when EXPR is an array subtype index subtype + -- and A_TYPE is the array index type. + Error_Msg_Sem ("subtype " & Disp_Node (Expr_Type) + & " doesn't match expected type " + & Disp_Node (A_Type), Expr); + end if; + end if; + if Expr_Type /= Null_Iir then Base_Type := Get_Base_Type (Expr_Type); else Base_Type := Null_Iir; end if; + -- Analyze left and right bounds. Left := Get_Left_Limit (Expr); Right := Get_Right_Limit (Expr); Right := Sem_Expression_Ov (Right, Base_Type); @@ -480,6 +477,7 @@ package body Sem_Expr is if Left = Null_Iir or else Right = Null_Iir then return Null_Iir; end if; + if Is_Overloaded (Left) or else Is_Overloaded (Right) then if Base_Type /= Null_Iir then -- Cannot happen, since sem_expression_ov should resolved @@ -544,9 +542,8 @@ package body Sem_Expr is Set_Type (Expr, Base_Type); end if; return Expr; - end Sem_Range_Expression; + end Sem_Simple_Range_Expression; - -- Set semantic to expr. -- The result can be: -- a subtype definition -- a range attribute @@ -554,7 +551,7 @@ package body Sem_Expr is -- LRM93 3.2.1.1 -- FIXME: avoid to run it on an already semantized node, be careful -- with range_type_expr. - function Sem_Discrete_Range_Expression + function Sem_Range_Expression (Expr: Iir; A_Type: Iir; Any_Dir : Boolean) return Iir is @@ -562,7 +559,7 @@ package body Sem_Expr is Res_Type : Iir; begin if Get_Kind (Expr) = Iir_Kind_Range_Expression then - Res := Sem_Range_Expression (Expr, A_Type, Any_Dir); + Res := Sem_Simple_Range_Expression (Expr, A_Type, Any_Dir); if Res = Null_Iir then return Null_Iir; end if; @@ -587,12 +584,6 @@ package body Sem_Expr is | Iir_Kind_Subtype_Declaration => Res := Get_Type (Res); Res_Type := Res; - if Get_Kind (Res) not in Iir_Kinds_Discrete_Type_Definition - then - Error_Msg_Sem - (Disp_Node (Res) & " is not a discrete range type", Expr); - return Null_Iir; - end if; when Iir_Kind_Range_Array_Attribute | Iir_Kind_Reverse_Range_Array_Attribute => Res_Type := Get_Type (Res); @@ -609,6 +600,11 @@ package body Sem_Expr is end if; end if; + if Get_Kind (Res_Type) not in Iir_Kinds_Scalar_Type_Definition then + Error_Msg_Sem (Disp_Node (Res) & " is not a range type", Expr); + return Null_Iir; + end if; + if A_Type /= Null_Iir and then Get_Type_Staticness (A_Type) = Locally and then Get_Kind (A_Type) in Iir_Kinds_Subtype_Definition @@ -626,6 +622,34 @@ package body Sem_Expr is end case; end if; return Res; + end Sem_Range_Expression; + + function Sem_Discrete_Range_Expression + (Expr: Iir; A_Type: Iir; Any_Dir : Boolean) + return Iir + is + Res : Iir; + Res_Type : Iir; + begin + Res := Sem_Range_Expression (Expr, A_Type, Any_Dir); + + if Res = Null_Iir then + return Null_Iir; + end if; + + if Get_Kind (Res) in Iir_Kinds_Type_And_Subtype_Definition then + Res_Type := Res; + else + Res_Type := Get_Type (Res); + end if; + + if Get_Kind (Res_Type) not in Iir_Kinds_Discrete_Type_Definition then + Error_Msg_Sem + (Disp_Node (Res) & " is not a discrete range type", Expr); + return Null_Iir; + end if; + + return Res; end Sem_Discrete_Range_Expression; function Sem_Discrete_Range_Integer (Expr: Iir) return Iir @@ -4113,7 +4137,7 @@ package body Sem_Expr is Disp_Overload_List (List, Expr1); return Null_Iir; end if; - return Sem_Expression_Ov (Expr1, Res); + return Sem_Expression_Ov (Expr1, Get_Base_Type (Res)); end Sem_Case_Expression; function Sem_Condition (Cond : Iir) return Iir diff --git a/sem_expr.ads b/sem_expr.ads index e209afd..5b56cae 100644 --- a/sem_expr.ads +++ b/sem_expr.ads @@ -103,6 +103,11 @@ package Sem_Expr is -- Semantize a procedure_call or a concurrent_procedure_call_statement. procedure Sem_Procedure_Call (Call : Iir_Procedure_Call; Stmt : Iir); + -- Semantize a range. If ANY_DIR is true, the range can't be a + -- null range (slice vs subtype -- used in static evaluation). + function Sem_Range_Expression (Expr: Iir; A_Type: Iir; Any_Dir : Boolean) + return Iir; + -- Semantize a discrete range. If ANY_DIR is true, the range can't be a -- null range (slice vs subtype -- used in static evaluation). function Sem_Discrete_Range_Expression diff --git a/sem_names.adb b/sem_names.adb index 0e46db9..f7a28a5 100644 --- a/sem_names.adb +++ b/sem_names.adb @@ -1569,6 +1569,7 @@ package body Sem_Names is Sem.Add_Dependence (Res); end if; when Iir_Kind_Process_Statement + | Iir_Kind_Procedure_Declaration | Iir_Kind_Sensitized_Process_Statement | Iir_Kind_Design_Unit -- | Iir_Kind_Architecture_Declaration @@ -2227,7 +2228,8 @@ package body Sem_Names is | Iir_Kind_Enumeration_Literal | Iir_Kind_Unit_Declaration | Iir_Kinds_Sequential_Statement - | Iir_Kinds_Concurrent_Statement => + | Iir_Kinds_Concurrent_Statement + | Iir_Kind_Component_Declaration => -- FIXME: to complete null; when Iir_Kind_Design_Unit => diff --git a/sem_specs.ads b/sem_specs.ads index 22e5d4e..76edc0f 100644 --- a/sem_specs.ads +++ b/sem_specs.ads @@ -25,6 +25,9 @@ package Sem_Specs is (Spec : Iir_Attribute_Specification; Scope : Iir); -- Check declarations following an ALL/OTHERS attribute specification. + -- ATTR_SPEC_CHAIN is the linked list of all attribute specifications whith + -- the entity name list ALL or OTHERS until the current declaration DECL. + -- So no specification in the chain must match the declaration. procedure Check_Post_Attribute_Specification (Attr_Spec_Chain : Iir; Decl : Iir); diff --git a/sem_stmts.adb b/sem_stmts.adb index 4ae668a..33071ab 100644 --- a/sem_stmts.adb +++ b/sem_stmts.adb @@ -1216,7 +1216,7 @@ package body Sem_Stmts is -- Sem declarations Sem_Sequential_Labels (Get_Sequential_Statement_Chain (Body_Parent)); - Sem_Declaration_Chain (Body_Parent, False); + Sem_Declaration_Chain (Body_Parent); Sem_Specification_Chain (Body_Parent, Null_Iir); -- Sem statements. @@ -1719,9 +1719,10 @@ package body Sem_Stmts is -- FIXME: check for nature type... end Simple_Simultaneous_Statement; - procedure Sem_Concurrent_Statement_Chain - (Parent : Iir; Is_Passive : Boolean) + procedure Sem_Concurrent_Statement_Chain (Parent : Iir) is + Is_Passive : constant Boolean := + Get_Kind (Parent) = Iir_Kind_Entity_Declaration; El: Iir; Prev_El : Iir; Prev_Concurrent_Statement : Iir; @@ -1843,8 +1844,6 @@ package body Sem_Stmts is end loop; end Sem_Labels_Chain; - -- Semantize declarations and concurrent statements of ARCH, which is - -- either an architecture_declaration or a block_statement. procedure Sem_Block (Blk: Iir; Sem_Decls : Boolean) is Implicit : Implicit_Signal_Declaration_Type; @@ -1853,10 +1852,10 @@ package body Sem_Stmts is if Sem_Decls then Sem_Labels_Chain (Blk); - Sem_Declaration_Chain (Blk, False); + Sem_Declaration_Chain (Blk); end if; - Sem_Concurrent_Statement_Chain (Blk, False); + Sem_Concurrent_Statement_Chain (Blk); if Sem_Decls then -- FIXME: do it only if there is conf. spec. in the declarative diff --git a/sem_stmts.ads b/sem_stmts.ads index 688a576..59102af 100644 --- a/sem_stmts.ads +++ b/sem_stmts.ads @@ -19,12 +19,13 @@ with Iirs; use Iirs; package Sem_Stmts is -- Semantize declarations and concurrent statements of BLK, which is - -- either an architecture_declaration or a block_statement. + -- either an architecture_declaration, and entity_declaration or + -- a block_statement. -- If SEM_DECLS is true, then semantize the declarations of BLK. procedure Sem_Block (Blk: Iir; Sem_Decls : Boolean); - procedure Sem_Concurrent_Statement_Chain - (Parent : Iir; Is_Passive : Boolean); + -- Analyze the concurrent statements of PARENT. + procedure Sem_Concurrent_Statement_Chain (Parent : Iir); -- Some signals are implicitly declared. This is the case for signals -- declared by an attribute ('stable, 'quiet and 'transaction). diff --git a/sem_types.adb b/sem_types.adb index d7cd351..2bf032b 100644 --- a/sem_types.adb +++ b/sem_types.adb @@ -492,7 +492,7 @@ package body Sem_Types is -- body. Open_Declarative_Region; - Sem_Decls.Sem_Declaration_Chain (Decl, False); + Sem_Decls.Sem_Declaration_Chain (Decl); El := Get_Declaration_Chain (Decl); while El /= Null_Iir loop case Get_Kind (El) is @@ -613,7 +613,7 @@ package body Sem_Types is Add_Protected_Type_Declarations (Decl); end if; - Sem_Decls.Sem_Declaration_Chain (Bod, False); + Sem_Decls.Sem_Declaration_Chain (Bod); El := Get_Declaration_Chain (Bod); while El /= Null_Iir loop @@ -1093,6 +1093,9 @@ package body Sem_Types is when Iir_Kind_Integer_Type_Definition | Iir_Kind_Integer_Subtype_Definition => Sub_Type := Create_Iir (Iir_Kind_Integer_Subtype_Definition); + when Iir_Kind_Floating_Type_Definition + | Iir_Kind_Floating_Subtype_Definition => + Sub_Type := Create_Iir (Iir_Kind_Floating_Subtype_Definition); when others => raise Internal_Error; end case; @@ -1559,7 +1562,7 @@ package body Sem_Types is begin Res := Create_Iir (Iir_Kind_Record_Subtype_Definition); Location_Copy (Res, Def); - Set_Base_Type (Res, Type_Mark); + Set_Base_Type (Res, Get_Base_Type (Type_Mark)); Set_Type_Staticness (Res, Get_Type_Staticness (Type_Mark)); Set_Type_Mark (Res, Type_Mark); if Get_Kind (Type_Mark) = Iir_Kind_Record_Subtype_Definition then @@ -1785,8 +1788,7 @@ package body Sem_Types is if A_Range = Null_Iir then A_Range := Get_Range_Constraint (Type_Mark); else - A_Range := Sem_Discrete_Range_Expression - (A_Range, Type_Mark, True); + A_Range := Sem_Range_Expression (A_Range, Type_Mark, True); if A_Range = Null_Iir then -- Avoid error propagation. A_Range := Get_Range_Constraint (Type_Mark); |