diff options
Diffstat (limited to 'src/ortho')
23 files changed, 283 insertions, 177 deletions
diff --git a/src/ortho/debug/ortho_debug-disp.adb b/src/ortho/debug/ortho_debug-disp.adb index e2e5793f9..465de8f7e 100644 --- a/src/ortho/debug/ortho_debug-disp.adb +++ b/src/ortho/debug/ortho_debug-disp.adb @@ -582,36 +582,55 @@ package body Ortho_Debug.Disp is Put ("."); Disp_Ident (C.Off_Field.Ident); Put (")"); - when OC_Aggregate => + when OC_Array_Aggregate => declare El : O_Cnode; El_Type : O_Tnode; - Field : O_Fnode; begin - Put ('{'); - El := C.Aggr_Els; + El := C.Arr_Els; case C.Ctype.Kind is - when ON_Record_Type => - Field := C.Ctype.Elements; - El_Type := Field.Ftype; when ON_Array_Sub_Type => - Field := null; El_Type := C.Ctype.Base_Type.El_Type; + when ON_Array_Type => + El_Type := C.Ctype.El_Type; when others => raise Program_Error; end case; + Put ('['); + Put_Trim (Unsigned_32'Image (C.Arr_Len)); + Put (']'); + Put ('{'); if El /= null then loop Set_Mark; - if Field /= null then - if Disp_All_Types then - Put ('.'); - Disp_Ident (Field.Ident); - Put (" = "); - end if; - El_Type := Field.Ftype; - Field := Field.Next; + Disp_Cnode (El.Aggr_Value, El_Type); + El := El.Aggr_Next; + exit when El = null; + Put (", "); + end loop; + end if; + Put ('}'); + end; + when OC_Record_Aggregate => + declare + El : O_Cnode; + El_Type : O_Tnode; + Field : O_Fnode; + begin + Put ('{'); + El := C.Rec_Els; + pragma Assert (C.Ctype.Kind = ON_Record_Type); + Field := C.Ctype.Elements; + if El /= null then + loop + Set_Mark; + if Disp_All_Types then + Put ('.'); + Disp_Ident (Field.Ident); + Put (" = "); end if; + El_Type := Field.Ftype; + Field := Field.Next; Disp_Cnode (El.Aggr_Value, El_Type); El := El.Aggr_Next; exit when El = null; diff --git a/src/ortho/debug/ortho_debug.adb b/src/ortho/debug/ortho_debug.adb index bb32197a4..30a9478ef 100644 --- a/src/ortho/debug/ortho_debug.adb +++ b/src/ortho/debug/ortho_debug.adb @@ -811,17 +811,17 @@ package body Ortho_Debug is procedure Start_Record_Aggr (List : out O_Record_Aggr_List; Atype : O_Tnode) is - subtype O_Cnode_Aggregate is O_Cnode_Type (OC_Aggregate); + subtype O_Cnode_Aggregate is O_Cnode_Type (OC_Record_Aggregate); Res : O_Cnode; begin if Atype.Kind /= ON_Record_Type then raise Type_Error; end if; Check_Complete_Type (Atype); - Res := new O_Cnode_Aggregate'(Kind => OC_Aggregate, + Res := new O_Cnode_Aggregate'(Kind => OC_Record_Aggregate, Ctype => Atype, Ref => False, - Aggr_Els => null); + Rec_Els => null); List.Res := Res; List.Last := null; List.Field := Atype.Elements; @@ -844,7 +844,7 @@ package body Ortho_Debug is Aggr_Value => Value, Aggr_Next => null); if List.Last = null then - List.Res.Aggr_Els := El; + List.Res.Rec_Els := El; else List.Last.Aggr_Next := El; end if; @@ -863,22 +863,31 @@ package body Ortho_Debug is Res := List.Res; end Finish_Record_Aggr; - procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode) + procedure Start_Array_Aggr + (List : out O_Array_Aggr_List; Atype : O_Tnode; Len : Unsigned_32) is - subtype O_Cnode_Aggregate is O_Cnode_Type (OC_Aggregate); + subtype O_Cnode_Aggregate is O_Cnode_Type (OC_Array_Aggregate); Res : O_Cnode; begin - if Atype.Kind /= ON_Array_Sub_Type then - raise Type_Error; - end if; + case Atype.Kind is + when ON_Array_Sub_Type => + if Atype.Length.U_Val /= Unsigned_64 (Len) then + raise Type_Error; + end if; + List.El_Type := Atype.Base_Type.El_Type; + when ON_Array_Type => + List.El_Type := Atype.El_Type; + when others => + raise Type_Error; + end case; Check_Complete_Type (Atype); - Res := new O_Cnode_Aggregate'(Kind => OC_Aggregate, + Res := new O_Cnode_Aggregate'(Kind => OC_Array_Aggregate, Ctype => Atype, Ref => False, - Aggr_Els => null); + Arr_Len => Len, + Arr_Els => null); List.Res := Res; List.Last := null; - List.El_Type := Atype.Base_Type.El_Type; end Start_Array_Aggr; procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; @@ -894,7 +903,7 @@ package body Ortho_Debug is Aggr_Value => Value, Aggr_Next => null); if List.Last = null then - List.Res.Aggr_Els := El; + List.Res.Arr_Els := El; else List.Last.Aggr_Next := El; end if; diff --git a/src/ortho/debug/ortho_debug.private.ads b/src/ortho/debug/ortho_debug.private.ads index b505ff434..7586319ff 100644 --- a/src/ortho/debug/ortho_debug.private.ads +++ b/src/ortho/debug/ortho_debug.private.ads @@ -135,7 +135,8 @@ private OC_Alignof_Lit, OC_Offsetof_Lit, OC_Default_Lit, - OC_Aggregate, + OC_Array_Aggregate, + OC_Record_Aggregate, OC_Aggr_Element, OC_Union_Aggr, OC_Address, @@ -170,8 +171,11 @@ private S_Type : O_Tnode; when OC_Offsetof_Lit => Off_Field : O_Fnode; - when OC_Aggregate => - Aggr_Els : O_Cnode; + when OC_Array_Aggregate => + Arr_Len : Unsigned_32; + Arr_Els : O_Cnode; + when OC_Record_Aggregate => + Rec_Els : O_Cnode; when OC_Union_Aggr => Uaggr_Field : O_Fnode; Uaggr_Value : O_Cnode; diff --git a/src/ortho/gcc/ortho-lang-49.c b/src/ortho/gcc/ortho-lang-49.c index fc86d799f..7de15aea9 100644 --- a/src/ortho/gcc/ortho-lang-49.c +++ b/src/ortho/gcc/ortho-lang-49.c @@ -1224,7 +1224,11 @@ finish_access_type (tree atype, tree dtype) tree new_array_type (tree el_type, tree index_type) { - return build_array_type (el_type, index_type); + /* Incomplete array. */ + tree range_type; + + range_type = build_range_type (index_type, size_zero_node, NULL_TREE); + return build_array_type (el_type, range_type); } @@ -1234,10 +1238,10 @@ new_constrained_array_type (tree atype, tree length) tree range_type; tree index_type; tree len; - tree one; tree res; index_type = TYPE_DOMAIN (atype); + if (integer_zerop (length)) { /* Handle null array, by creating a one-length array... */ @@ -1245,11 +1249,10 @@ new_constrained_array_type (tree atype, tree length) } else { - one = build_int_cstu (index_type, 1); - len = build2 (MINUS_EXPR, index_type, length, one); - len = fold (len); + len = fold_build2 (MINUS_EXPR, index_type, + convert (index_type, length), + convert (index_type, size_one_node)); } - range_type = build_range_type (index_type, size_zero_node, len); res = build_array_type (TREE_TYPE (atype), range_type); @@ -1349,19 +1352,13 @@ struct GTY(()) o_array_aggr_list }; void -start_array_aggr (struct o_array_aggr_list *list, tree atype) +start_array_aggr (struct o_array_aggr_list *list, tree atype, unsigned len) { - tree nelts; - unsigned HOST_WIDE_INT n; + tree length; - list->atype = atype; - list->elts = NULL; - - nelts = array_type_nelts (atype); - gcc_assert (nelts != NULL_TREE && tree_fits_uhwi_p (nelts)); - - n = tree_to_uhwi (nelts) + 1; - vec_alloc(list->elts, n); + length = new_unsigned_literal (sizetype, len); + list->atype = new_constrained_array_type (atype, length); + vec_alloc(list->elts, len); } void @@ -1638,6 +1635,11 @@ finish_init_value (tree *decl, tree val) DECL_INITIAL (*decl) = val; TREE_CONSTANT (val) = 1; TREE_STATIC (*decl) = 1; + + /* The variable may be declared with an incomplete array, so be sure it + has a completed type. */ + TREE_TYPE (*decl) = TREE_TYPE (val); + rest_of_decl_compilation (*decl, current_function_decl == NULL_TREE, 0); } diff --git a/src/ortho/gcc/ortho-lang-5.c b/src/ortho/gcc/ortho-lang-5.c index 927b9594a..52fd049f7 100644 --- a/src/ortho/gcc/ortho-lang-5.c +++ b/src/ortho/gcc/ortho-lang-5.c @@ -1210,7 +1210,11 @@ finish_access_type (tree atype, tree dtype) tree new_array_type (tree el_type, tree index_type) { - return build_array_type (el_type, index_type); + /* Incomplete array. */ + tree range_type; + + range_type = build_range_type (index_type, size_zero_node, NULL_TREE); + return build_array_type (el_type, range_type); } @@ -1220,10 +1224,10 @@ new_constrained_array_type (tree atype, tree length) tree range_type; tree index_type; tree len; - tree one; tree res; index_type = TYPE_DOMAIN (atype); + if (integer_zerop (length)) { /* Handle null array, by creating a one-length array... */ @@ -1231,11 +1235,10 @@ new_constrained_array_type (tree atype, tree length) } else { - one = build_int_cstu (index_type, 1); - len = build2 (MINUS_EXPR, index_type, length, one); - len = fold (len); + len = fold_build2 (MINUS_EXPR, index_type, + convert (index_type, length), + convert (index_type, size_one_node)); } - range_type = build_range_type (index_type, size_zero_node, len); res = build_array_type (TREE_TYPE (atype), range_type); @@ -1335,19 +1338,13 @@ struct GTY(()) o_array_aggr_list }; void -start_array_aggr (struct o_array_aggr_list *list, tree atype) +start_array_aggr (struct o_array_aggr_list *list, tree atype, unsigned len) { - tree nelts; - unsigned HOST_WIDE_INT n; + tree length; - list->atype = atype; - list->elts = NULL; - - nelts = array_type_nelts (atype); - gcc_assert (nelts != NULL_TREE && tree_fits_uhwi_p (nelts)); - - n = tree_to_uhwi (nelts) + 1; - vec_alloc(list->elts, n); + length = new_unsigned_literal (sizetype, len); + list->atype = new_constrained_array_type (atype, length); + vec_alloc(list->elts, len); } void @@ -1624,6 +1621,11 @@ finish_init_value (tree *decl, tree val) DECL_INITIAL (*decl) = val; TREE_CONSTANT (val) = 1; TREE_STATIC (*decl) = 1; + + /* The variable may be declared with an incomplete array, so be sure it + has a completed type. */ + TREE_TYPE (*decl) = TREE_TYPE (val); + rest_of_decl_compilation (*decl, current_function_decl == NULL_TREE, 0); } diff --git a/src/ortho/gcc/ortho-lang-6.c b/src/ortho/gcc/ortho-lang-6.c index d2d247976..f78017da4 100644 --- a/src/ortho/gcc/ortho-lang-6.c +++ b/src/ortho/gcc/ortho-lang-6.c @@ -1210,7 +1210,11 @@ finish_access_type (tree atype, tree dtype) tree new_array_type (tree el_type, tree index_type) { - return build_array_type (el_type, index_type); + /* Incomplete array. */ + tree range_type; + + range_type = build_range_type (index_type, size_zero_node, NULL_TREE); + return build_array_type (el_type, range_type); } @@ -1220,10 +1224,10 @@ new_constrained_array_type (tree atype, tree length) tree range_type; tree index_type; tree len; - tree one; tree res; index_type = TYPE_DOMAIN (atype); + if (integer_zerop (length)) { /* Handle null array, by creating a one-length array... */ @@ -1231,11 +1235,10 @@ new_constrained_array_type (tree atype, tree length) } else { - one = build_int_cstu (index_type, 1); - len = build2 (MINUS_EXPR, index_type, length, one); - len = fold (len); + len = fold_build2 (MINUS_EXPR, index_type, + convert (index_type, length), + convert (index_type, size_one_node)); } - range_type = build_range_type (index_type, size_zero_node, len); res = build_array_type (TREE_TYPE (atype), range_type); @@ -1335,19 +1338,13 @@ struct GTY(()) o_array_aggr_list }; void -start_array_aggr (struct o_array_aggr_list *list, tree atype) +start_array_aggr (struct o_array_aggr_list *list, tree atype, unsigned len) { - tree nelts; - unsigned HOST_WIDE_INT n; + tree length; - list->atype = atype; - list->elts = NULL; - - nelts = array_type_nelts (atype); - gcc_assert (nelts != NULL_TREE && tree_fits_uhwi_p (nelts)); - - n = tree_to_uhwi (nelts) + 1; - vec_alloc(list->elts, n); + length = new_unsigned_literal (sizetype, len); + list->atype = new_constrained_array_type (atype, length); + vec_alloc(list->elts, len); } void @@ -1624,6 +1621,11 @@ finish_init_value (tree *decl, tree val) DECL_INITIAL (*decl) = val; TREE_CONSTANT (val) = 1; TREE_STATIC (*decl) = 1; + + /* The variable may be declared with an incomplete array, so be sure it + has a completed type. */ + TREE_TYPE (*decl) = TREE_TYPE (val); + rest_of_decl_compilation (*decl, current_function_decl == NULL_TREE, 0); } diff --git a/src/ortho/gcc/ortho-lang-7.c b/src/ortho/gcc/ortho-lang-7.c index 28df56c07..92bfc8d46 100644 --- a/src/ortho/gcc/ortho-lang-7.c +++ b/src/ortho/gcc/ortho-lang-7.c @@ -1222,7 +1222,11 @@ finish_access_type (tree atype, tree dtype) tree new_array_type (tree el_type, tree index_type) { - return build_array_type (el_type, index_type); + /* Incomplete array. */ + tree range_type; + + range_type = build_range_type (index_type, size_zero_node, NULL_TREE); + return build_array_type (el_type, range_type); } @@ -1232,10 +1236,10 @@ new_constrained_array_type (tree atype, tree length) tree range_type; tree index_type; tree len; - tree one; tree res; index_type = TYPE_DOMAIN (atype); + if (integer_zerop (length)) { /* Handle null array, by creating a one-length array... */ @@ -1243,11 +1247,10 @@ new_constrained_array_type (tree atype, tree length) } else { - one = build_int_cstu (index_type, 1); - len = build2 (MINUS_EXPR, index_type, length, one); - len = fold (len); + len = fold_build2 (MINUS_EXPR, index_type, + convert (index_type, length), + convert (index_type, size_one_node)); } - range_type = build_range_type (index_type, size_zero_node, len); res = build_array_type (TREE_TYPE (atype), range_type); @@ -1347,19 +1350,13 @@ struct GTY(()) o_array_aggr_list }; void -start_array_aggr (struct o_array_aggr_list *list, tree atype) +start_array_aggr (struct o_array_aggr_list *list, tree atype, unsigned len) { - tree nelts; - unsigned HOST_WIDE_INT n; + tree length; - list->atype = atype; - list->elts = NULL; - - nelts = array_type_nelts (atype); - gcc_assert (nelts != NULL_TREE && tree_fits_uhwi_p (nelts)); - - n = tree_to_uhwi (nelts) + 1; - vec_alloc(list->elts, n); + length = new_unsigned_literal (sizetype, len); + list->atype = new_constrained_array_type (atype, length); + vec_alloc(list->elts, len); } void @@ -1636,6 +1633,11 @@ finish_init_value (tree *decl, tree val) DECL_INITIAL (*decl) = val; TREE_CONSTANT (val) = 1; TREE_STATIC (*decl) = 1; + + /* The variable may be declared with an incomplete array, so be sure it + has a completed type. */ + TREE_TYPE (*decl) = TREE_TYPE (val); + rest_of_decl_compilation (*decl, current_function_decl == NULL_TREE, 0); } diff --git a/src/ortho/gcc/ortho-lang-8.c b/src/ortho/gcc/ortho-lang-8.c index 1c2b0c0b8..5b253aee2 100644 --- a/src/ortho/gcc/ortho-lang-8.c +++ b/src/ortho/gcc/ortho-lang-8.c @@ -1223,7 +1223,11 @@ finish_access_type (tree atype, tree dtype) tree new_array_type (tree el_type, tree index_type) { - return build_array_type (el_type, index_type); + /* Incomplete array. */ + tree range_type; + + range_type = build_range_type (index_type, size_zero_node, NULL_TREE); + return build_array_type (el_type, range_type); } @@ -1233,10 +1237,10 @@ new_constrained_array_type (tree atype, tree length) tree range_type; tree index_type; tree len; - tree one; tree res; index_type = TYPE_DOMAIN (atype); + if (integer_zerop (length)) { /* Handle null array, by creating a one-length array... */ @@ -1244,11 +1248,10 @@ new_constrained_array_type (tree atype, tree length) } else { - one = build_int_cstu (index_type, 1); - len = build2 (MINUS_EXPR, index_type, length, one); - len = fold (len); + len = fold_build2 (MINUS_EXPR, index_type, + convert (index_type, length), + convert (index_type, size_one_node)); } - range_type = build_range_type (index_type, size_zero_node, len); res = build_array_type (TREE_TYPE (atype), range_type); @@ -1348,19 +1351,13 @@ struct GTY(()) o_array_aggr_list }; void -start_array_aggr (struct o_array_aggr_list *list, tree atype) +start_array_aggr (struct o_array_aggr_list *list, tree atype, unsigned len) { - tree nelts; - unsigned HOST_WIDE_INT n; + tree length; - list->atype = atype; - list->elts = NULL; - - nelts = array_type_nelts (atype); - gcc_assert (nelts != NULL_TREE && tree_fits_uhwi_p (nelts)); - - n = tree_to_uhwi (nelts) + 1; - vec_alloc(list->elts, n); + length = new_unsigned_literal (sizetype, len); + list->atype = new_constrained_array_type (atype, length); + vec_alloc(list->elts, len); } void @@ -1637,6 +1634,11 @@ finish_init_value (tree *decl, tree val) DECL_INITIAL (*decl) = val; TREE_CONSTANT (val) = 1; TREE_STATIC (*decl) = 1; + + /* The variable may be declared with an incomplete array, so be sure it + has a completed type. */ + TREE_TYPE (*decl) = TREE_TYPE (val); + rest_of_decl_compilation (*decl, current_function_decl == NULL_TREE, 0); } diff --git a/src/ortho/gcc/ortho-lang-9.c b/src/ortho/gcc/ortho-lang-9.c index f9eac7082..80e793125 100644 --- a/src/ortho/gcc/ortho-lang-9.c +++ b/src/ortho/gcc/ortho-lang-9.c @@ -1223,7 +1223,11 @@ finish_access_type (tree atype, tree dtype) tree new_array_type (tree el_type, tree index_type) { - return build_array_type (el_type, index_type); + /* Incomplete array. */ + tree range_type; + + range_type = build_range_type (index_type, size_zero_node, NULL_TREE); + return build_array_type (el_type, range_type); } @@ -1233,10 +1237,10 @@ new_constrained_array_type (tree atype, tree length) tree range_type; tree index_type; tree len; - tree one; tree res; index_type = TYPE_DOMAIN (atype); + if (integer_zerop (length)) { /* Handle null array, by creating a one-length array... */ @@ -1244,11 +1248,10 @@ new_constrained_array_type (tree atype, tree length) } else { - one = build_int_cstu (index_type, 1); - len = build2 (MINUS_EXPR, index_type, length, one); - len = fold (len); + len = fold_build2 (MINUS_EXPR, index_type, + convert (index_type, length), + convert (index_type, size_one_node)); } - range_type = build_range_type (index_type, size_zero_node, len); res = build_array_type (TREE_TYPE (atype), range_type); @@ -1348,19 +1351,13 @@ struct GTY(()) o_array_aggr_list }; void -start_array_aggr (struct o_array_aggr_list *list, tree atype) +start_array_aggr (struct o_array_aggr_list *list, tree atype, unsigned len) { - tree nelts; - unsigned HOST_WIDE_INT n; + tree length; - list->atype = atype; - list->elts = NULL; - - nelts = array_type_nelts (atype); - gcc_assert (nelts != NULL_TREE && tree_fits_uhwi_p (nelts)); - - n = tree_to_uhwi (nelts) + 1; - vec_alloc(list->elts, n); + length = new_unsigned_literal (sizetype, len); + list->atype = new_constrained_array_type (atype, length); + vec_alloc(list->elts, len); } void @@ -1637,6 +1634,11 @@ finish_init_value (tree *decl, tree val) DECL_INITIAL (*decl) = val; TREE_CONSTANT (val) = 1; TREE_STATIC (*decl) = 1; + + /* The variable may be declared with an incomplete array, so be sure it + has a completed type. */ + TREE_TYPE (*decl) = TREE_TYPE (val); + rest_of_decl_compilation (*decl, current_function_decl == NULL_TREE, 0); } diff --git a/src/ortho/gcc/ortho_gcc.ads b/src/ortho/gcc/ortho_gcc.ads index 6273435dc..d5cbf51c1 100644 --- a/src/ortho/gcc/ortho_gcc.ads +++ b/src/ortho/gcc/ortho_gcc.ads @@ -159,7 +159,8 @@ package Ortho_Gcc is procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List; Res : out O_Cnode); - procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode); + procedure Start_Array_Aggr + (List : out O_Array_Aggr_List; Atype : O_Tnode; Len : Unsigned_32); procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; Value : O_Cnode); procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List; diff --git a/src/ortho/llvm-nodebug/ortho_llvm.adb b/src/ortho/llvm-nodebug/ortho_llvm.adb index 443b469aa..56b22f092 100644 --- a/src/ortho/llvm-nodebug/ortho_llvm.adb +++ b/src/ortho/llvm-nodebug/ortho_llvm.adb @@ -627,13 +627,12 @@ package body Ortho_LLVM is ---------------------- procedure Start_Array_Aggr - (List : out O_Array_Aggr_List; - Atype : O_Tnode) + (List : out O_Array_Aggr_List; Atype : O_Tnode; Len : Unsigned_32) is Llvm : constant TypeRef := Get_LLVM_Type (Atype); begin List := (Len => 0, - Vals => new ValueRefArray (1 .. GetArrayLength (Llvm)), + Vals => new ValueRefArray (1 .. unsigned (Len)), El_Type => GetElementType (Llvm), Atype => Atype); end Start_Array_Aggr; diff --git a/src/ortho/llvm35/ortho_llvm.adb b/src/ortho/llvm35/ortho_llvm.adb index 250870224..a4f4599e6 100644 --- a/src/ortho/llvm35/ortho_llvm.adb +++ b/src/ortho/llvm35/ortho_llvm.adb @@ -963,13 +963,12 @@ package body Ortho_LLVM is ---------------------- procedure Start_Array_Aggr - (List : out O_Array_Aggr_List; - Atype : O_Tnode) + (List : out O_Array_Aggr_List; Atype : O_Tnode; Len : Unsigned_32) is Llvm : constant TypeRef := Get_LLVM_Type (Atype); begin List := (Len => 0, - Vals => new ValueRefArray (1 .. GetArrayLength (Llvm)), + Vals => new ValueRefArray (1 .. unsigned (Len)), El_Type => GetElementType (Llvm), Atype => Atype); end Start_Array_Aggr; diff --git a/src/ortho/llvm35/ortho_llvm.ads b/src/ortho/llvm35/ortho_llvm.ads index 2779d0233..85f52b796 100644 --- a/src/ortho/llvm35/ortho_llvm.ads +++ b/src/ortho/llvm35/ortho_llvm.ads @@ -182,7 +182,8 @@ package Ortho_LLVM is procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List; Res : out O_Cnode); - procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode); + procedure Start_Array_Aggr + (List : out O_Array_Aggr_List; Atype : O_Tnode; Len : Unsigned_32); procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; Value : O_Cnode); procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List; diff --git a/src/ortho/llvm4-nodebug/ortho_llvm.adb b/src/ortho/llvm4-nodebug/ortho_llvm.adb index 2f0edca3c..68828497b 100644 --- a/src/ortho/llvm4-nodebug/ortho_llvm.adb +++ b/src/ortho/llvm4-nodebug/ortho_llvm.adb @@ -630,13 +630,12 @@ package body Ortho_LLVM is ---------------------- procedure Start_Array_Aggr - (List : out O_Array_Aggr_List; - Atype : O_Tnode) + (List : out O_Array_Aggr_List; Atype : O_Tnode; Len : Unsigned_32) is Llvm : constant TypeRef := Get_LLVM_Type (Atype); begin List := (Len => 0, - Vals => new ValueRefArray (1 .. GetArrayLength (Llvm)), + Vals => new ValueRefArray (1 .. unsigned (Len)), El_Type => GetElementType (Llvm), Atype => Atype); end Start_Array_Aggr; diff --git a/src/ortho/llvm4-nodebug/ortho_llvm.ads b/src/ortho/llvm4-nodebug/ortho_llvm.ads index 837f4846e..df30a5d8d 100644 --- a/src/ortho/llvm4-nodebug/ortho_llvm.ads +++ b/src/ortho/llvm4-nodebug/ortho_llvm.ads @@ -175,7 +175,8 @@ package Ortho_LLVM is procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List; Res : out O_Cnode); - procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode); + procedure Start_Array_Aggr + (List : out O_Array_Aggr_List; Atype : O_Tnode; Len : Unsigned_32); procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; Value : O_Cnode); procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List; diff --git a/src/ortho/mcode/ortho_code-consts.adb b/src/ortho/mcode/ortho_code-consts.adb index 1b2146dc4..dcb9c13be 100644 --- a/src/ortho/mcode/ortho_code-consts.adb +++ b/src/ortho/mcode/ortho_code-consts.adb @@ -420,20 +420,29 @@ package body Ortho_Code.Consts is end Finish_Record_Aggr; - procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode) + procedure Start_Array_Aggr + (List : out O_Array_Aggr_List; Arr_Type : O_Tnode; Len : Unsigned_32) is - Num : constant Uns32 := Get_Type_Subarray_Length (Atype); Val : Int32; begin - Val := Els.Allocate (Integer (Num)); + case Get_Type_Kind (Arr_Type) is + when OT_Subarray => + pragma Assert (Uns32 (Len) = Get_Type_Subarray_Length (Arr_Type)); + when OT_Ucarray => + null; + when others => + -- The type of an array aggregate must be an array type. + raise Syntax_Error; + end case; + Val := Els.Allocate (Integer (Len)); Cnodes.Append (Cnode_Common'(Kind => OC_Array, - Lit_Type => Atype)); + Lit_Type => Arr_Type)); List := (Res => Cnodes.Last, El => Val, - Len => Num); + Len => Uns32 (Len)); Cnodes.Append (To_Cnode_Common (Cnode_Aggr'(Els => Val, - Nbr => Int32 (Num)))); + Nbr => Int32 (Len)))); end Start_Array_Aggr; procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; @@ -658,6 +667,27 @@ package body Ortho_Code.Consts is end case; end Get_Const_Bytes; + function Get_Const_Size (Cst : O_Cnode) return Uns32 + is + T : constant O_Tnode := Get_Const_Type (Cst); + begin + case Get_Type_Kind (T) is + when OT_Ucarray => + declare + Len : constant Int32 := Get_Const_Aggr_Length (Cst); + El_Sz : Uns32; + begin + if Len = 0 then + return 0; + end if; + El_Sz := Get_Const_Size (Get_Const_Aggr_Element (Cst, 0)); + return Uns32 (Len) * El_Sz; + end; + when others => + return Get_Type_Size (T); + end case; + end Get_Const_Size; + procedure Mark (M : out Mark_Type) is begin M.Cnode := Cnodes.Last; diff --git a/src/ortho/mcode/ortho_code-consts.ads b/src/ortho/mcode/ortho_code-consts.ads index dcb719f26..f49dbb315 100644 --- a/src/ortho/mcode/ortho_code-consts.ads +++ b/src/ortho/mcode/ortho_code-consts.ads @@ -68,6 +68,9 @@ package Ortho_Code.Consts is -- Get the type from an OC_Alignof node. function Get_Alignof_Type (Cst : O_Cnode) return O_Tnode; + -- Get the size (number of bytes) for CST. + function Get_Const_Size (Cst : O_Cnode) return Uns32; + -- Get the value of a named literal. --function Get_Const_Literal (Cst : O_Cnode) return Uns32; @@ -122,7 +125,8 @@ package Ortho_Code.Consts is procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List; Res : out O_Cnode); - procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode); + procedure Start_Array_Aggr + (List : out O_Array_Aggr_List; Arr_Type : O_Tnode; Len : Unsigned_32); procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; Value : O_Cnode); procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List; diff --git a/src/ortho/mcode/ortho_code-types.adb b/src/ortho/mcode/ortho_code-types.adb index 95ed20f73..177c1ec99 100644 --- a/src/ortho/mcode/ortho_code-types.adb +++ b/src/ortho/mcode/ortho_code-types.adb @@ -96,6 +96,7 @@ package body Ortho_Code.Types is function Get_Type_Size (Atype : O_Tnode) return Uns32 is begin + pragma Assert (Get_Type_Kind (Atype) /= OT_Ucarray); return Tnodes.Table (Atype).Size; end Get_Type_Size; diff --git a/src/ortho/mcode/ortho_code-x86-emits.adb b/src/ortho/mcode/ortho_code-x86-emits.adb index cc27a3a23..a8696d19f 100644 --- a/src/ortho/mcode/ortho_code-x86-emits.adb +++ b/src/ortho/mcode/ortho_code-x86-emits.adb @@ -3216,7 +3216,7 @@ package body Ortho_Code.X86.Emits is Gen_Pow_Align (Get_Type_Align (Dtype)); Set_Symbol_Pc (Sym, Get_Decl_Storage (Decl) = O_Storage_Public); - Prealloc (Pc_Type (Get_Type_Size (Dtype))); + Prealloc (Pc_Type (Consts.Get_Const_Size (Val))); Emit_Const (Val); Set_Current_Section (Sect_Text); diff --git a/src/ortho/mcode/ortho_mcode.adb b/src/ortho/mcode/ortho_mcode.adb index 16638300d..95f442c89 100644 --- a/src/ortho/mcode/ortho_mcode.adb +++ b/src/ortho/mcode/ortho_mcode.adb @@ -283,12 +283,14 @@ package body Ortho_Mcode is Ortho_Code.O_Cnode (Res)); end Finish_Record_Aggr; - procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode) + procedure Start_Array_Aggr + (List : out O_Array_Aggr_List; Arr_Type : O_Tnode; Len : Unsigned_32) is begin Ortho_Code.Consts.Start_Array_Aggr (Ortho_Code.Consts.O_Array_Aggr_List (List), - Ortho_Code.O_Tnode (Atype)); + Ortho_Code.O_Tnode (Arr_Type), + Len); end Start_Array_Aggr; procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; diff --git a/src/ortho/mcode/ortho_mcode.ads b/src/ortho/mcode/ortho_mcode.ads index 515242561..554b1ee19 100644 --- a/src/ortho/mcode/ortho_mcode.ads +++ b/src/ortho/mcode/ortho_mcode.ads @@ -166,7 +166,8 @@ package Ortho_Mcode is procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List; Res : out O_Cnode); - procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode); + procedure Start_Array_Aggr + (List : out O_Array_Aggr_List; Arr_Type : O_Tnode; Len : Unsigned_32); procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; Value : O_Cnode); procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List; diff --git a/src/ortho/oread/ortho_front.adb b/src/ortho/oread/ortho_front.adb index 42f72ea71..9d2da4192 100644 --- a/src/ortho/oread/ortho_front.adb +++ b/src/ortho/oread/ortho_front.adb @@ -2674,31 +2674,54 @@ package body Ortho_Front is return Res; end Parse_Constant_Address; + function Parse_Array_Aggregate (Aggr_Type : Node_Acc; El_Type : Node_Acc) + return O_Cnode + is + Res : O_Cnode; + Constr : O_Array_Aggr_List; + Len : Unsigned_32; + begin + -- Parse '[' LEN ']' + Expect (Tok_Left_Brack); + Next_Token; + Expect (Tok_Num); + Len := Unsigned_32 (Token_Number); + Next_Token; + Expect (Tok_Right_Brack); + Next_Token; + + Expect (Tok_Left_Brace); + Next_Token; + Start_Array_Aggr (Constr, Aggr_Type.Type_Onode, Len); + for I in Unsigned_32 loop + if Tok = Tok_Right_Brace then + if I /= Len then + Parse_Error ("bad number of aggregate element"); + end if; + exit; + end if; + + if I /= 0 then + Expect (Tok_Comma); + Next_Token; + end if; + New_Array_Aggr_El (Constr, Parse_Constant_Value (El_Type)); + end loop; + Finish_Array_Aggr (Constr, Res); + Next_Token; + return Res; + end Parse_Array_Aggregate; + function Parse_Constant_Value (Atype : Node_Acc) return O_Cnode is Res : O_Cnode; begin case Atype.Kind is when Type_Subarray => - declare - El : constant Node_Acc := Atype.Subarray_Base.Array_Element; - Constr : O_Array_Aggr_List; - begin - Expect (Tok_Left_Brace); - Next_Token; - Start_Array_Aggr (Constr, Atype.Type_Onode); - for I in Natural loop - exit when Tok = Tok_Right_Brace; - if I /= 0 then - Expect (Tok_Comma); - Next_Token; - end if; - New_Array_Aggr_El (Constr, Parse_Constant_Value (El)); - end loop; - Finish_Array_Aggr (Constr, Res); - Next_Token; - return Res; - end; + return Parse_Array_Aggregate + (Atype, Atype.Subarray_Base.Array_Element); + when Type_Array => + return Parse_Array_Aggregate (Atype, Atype.Array_Element); when Type_Unsigned | Type_Signed | Type_Enum diff --git a/src/ortho/ortho_nodes.common.ads b/src/ortho/ortho_nodes.common.ads index 30e44d6fd..e2dd1521b 100644 --- a/src/ortho/ortho_nodes.common.ads +++ b/src/ortho/ortho_nodes.common.ads @@ -153,7 +153,8 @@ package ORTHO_NODES is procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List; Res : out O_Cnode); - procedure Start_Array_Aggr (List : out O_Array_Aggr_List; Atype : O_Tnode); + procedure Start_Array_Aggr + (List : out O_Array_Aggr_List; Atype : O_Tnode; Len : Unsigned_32); procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; Value : O_Cnode); procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List; |