aboutsummaryrefslogtreecommitdiffstats
path: root/src/ortho/mcode
diff options
context:
space:
mode:
Diffstat (limited to 'src/ortho/mcode')
-rw-r--r--src/ortho/mcode/ortho_code-decls.adb60
-rw-r--r--src/ortho/mcode/ortho_code-decls.ads11
-rw-r--r--src/ortho/mcode/ortho_code-disps.adb2
-rw-r--r--src/ortho/mcode/ortho_code-x86-abi.adb11
-rw-r--r--src/ortho/mcode/ortho_code-x86-abi.ads7
-rw-r--r--src/ortho/mcode/ortho_code-x86-emits.adb47
-rw-r--r--src/ortho/mcode/ortho_code-x86-emits.ads4
-rw-r--r--src/ortho/mcode/ortho_code-x86-insns.adb2
-rw-r--r--src/ortho/mcode/ortho_mcode.adb1
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:");