diff options
author | Tristan Gingold <tgingold@free.fr> | 2020-05-27 17:50:12 +0200 |
---|---|---|
committer | Tristan Gingold <tgingold@free.fr> | 2020-05-28 17:47:48 +0200 |
commit | 691d4875f0710e0603a7ae563600f9a6c041c6d6 (patch) | |
tree | 529071dca47189003ebc87cc6e1c6afd5e12b975 /src/ortho/mcode | |
parent | 58756712b9465c24e1d2a198e5a03aae7ebbf774 (diff) | |
download | ghdl-691d4875f0710e0603a7ae563600f9a6c041c6d6.tar.gz ghdl-691d4875f0710e0603a7ae563600f9a6c041c6d6.tar.bz2 ghdl-691d4875f0710e0603a7ae563600f9a6c041c6d6.zip |
ortho: add a length parameter to start_array_aggr.
Diffstat (limited to 'src/ortho/mcode')
-rw-r--r-- | src/ortho/mcode/ortho_code-consts.adb | 42 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_code-consts.ads | 6 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_code-types.adb | 1 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_code-x86-emits.adb | 2 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_mcode.adb | 6 | ||||
-rw-r--r-- | src/ortho/mcode/ortho_mcode.ads | 3 |
6 files changed, 49 insertions, 11 deletions
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; |