diff options
author | Tristan Gingold <tgingold@free.fr> | 2020-07-08 09:27:07 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2020-07-18 19:19:56 +0200 |
commit | b4a3f85b3f5331af4f73252a8a34d0efce467c56 (patch) | |
tree | 0bd68fb8148587a43180f18006d5f77e70601cda | |
parent | 05507ab2016c069a195ad86be451b5b33c64df4c (diff) | |
download | ghdl-b4a3f85b3f5331af4f73252a8a34d0efce467c56.tar.gz ghdl-b4a3f85b3f5331af4f73252a8a34d0efce467c56.tar.bz2 ghdl-b4a3f85b3f5331af4f73252a8a34d0efce467c56.zip |
vhdl: improve support of subtype attribute.
A subtype definition does not mean anymore that the subtype is constrained.
It is now defined by the subtype indication of the name.
-rw-r--r-- | src/vhdl/translate/trans-chap4.adb | 96 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap5.adb | 2 | ||||
-rw-r--r-- | src/vhdl/translate/trans-chap7.adb | 3 | ||||
-rw-r--r-- | src/vhdl/vhdl-sem_decls.adb | 10 | ||||
-rw-r--r-- | src/vhdl/vhdl-sem_expr.adb | 24 | ||||
-rw-r--r-- | src/vhdl/vhdl-sem_expr.ads | 3 | ||||
-rw-r--r-- | src/vhdl/vhdl-sem_stmts.adb | 49 | ||||
-rw-r--r-- | src/vhdl/vhdl-utils.adb | 53 | ||||
-rw-r--r-- | src/vhdl/vhdl-utils.ads | 7 |
9 files changed, 181 insertions, 66 deletions
diff --git a/src/vhdl/translate/trans-chap4.adb b/src/vhdl/translate/trans-chap4.adb index 94f389637..986c5f658 100644 --- a/src/vhdl/translate/trans-chap4.adb +++ b/src/vhdl/translate/trans-chap4.adb @@ -448,6 +448,49 @@ package body Trans.Chap4 is end case; end Init_Object; + -- Return True iff subtype indication of DECL is a subtype attribute. + function Is_Object_Subtype_Attribute (Decl : Iir) return Boolean + is + Ind : constant Iir := Get_Subtype_Indication (Decl); + begin + return Ind /= Null_Iir + and then Get_Kind (Ind) = Iir_Kind_Subtype_Attribute; + end Is_Object_Subtype_Attribute; + + procedure Elab_Subtype_Attribute + (Decl : Iir; Name_Val : Mnode; Name_Sig : Mnode) + is + Ind : constant Iir := Get_Subtype_Indication (Decl); + Name : Mnode; + Bnd : Mnode; + begin + Name := Chap6.Translate_Name (Get_Prefix (Ind), Mode_Value); + Bnd := Chap3.Get_Composite_Bounds (Name); + + if Name_Sig /= Mnode_Null then + Stabilize (Bnd); + New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Bounds (Name_Sig)), + M2Addr (Bnd)); + end if; + New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Bounds (Name_Val)), + M2Addr (Bnd)); + end Elab_Subtype_Attribute; + + procedure Elab_Maybe_Subtype_Attribute + (Decl : Iir; Name_Val : Mnode; Name_Sig : Mnode) is + begin + case Get_Kind (Decl) is + when Iir_Kind_Anonymous_Signal_Declaration => + return; + when others => + if not Is_Object_Subtype_Attribute (Decl) then + return; + end if; + end case; + + Elab_Subtype_Attribute (Decl, Name_Val, Name_Sig); + end Elab_Maybe_Subtype_Attribute; + -- If SIZE is larger than the threshold, call __ghdl_check_stack_allocation -- to raise an error if the size is too large. There are two threshold: -- one set at compile time (Check_Stack_Allocation_Threshold) and one set @@ -498,9 +541,25 @@ package body Trans.Chap4 is when Iir_Kind_Attribute_Value => null; when others => - Chap3.Elab_Object_Subtype_Indication (Obj); + if Is_Object_Subtype_Attribute (Obj) then + Type_Info := Get_Info (Obj_Type); + if Type_Info.Type_Mode in Type_Mode_Unbounded then + -- Copy bounds and allocate base. + Name_Node := + Get_Var (Obj_Info.Object_Var, Type_Info, Mode_Value); + Stabilize (Name_Node); + Elab_Maybe_Subtype_Attribute (Obj, Name_Node, Mnode_Null); + Alloc_Kind := Get_Alloc_Kind_For_Var (Obj_Info.Object_Var); + Chap3.Allocate_Unbounded_Composite_Base + (Alloc_Kind, Name_Node, Get_Base_Type (Obj_Type)); + return; + end if; + else + Chap3.Elab_Object_Subtype_Indication (Obj); + end if; end case; + -- Now the subtype is elaborated, its info is defined. Type_Info := Get_Info (Obj_Type); -- FIXME: the object type may be a fat array! @@ -549,7 +608,9 @@ package body Trans.Chap4 is Init_Object (Name, Obj_Type); Close_Temp; elsif Get_Kind (Value) = Iir_Kind_Aggregate then - if Type_Info.Type_Mode in Type_Mode_Unbounded then + if Type_Info.Type_Mode in Type_Mode_Unbounded + and then not Is_Object_Subtype_Attribute (Obj) + then -- Allocate. declare Aggr_Type : constant Iir := Get_Type (Value); @@ -1067,37 +1128,6 @@ package body Trans.Chap4 is Update_Data_Record => Elab_Signal_Update_Record, Finish_Data_Record => Elab_Signal_Finish_Composite); - procedure Elab_Maybe_Subtype_Attribute - (Decl : Iir; Name_Val : Mnode; Name_Sig : Mnode) - is - Ind : Iir; - Name : Mnode; - Bnd : Mnode; - begin - case Get_Kind (Decl) is - when Iir_Kind_Anonymous_Signal_Declaration => - return; - when others => - Ind := Get_Subtype_Indication (Decl); - if Ind = Null_Iir - or else Get_Kind (Ind) /= Iir_Kind_Subtype_Attribute - then - return; - end if; - end case; - - Name := Chap6.Translate_Name (Get_Prefix (Ind), Mode_Value); - Bnd := Chap3.Get_Composite_Bounds (Name); - - if Name_Sig /= Mnode_Null then - Stabilize (Bnd); - New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Bounds (Name_Sig)), - M2Addr (Bnd)); - end if; - New_Assign_Stmt (M2Lp (Chap3.Get_Composite_Bounds (Name_Val)), - M2Addr (Bnd)); - end Elab_Maybe_Subtype_Attribute; - -- Elaborate signal subtypes and allocate the storage for the object. procedure Elab_Signal_Declaration_Storage (Decl : Iir; Has_Copy : Boolean) is diff --git a/src/vhdl/translate/trans-chap5.adb b/src/vhdl/translate/trans-chap5.adb index a1f89f57f..4c508931c 100644 --- a/src/vhdl/translate/trans-chap5.adb +++ b/src/vhdl/translate/trans-chap5.adb @@ -652,6 +652,8 @@ package body Trans.Chap5 is declare Actual_Type : constant Iir := Get_Actual_Type (Assoc); begin + Chap3.Translate_Anonymous_Subtype_Definition + (Actual_Type, False); Chap3.Create_Composite_Subtype (Actual_Type); Bounds := Chap3.Get_Composite_Type_Bounds (Actual_Type); end; diff --git a/src/vhdl/translate/trans-chap7.adb b/src/vhdl/translate/trans-chap7.adb index d2b97fe1e..0f4200b29 100644 --- a/src/vhdl/translate/trans-chap7.adb +++ b/src/vhdl/translate/trans-chap7.adb @@ -3702,7 +3702,8 @@ package body Trans.Chap7 is function Translate_Allocator_By_Expression (Expr : Iir) return O_Enode is - A_Type : constant Iir := Get_Type (Expr); + -- TODO: the constraint from an access subtype is ignored. + A_Type : constant Iir := Get_Base_Type (Get_Type (Expr)); A_Info : constant Type_Info_Acc := Get_Info (A_Type); D_Type : constant Iir := Get_Designated_Type (A_Type); D_Info : constant Type_Info_Acc := Get_Info (D_Type); diff --git a/src/vhdl/vhdl-sem_decls.adb b/src/vhdl/vhdl-sem_decls.adb index 6dca7e9d5..7eba27bc2 100644 --- a/src/vhdl/vhdl-sem_decls.adb +++ b/src/vhdl/vhdl-sem_decls.adb @@ -244,11 +244,13 @@ package body Vhdl.Sem_Decls is A_Type := Sem_Subtype_Indication (A_Type); Set_Subtype_Indication (Inter, A_Type); A_Type := Get_Type_Of_Subtype_Indication (A_Type); + Set_Type (Inter, A_Type); Default_Value := Get_Default_Value (Inter); if Default_Value /= Null_Iir and then not Is_Error (A_Type) then Deferred_Constant_Allowed := True; - Default_Value := Sem_Expression (Default_Value, A_Type); + Default_Value := Sem_Expression_Wildcard + (Default_Value, A_Type, Is_Object_Fully_Constrained (Inter)); Default_Value := Eval_Expr_Check_If_Static (Default_Value, A_Type); Deferred_Constant_Allowed := False; @@ -935,10 +937,12 @@ package body Vhdl.Sem_Decls is if Atype = Null_Iir then Atype := Create_Error_Type (Get_Type (Decl)); end if; + Set_Type (Decl, Atype); Default_Value := Get_Default_Value (Decl); if Default_Value /= Null_Iir then - Default_Value := Sem_Expression (Default_Value, Atype); + Default_Value := Sem_Expression_Wildcard + (Default_Value, Atype, Is_Object_Fully_Constrained (Decl)); if Default_Value = Null_Iir then Default_Value := Create_Error_Expr (Get_Default_Value (Decl), Atype); @@ -954,9 +958,9 @@ package body Vhdl.Sem_Decls is Set_Is_Ref (Decl, True); end if; Atype := Get_Type (Last_Decl); + Set_Type (Decl, Atype); end if; - Set_Type (Decl, Atype); Set_Default_Value (Decl, Default_Value); Set_Name_Staticness (Decl, Locally); Set_Visible_Flag (Decl, True); diff --git a/src/vhdl/vhdl-sem_expr.adb b/src/vhdl/vhdl-sem_expr.adb index 8f1514eef..49ad9ed8a 100644 --- a/src/vhdl/vhdl-sem_expr.adb +++ b/src/vhdl/vhdl-sem_expr.adb @@ -3034,7 +3034,8 @@ package body Vhdl.Sem_Expr is -- Perform semantisation on a (sub)aggregate AGGR, which is of type -- A_TYPE. -- return FALSE is case of failure - function Sem_Record_Aggregate (Aggr: Iir_Aggregate; A_Type: Iir) + function Sem_Record_Aggregate + (Aggr : Iir_Aggregate; A_Type : Iir; Constrained : Boolean) return boolean is El_List : constant Iir_Flist := Get_Elements_Declaration_List (A_Type); @@ -3195,7 +3196,8 @@ package body Vhdl.Sem_Expr is if not Get_Same_Alternative_Flag (El) then if El_Type /= Null_Iir then -- Analyze the expression only if the choice is correct. - Expr := Sem_Expression (Expr, El_Type); + Expr := Sem_Expression_Wildcard + (Expr, El_Type, Constrained); if Expr /= Null_Iir then Set_Associated_Expr (El, Eval_Expr_If_Static (Expr)); Expr_Staticness := Min (Expr_Staticness, @@ -4039,11 +4041,7 @@ package body Vhdl.Sem_Expr is -- the target is a fully constrained array subtype or the target is a -- slice name. function Sem_Aggregate - (Expr: Iir_Aggregate; A_Type: Iir; Force_Constrained : Boolean) - return Iir_Aggregate - is - Force_Constrained2 : constant Boolean := - Force_Constrained and Flag_Relaxed_Rules; + (Expr: Iir_Aggregate; A_Type: Iir; Constrained : Boolean) return Iir is begin pragma Assert (A_Type /= Null_Iir); @@ -4061,12 +4059,12 @@ package body Vhdl.Sem_Expr is when Iir_Kind_Array_Subtype_Definition => return Sem_Array_Aggregate (Expr, A_Type, - Force_Constrained2 or else Get_Index_Constraint_Flag (A_Type)); + Constrained or Get_Index_Constraint_Flag (A_Type)); when Iir_Kind_Array_Type_Definition => - return Sem_Array_Aggregate (Expr, A_Type, Force_Constrained2); + return Sem_Array_Aggregate (Expr, A_Type, Constrained); when Iir_Kind_Record_Type_Definition - | Iir_Kind_Record_Subtype_Definition => - if not Sem_Record_Aggregate (Expr, A_Type) then + | Iir_Kind_Record_Subtype_Definition => + if not Sem_Record_Aggregate (Expr, A_Type, Constrained) then return Null_Iir; end if; return Expr; @@ -5151,7 +5149,7 @@ package body Vhdl.Sem_Expr is end Compatible_Types_Intersect; function Sem_Expression_Wildcard - (Expr : Iir; Atype : Iir; Force_Constrained : Boolean := False) + (Expr : Iir; Atype : Iir; Constrained : Boolean := False) return Iir is Expr_Type : constant Iir := Get_Type (Expr); @@ -5173,7 +5171,7 @@ package body Vhdl.Sem_Expr is case Get_Kind (Expr) is when Iir_Kind_Aggregate => if Atype_Defined then - return Sem_Aggregate (Expr, Atype, Force_Constrained); + return Sem_Aggregate (Expr, Atype, Constrained); else pragma Assert (Expr_Type = Null_Iir); Set_Type (Expr, Wildcard_Any_Aggregate_Type); diff --git a/src/vhdl/vhdl-sem_expr.ads b/src/vhdl/vhdl-sem_expr.ads index f24ec159a..98d89c6cd 100644 --- a/src/vhdl/vhdl-sem_expr.ads +++ b/src/vhdl/vhdl-sem_expr.ads @@ -259,8 +259,7 @@ package Vhdl.Sem_Expr is -- If EXPR is partially or fully analyzed, ATYPE must not be null_iir and -- it is checked with the types of EXPR. EXPR may become fully analyzed. function Sem_Expression_Wildcard - (Expr : Iir; Atype : Iir; Force_Constrained : Boolean := False) - return Iir; + (Expr : Iir; Atype : Iir; Constrained : Boolean := False) return Iir; -- To be used after Sem_Expression_Wildcard to update list ATYPE of -- possible types. diff --git a/src/vhdl/vhdl-sem_stmts.adb b/src/vhdl/vhdl-sem_stmts.adb index fbee2e756..743c38ae6 100644 --- a/src/vhdl/vhdl-sem_stmts.adb +++ b/src/vhdl/vhdl-sem_stmts.adb @@ -494,6 +494,7 @@ package body Vhdl.Sem_Stmts is -- Analyze a waveform_list WAVEFORM_LIST that is assigned via statement -- ASSIGN_STMT to a subelement or a slice of a signal SIGNAL_DECL. procedure Sem_Waveform_Chain (Waveform_Chain : Iir_Waveform_Element; + Constrained : Boolean; Waveform_Type : in out Iir) is Expr: Iir; @@ -515,7 +516,8 @@ package body Vhdl.Sem_Stmts is -- sem_check_waveform_list. null; else - Expr := Sem_Expression_Wildcard (Expr, Waveform_Type, True); + Expr := Sem_Expression_Wildcard + (Expr, Waveform_Type, Constrained); if Expr /= Null_Iir then if Is_Expr_Fully_Analyzed (Expr) then @@ -729,25 +731,33 @@ package body Vhdl.Sem_Stmts is procedure Sem_Signal_Assignment (Stmt: Iir) is - Cond_Wf : Iir_Conditional_Waveform; - Wf_Chain : Iir_Waveform_Element; + Cond_Wf : Iir_Conditional_Waveform; + Wf_Chain : Iir_Waveform_Element; + Target : Iir; Target_Type : Iir; - Done : Boolean; + Done : Boolean; + Constrained : Boolean; begin Target_Type := Wildcard_Any_Type; + Constrained := True; Done := False; for S in Resolve_Stages loop Sem_Signal_Assignment_Target_And_Option (Stmt, Target_Type); if Is_Defined_Type (Target_Type) then Done := True; + Target := Get_Target (Stmt); + Constrained := Get_Kind (Target) /= Iir_Kind_Aggregate + and then Is_Object_Name_Fully_Constrained (Target); + else + Constrained := False; end if; case Get_Kind (Stmt) is when Iir_Kind_Concurrent_Simple_Signal_Assignment | Iir_Kind_Simple_Signal_Assignment_Statement => Wf_Chain := Get_Waveform_Chain (Stmt); - Sem_Waveform_Chain (Wf_Chain, Target_Type); + Sem_Waveform_Chain (Wf_Chain, Constrained, Target_Type); if Done then Sem_Check_Waveform_Chain (Stmt, Wf_Chain); end if; @@ -757,7 +767,7 @@ package body Vhdl.Sem_Stmts is Cond_Wf := Get_Conditional_Waveform_Chain (Stmt); while Cond_Wf /= Null_Iir loop Wf_Chain := Get_Waveform_Chain (Cond_Wf); - Sem_Waveform_Chain (Wf_Chain, Target_Type); + Sem_Waveform_Chain (Wf_Chain, Constrained, Target_Type); if Done then Sem_Check_Waveform_Chain (Stmt, Wf_Chain); end if; @@ -777,7 +787,8 @@ package body Vhdl.Sem_Stmts is Wf_Chain := Get_Associated_Chain (El); if Is_Valid (Wf_Chain) then -- The first choice of a list. - Sem_Waveform_Chain (Wf_Chain, Target_Type); + Sem_Waveform_Chain + (Wf_Chain, Constrained, Target_Type); if Done then Sem_Check_Waveform_Chain (Stmt, Wf_Chain); end if; @@ -807,7 +818,7 @@ package body Vhdl.Sem_Stmts is end Sem_Signal_Assignment; procedure Sem_Conditional_Expression_Chain - (Cond_Expr : Iir; Atype : in out Iir) + (Cond_Expr : Iir; Atype : in out Iir; Constrained : Boolean) is El : Iir; Expr : Iir; @@ -816,7 +827,7 @@ package body Vhdl.Sem_Stmts is El := Cond_Expr; while El /= Null_Iir loop Expr := Get_Expression (El); - Expr := Sem_Expression_Wildcard (Expr, Atype, True); + Expr := Sem_Expression_Wildcard (Expr, Atype, Constrained); if Expr /= Null_Iir then Set_Expression (El, Expr); @@ -844,10 +855,11 @@ package body Vhdl.Sem_Stmts is procedure Sem_Variable_Assignment (Stmt: Iir) is Target : Iir; - Expr : Iir; + Expr : Iir; Target_Type : Iir; - Stmt_Type : Iir; - Done : Boolean; + Stmt_Type : Iir; + Done : Boolean; + Constrained : Boolean; begin -- LRM93 8.5 Variable assignment statement -- If the target of the variable assignment statement is in the form of @@ -868,11 +880,18 @@ package body Vhdl.Sem_Stmts is Target := Sem_Expression_Wildcard (Target, Stmt_Type); if Target = Null_Iir then Target_Type := Stmt_Type; + -- To avoid spurious errors, assume the target is fully + -- constrained. + Constrained := True; else Set_Target (Stmt, Target); if Is_Expr_Fully_Analyzed (Target) then Check_Target (Stmt, Target); Done := True; + Constrained := Get_Kind (Target) /= Iir_Kind_Aggregate + and then Is_Object_Name_Fully_Constrained (Target); + else + Constrained := False; end if; Target_Type := Get_Type (Target); Stmt_Type := Target_Type; @@ -881,7 +900,8 @@ package body Vhdl.Sem_Stmts is case Iir_Kinds_Variable_Assignment_Statement (Get_Kind (Stmt)) is when Iir_Kind_Variable_Assignment_Statement => Expr := Get_Expression (Stmt); - Expr := Sem_Expression_Wildcard (Expr, Stmt_Type, True); + Expr := Sem_Expression_Wildcard + (Expr, Stmt_Type, Constrained); if Expr /= Null_Iir then if Is_Expr_Fully_Analyzed (Expr) then Check_Read (Expr); @@ -902,7 +922,8 @@ package body Vhdl.Sem_Stmts is when Iir_Kind_Conditional_Variable_Assignment_Statement => Expr := Get_Conditional_Expression_Chain (Stmt); - Sem_Conditional_Expression_Chain (Expr, Stmt_Type); + Sem_Conditional_Expression_Chain + (Expr, Stmt_Type, Constrained); end case; exit when Done; diff --git a/src/vhdl/vhdl-utils.adb b/src/vhdl/vhdl-utils.adb index a7b726b79..116d3dcb1 100644 --- a/src/vhdl/vhdl-utils.adb +++ b/src/vhdl/vhdl-utils.adb @@ -19,6 +19,7 @@ with Name_Table; with Str_Table; with Std_Names; use Std_Names; +with Flags; with Vhdl.Std_Package; with Vhdl.Errors; use Vhdl.Errors; with PSL.Nodes; @@ -1007,6 +1008,58 @@ package body Vhdl.Utils is or else Get_Constraint_State (Def) = Fully_Constrained; end Is_Fully_Constrained_Type; + function Is_Object_Fully_Constrained (Decl : Iir) return Boolean is + begin + -- That's true if the object type is constrained. + if Is_Fully_Constrained_Type (Get_Type (Decl)) then + return True; + end if; + + -- That's also true if the object is declared with a subtype attribute. + if Get_Kind (Get_Subtype_Indication (Decl)) = Iir_Kind_Subtype_Attribute + then + return True; + end if; + + -- Otherwise this is false. + return False; + end Is_Object_Fully_Constrained; + + function Is_Object_Name_Fully_Constrained (Obj : Iir) return Boolean + is + Base : Iir; + begin + -- That's true if the object type is constrained. + if Flags.Flag_Relaxed_Rules + or else Is_Fully_Constrained_Type (Get_Type (Obj)) + then + return True; + end if; + + -- That's also true if the object is declared with a subtype attribute. + Base := Get_Base_Name (Obj); + case Get_Kind (Base) is + when Iir_Kind_Variable_Declaration + | Iir_Kind_Signal_Declaration + | Iir_Kind_Interface_Variable_Declaration + | Iir_Kind_Interface_Signal_Declaration + | Iir_Kind_Object_Alias_Declaration => + if (Get_Kind (Get_Subtype_Indication (Base)) + = Iir_Kind_Subtype_Attribute) + then + return True; + end if; + when Iir_Kind_Dereference + | Iir_Kind_Implicit_Dereference => + null; + when others => + Error_Kind ("is_object_name_fully_constrained", Base); + end case; + + -- Otherwise this is false. + return False; + end Is_Object_Name_Fully_Constrained; + function Strip_Denoting_Name (Name : Iir) return Iir is begin if Get_Kind (Name) in Iir_Kinds_Denoting_Name then diff --git a/src/vhdl/vhdl-utils.ads b/src/vhdl/vhdl-utils.ads index d410a26f9..6712aa0fa 100644 --- a/src/vhdl/vhdl-utils.ads +++ b/src/vhdl/vhdl-utils.ads @@ -173,6 +173,13 @@ package Vhdl.Utils is -- Return TRUE iff DEF is a fully constrained type (or subtype) definition. function Is_Fully_Constrained_Type (Def : Iir) return Boolean; + -- Return True iff OBJ can be the target of an aggregate with an others + -- choice (cf LRM08 9.3.3.3). + -- Return True iff object or member of it is declared to be a fully + -- constrained subtype. + function Is_Object_Fully_Constrained (Decl : Iir) return Boolean; + function Is_Object_Name_Fully_Constrained (Obj : Iir) return Boolean; + -- Return the type definition/subtype indication of NAME if NAME denotes -- a type or subtype name. Otherwise, return Null_Iir; function Is_Type_Name (Name : Iir) return Iir; |