mcode: init support for initialized variables.

9 files changed, 107 insertions, 38 deletions

diff --git a/src/ortho/mcode/ortho_code-decls.adb b/src/ortho/mcode/ortho_code-decls.adb
index 8b6d92fe5..b95d4a2b8 100644
--- a/src/ortho/mcode/ortho_code-decls.adb
+++ b/src/ortho/mcode/ortho_code-decls.adb
@@ -68,7 +68,7 @@ package body Ortho_Code.Decls is
             Dtype : O_Tnode;
             --  Symbol or offset.
             Ref : Int32;
-            --  For const: the value.
+            --  For const, val: the value.
             --  For subprg: size of pushed arguments.
             Info2 : Int32;
          when OD_Subprg_Ext =>
@@ -91,7 +91,7 @@ package body Ortho_Code.Decls is
             --  Parent (as a body) of this body or null if at top level.
             Body_Parent : O_Dnode;
             Body_Info : Int32;
-         when OD_Const_Val =>
+         when OD_Init_Val =>
             --  Corresponding declaration.
             Val_Decl : O_Dnode;
             --  Value.
@@ -161,6 +161,7 @@ package body Ortho_Code.Decls is
             return Get_Block_Last (Decl + 1) + 1;
          when OD_Function
            | OD_Procedure =>
+            --  Return the first interface.
             if Use_Subprg_Ext then
                return Decl + 2;
             else
@@ -337,24 +338,35 @@ package body Ortho_Code.Decls is
       end if;
    end New_Const_Decl;
 
-   procedure New_Const_Value (Cst : O_Dnode; Val : O_Cnode) is
+   function Get_Init_Value (Decl : O_Dnode) return O_Cnode is
+   begin
+      return O_Cnode (Dnodes.Table (Decl).Info2);
+   end Get_Init_Value;
+
+   procedure New_Init_Value (Decl : O_Dnode; Val : O_Cnode) is
    begin
-      if Dnodes.Table (Cst).Info2 /= 0 then
+      if Get_Init_Value (Decl) /= O_Cnode_Null then
          --  Value was already set.
          raise Syntax_Error;
       end if;
-      Dnodes.Table (Cst).Info2 := Int32 (Val);
+      Dnodes.Table (Decl).Info2 := Int32 (Val);
       if Flag_Debug_Hli then
-         Dnodes.Append (Dnode_Common'(Kind => OD_Const_Val,
+         Dnodes.Append (Dnode_Common'(Kind => OD_Init_Val,
                                       Storage => O_Storage_Private,
                                       Depth => Cur_Depth,
                                       Reg => R_Nil,
-                                      Val_Decl => Cst,
+                                      Val_Decl => Decl,
                                       Val_Val => Val,
                                       others => False));
       else
-         Expand_Const_Value (Cst, Val);
+         Expand_Init_Value (Decl, Val);
       end if;
+   end New_Init_Value;
+
+   procedure New_Const_Value (Cst : O_Dnode; Val : O_Cnode) is
+   begin
+      pragma Assert (Get_Decl_Kind (Cst) = OD_Const);
+      New_Init_Value (Cst, Val);
    end New_Const_Value;
 
    procedure New_Var_Decl
@@ -679,7 +691,7 @@ package body Ortho_Code.Decls is
             Disp_Decl_Name (Decl);
             Put (": ");
             Disp_Decl_Type (Decl);
-         when OD_Const_Val =>
+         when OD_Init_Val =>
             Put ("constant ");
             Disp_Decl_Name (Get_Val_Decl (Decl));
             Put (": ");
@@ -787,6 +799,36 @@ package body Ortho_Code.Decls is
       TDnodes.Set_Last (M.TDnode);
    end Release;
 
+   procedure Alloc_Zero is
+   begin
+      if not Flag_Debug_Hli then
+         --  Expand not explicitly initialized variables.
+         declare
+            N : O_Dnode;
+            Init : O_Cnode;
+         begin
+            N := Dnodes.First;
+            while N <= Dnodes.Last loop
+               if Get_Decl_Kind (N) = OD_Var then
+                  case Get_Decl_Storage (N) is
+                     when O_Storage_Private
+                       | O_Storage_Public =>
+                        Init := Get_Init_Value (N);
+                        if Init = O_Cnode_Null then
+                           Expand_Var_Zero (N);
+                        end if;
+                     when O_Storage_External =>
+                        null;
+                     when O_Storage_Local =>
+                        raise Program_Error;
+                  end case;
+               end if;
+               N := Get_Decl_Chain (N);
+            end loop;
+         end;
+      end if;
+   end Alloc_Zero;
+
    procedure Finish is
    begin
       Dnodes.Free;
