From 228c201e45fd56cb3a32fed0abb6285a95fa9c91 Mon Sep 17 00:00:00 2001 From: Tristan Gingold Date: Mon, 15 Feb 2016 06:01:47 +0100 Subject: mcode: init support for initialized variables. --- src/ortho/mcode/ortho_code-decls.adb | 60 +++++++++++++++++++++++++++----- src/ortho/mcode/ortho_code-decls.ads | 11 ++++-- src/ortho/mcode/ortho_code-disps.adb | 2 +- src/ortho/mcode/ortho_code-x86-abi.adb | 11 ++++-- src/ortho/mcode/ortho_code-x86-abi.ads | 7 +++- src/ortho/mcode/ortho_code-x86-emits.adb | 47 ++++++++++++++----------- src/ortho/mcode/ortho_code-x86-emits.ads | 4 ++- src/ortho/mcode/ortho_code-x86-insns.adb | 2 +- src/ortho/mcode/ortho_mcode.adb | 1 + 9 files changed, 107 insertions(+), 38 deletions(-) (limited to 'src/ortho/mcode') 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:"); -- cgit v1.2.3