diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ortho/mcode/ortho_code-decls.adb | 60 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-decls.ads | 11 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-disps.adb | 2 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-x86-abi.adb | 11 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-x86-abi.ads | 7 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-x86-emits.adb | 47 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-x86-emits.ads | 4 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-x86-insns.adb | 2 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_mcode.adb | 1 | 
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:"); | 