diff --git a/src/ortho/mcode/ortho_code-decls.ads b/src/ortho/mcode/ortho_code-decls.ads
index ad18892fe..0cd532593 100644
--- a/src/ortho/mcode/ortho_code-decls.ads
+++ b/src/ortho/mcode/ortho_code-decls.ads
@@ -20,7 +20,10 @@ with Ortho_Code.Abi;
 package Ortho_Code.Decls is
    --  Kind of a declaration.
    type OD_Kind is (OD_Type,
-                    OD_Const, OD_Const_Val,
+                    OD_Const,
+
+                    --  Value of constant, initial value of variable.
+                    OD_Init_Val,
 
                     --  Global and local variables.
                     OD_Var, OD_Local,
@@ -55,7 +58,8 @@ package Ortho_Code.Decls is
    procedure Set_Decl_Reg (Decl : O_Dnode; Reg : O_Reg);
 
    --  Return the next decl (in the same scope) after DECL.
-   --  This skips declarations in an inner block.
+   --  This skips declarations in an inner block, but returns interfaces for
+   --  a subprogram.
    function Get_Decl_Chain (Decl : O_Dnode) return O_Dnode;
 
    --  Get the last declaration.
@@ -188,6 +192,9 @@ package Ortho_Code.Decls is
    procedure Mark (M : out Mark_Type);
    procedure Release (M : Mark_Type);
 
+   --  Allocate non explicitly initialized variables.
+   procedure Alloc_Zero;
+
    procedure Finish;
 private
    type O_Inter_List is record
diff --git a/src/ortho/mcode/ortho_code-disps.adb b/src/ortho/mcode/ortho_code-disps.adb
index e76a20f4a..d33fe403d 100644
--- a/src/ortho/mcode/ortho_code-disps.adb
+++ b/src/ortho/mcode/ortho_code-disps.adb
@@ -563,7 +563,7 @@ package body Ortho_Code.Disps is
             Put (" : ");
             Disp_Type (Get_Decl_Type (Decl));
             Put_Line (";");
-         when OD_Const_Val =>
+         when OD_Init_Val =>
             Put ("constant ");
             Disp_Decl_Name (Get_Val_Decl (Decl));
             Put (" := ");
diff --git a/src/ortho/mcode/ortho_code-x86-abi.adb b/src/ortho/mcode/ortho_code-x86-abi.adb
index aa6eb1913..b474f2bd6 100644
--- a/src/ortho/mcode/ortho_code-x86-abi.adb
+++ b/src/ortho/mcode/ortho_code-x86-abi.adb
@@ -202,10 +202,15 @@ package body Ortho_Code.X86.Abi is
       Emits.Emit_Var_Decl (Decl);
    end Expand_Var_Decl;
 
-   procedure Expand_Const_Value (Decl : O_Dnode; Val : O_Cnode) is
+   procedure Expand_Var_Zero (Decl : O_Dnode) is
    begin
-      Emits.Emit_Const_Value (Decl, Val);
-   end Expand_Const_Value;
+      Emits.Emit_Var_Zero (Decl);
+   end Expand_Var_Zero;
+
+   procedure Expand_Init_Value (Decl : O_Dnode; Val : O_Cnode) is
+   begin
+      Emits.Emit_Init_Value (Decl, Val);
+   end Expand_Init_Value;
 
    procedure Disp_Label (Label : O_Enode)
    is
diff --git a/src/ortho/mcode/ortho_code-x86-abi.ads b/src/ortho/mcode/ortho_code-x86-abi.ads
index 484cf3cfe..83fd6e6e9 100644
--- a/src/ortho/mcode/ortho_code-x86-abi.ads
+++ b/src/ortho/mcode/ortho_code-x86-abi.ads
@@ -58,7 +58,12 @@ package Ortho_Code.X86.Abi is
 
    procedure Expand_Const_Decl (Decl : O_Dnode);
    procedure Expand_Var_Decl (Decl : O_Dnode);
-   procedure Expand_Const_Value (Decl : O_Dnode; Val : O_Cnode);
+
+   --  Create a variable with a nul default value.
+   procedure Expand_Var_Zero (Decl : O_Dnode);
+
+   --  Set the initial value of a constant or a variable.
+   procedure Expand_Init_Value (Decl : O_Dnode; Val : O_Cnode);
 
    procedure New_Debug_Filename_Decl (Filename : String);
 
diff --git a/src/ortho/mcode/ortho_code-x86-emits.adb b/src/ortho/mcode/ortho_code-x86-emits.adb
index ed17d0bc6..28f621af2 100644
--- a/src/ortho/mcode/ortho_code-x86-emits.adb
+++ b/src/ortho/mcode/ortho_code-x86-emits.adb
@@ -3074,28 +3074,28 @@ package body Ortho_Code.X86.Emits is
       use Decls;
       use Types;
       Sym : Symbol;
-      Storage : O_Storage;
-      Dtype : O_Tnode;
    begin
-      Set_Current_Section (Sect_Bss);
       Sym := Create_Symbol (Get_Decl_Ident (Decl), False);
       Set_Decl_Info (Decl, To_Int32 (Uns32 (Sym)));
-      Storage := Get_Decl_Storage (Decl);
-      Dtype := Get_Decl_Type (Decl);
-      case Storage is
-         when O_Storage_External =>
-            null;
-         when O_Storage_Public
-           | O_Storage_Private =>
-            Gen_Pow_Align (Get_Type_Align (Dtype));
-            Set_Symbol_Pc (Sym, Storage = O_Storage_Public);
-            Gen_Space (Integer_32 (Get_Type_Size (Dtype)));
-         when O_Storage_Local =>
-            raise Program_Error;
-      end case;
-      Set_Current_Section (Sect_Text);
    end Emit_Var_Decl;
 
+   procedure Emit_Var_Zero (Decl : O_Dnode)
+   is
+      use Decls;
+      use Types;
+      Sym : constant Symbol := Symbol (To_Uns32 (Get_Decl_Info (Decl)));
+      Storage : constant O_Storage := Get_Decl_Storage (Decl);
+      Dtype : constant O_Tnode := Get_Decl_Type (Decl);
+   begin
+      Set_Current_Section (Sect_Bss);
+      pragma Assert (Storage = O_Storage_Public
+                       or Storage = O_Storage_Private);
+      Gen_Pow_Align (Get_Type_Align (Dtype));
+      Set_Symbol_Pc (Sym, Storage = O_Storage_Public);
+      Gen_Space (Integer_32 (Get_Type_Size (Dtype)));
+      Set_Current_Section (Sect_Text);
+   end Emit_Var_Zero;
+
    procedure Emit_Const_Decl (Decl : O_Dnode)
    is
       use Decls;
@@ -3164,14 +3164,21 @@ package body Ortho_Code.X86.Emits is
       end case;
    end Emit_Const;
 
-   procedure Emit_Const_Value (Decl : O_Dnode; Val : O_Cnode)
+   procedure Emit_Init_Value (Decl : O_Dnode; Val : O_Cnode)
    is
       use Decls;
       use Types;
       Sym : constant Symbol := Get_Decl_Symbol (Decl);
       Dtype : constant O_Tnode := Get_Decl_Type (Decl);
    begin
-      Set_Current_Section (Sect_Rodata);
+      case Get_Decl_Kind (Decl) is
+         when OD_Const =>
+            Set_Current_Section (Sect_Rodata);
+         when OD_Var =>
+            Set_Current_Section (Sect_Rodata);
+         when others =>
+            raise Syntax_Error;
+      end case;
 
       Gen_Pow_Align (Get_Type_Align (Dtype));
       Set_Symbol_Pc (Sym, Get_Decl_Storage (Decl) = O_Storage_Public);
@@ -3179,7 +3186,7 @@ package body Ortho_Code.X86.Emits is
       Emit_Const (Val);
 
       Set_Current_Section (Sect_Text);
-   end Emit_Const_Value;
+   end Emit_Init_Value;
 
    procedure Init
    is
diff --git a/src/ortho/mcode/ortho_code-x86-emits.ads b/src/ortho/mcode/ortho_code-x86-emits.ads
index 1813f9bd2..da3138575 100644
--- a/src/ortho/mcode/ortho_code-x86-emits.ads
+++ b/src/ortho/mcode/ortho_code-x86-emits.ads
@@ -25,8 +25,10 @@ package Ortho_Code.X86.Emits is
    procedure Emit_Subprg (Subprg : Subprogram_Data_Acc);
 
    procedure Emit_Var_Decl (Decl : O_Dnode);
+   procedure Emit_Var_Zero (Decl : O_Dnode);
+
    procedure Emit_Const_Decl (Decl : O_Dnode);
-   procedure Emit_Const_Value (Decl : O_Dnode; Val : O_Cnode);
+   procedure Emit_Init_Value (Decl : O_Dnode; Val : O_Cnode);
 
    type Intrinsic_Symbols_Map is array (Intrinsics_X86) of Symbol;
    Intrinsics_Symbol : Intrinsic_Symbols_Map;
diff --git a/src/ortho/mcode/ortho_code-x86-insns.adb b/src/ortho/mcode/ortho_code-x86-insns.adb
index ba6919ed1..9fe2218e8 100644
--- a/src/ortho/mcode/ortho_code-x86-insns.adb
+++ b/src/ortho/mcode/ortho_code-x86-insns.adb
@@ -172,7 +172,7 @@ package body Ortho_Code.X86.Insns is
                end if;
             when OD_Type
               | OD_Const
-              | OD_Const_Val
+              | OD_Init_Val
               | OD_Var
               | OD_Function
               | OD_Procedure
diff --git a/src/ortho/mcode/ortho_mcode.adb b/src/ortho/mcode/ortho_mcode.adb
index 55e890bf3..77e101721 100644
--- a/src/ortho/mcode/ortho_mcode.adb
+++ b/src/ortho/mcode/ortho_mcode.adb
@@ -715,6 +715,7 @@ package body Ortho_Mcode is
          Ortho_Code.Decls.Disp_All_Decls;
          --Ortho_Code.Exprs.Disp_All_Enode;
       end if;
+      Ortho_Code.Decls.Alloc_Zero;
       Ortho_Code.Abi.Finish;
       if Debug.Flag_Debug_Stat then
          Ada.Text_IO.Put_Line ("Statistics:");