ortho: add a length parameter to start_array_aggr.

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;