diff options
Diffstat (limited to 'src/ortho/mcode')
| -rw-r--r-- | src/ortho/mcode/ortho_code-consts.adb | 138 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-consts.ads | 21 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-decls.ads | 72 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-disps.adb | 8 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-exprs.adb | 36 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-exprs.ads | 14 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-types.ads | 3 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-x86-abi.adb | 16 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-x86-emits.adb | 27 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code-x86-insns.adb | 8 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_code.ads | 4 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_mcode.adb | 24 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_mcode.ads | 22 | ||||
| -rw-r--r-- | src/ortho/mcode/ortho_mcode.private.ads | 2 |
14 files changed, 287 insertions, 108 deletions
diff --git a/src/ortho/mcode/ortho_code-consts.adb b/src/ortho/mcode/ortho_code-consts.adb index 7cc554211..1b2146dc4 100644 --- a/src/ortho/mcode/ortho_code-consts.adb +++ b/src/ortho/mcode/ortho_code-consts.adb @@ -19,6 +19,7 @@ with Ada.Unchecked_Conversion; with Tables; with Ada.Text_IO; with Ortho_Code.Types; use Ortho_Code.Types; +with Ortho_Code.Decls; with Ortho_Code.Debug; package body Ortho_Code.Consts is @@ -59,6 +60,12 @@ package body Ortho_Code.Consts is end record; for Cnode_Addr'Size use 64; + type Cnode_Global is record + Obj : O_Gnode; + Pad : Int32; + end record; + for Cnode_Global'Size use 64; + type Cnode_Aggr is record Els : Int32; Nbr : Int32; @@ -83,11 +90,43 @@ package body Ortho_Code.Consts is Table_Low_Bound => 2, Table_Initial => 128); + type Gnode_Common is record + Kind : OG_Kind; + Ref : Int32; + end record; + for Gnode_Common use record + Kind at 0 range 0 .. 31; + Ref at 4 range 0 .. 31; + end record; + for Gnode_Common'Size use 64; + + type Gnode_Record_Ref is record + Field : O_Fnode; + Off : Uns32; + end record; + for Gnode_Record_Ref'Size use 64; + + function To_Gnode_Common is new Ada.Unchecked_Conversion + (Gnode_Record_Ref, Gnode_Common); + function To_Gnode_Record_Ref is new Ada.Unchecked_Conversion + (Gnode_Common, Gnode_Record_Ref); + + package Gnodes is new Tables + (Table_Component_Type => Gnode_Common, + Table_Index_Type => O_Gnode, + Table_Low_Bound => 2, + Table_Initial => 64); + function Get_Const_Kind (Cst : O_Cnode) return OC_Kind is begin return Cnodes.Table (Cst).Kind; end Get_Const_Kind; + function Get_Global_Kind (Cst : O_Gnode) return OG_Kind is + begin + return Gnodes.Table (Cst).Kind; + end Get_Global_Kind; + function Get_Const_Type (Cst : O_Cnode) return O_Tnode is begin return Cnodes.Table (Cst).Lit_Type; @@ -227,12 +266,12 @@ package body Ortho_Code.Consts is end New_Default_Value; function To_Cnode_Common is new Ada.Unchecked_Conversion - (Source => Cnode_Addr, Target => Cnode_Common); + (Source => Cnode_Global, Target => Cnode_Common); - function To_Cnode_Addr is new Ada.Unchecked_Conversion - (Source => Cnode_Common, Target => Cnode_Addr); + function To_Cnode_Global is new Ada.Unchecked_Conversion + (Source => Cnode_Common, Target => Cnode_Global); - function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode) + function New_Global_Unchecked_Address (Lvalue : O_Gnode; Atype : O_Tnode) return O_Cnode is Res : O_Cnode; @@ -240,12 +279,12 @@ package body Ortho_Code.Consts is Cnodes.Append (Cnode_Common'(Kind => OC_Address, Lit_Type => Atype)); Res := Cnodes.Last; - Cnodes.Append (To_Cnode_Common (Cnode_Addr'(Decl => Decl, - Pad => 0))); + Cnodes.Append (To_Cnode_Common (Cnode_Global'(Obj => Lvalue, + Pad => 0))); return Res; end New_Global_Unchecked_Address; - function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) + function New_Global_Address (Lvalue : O_Gnode; Atype : O_Tnode) return O_Cnode is Res : O_Cnode; @@ -253,11 +292,23 @@ package body Ortho_Code.Consts is Cnodes.Append (Cnode_Common'(Kind => OC_Address, Lit_Type => Atype)); Res := Cnodes.Last; - Cnodes.Append (To_Cnode_Common (Cnode_Addr'(Decl => Decl, - Pad => 0))); + Cnodes.Append (To_Cnode_Common (Cnode_Global'(Obj => Lvalue, + Pad => 0))); return Res; end New_Global_Address; + function Get_Const_Global (Cst : O_Cnode) return O_Gnode is + begin + pragma Assert (Get_Const_Kind (Cst) = OC_Address); + return To_Cnode_Global (Cnodes.Table (Cst + 1)).Obj; + end Get_Const_Global; + + function To_Cnode_Common is new Ada.Unchecked_Conversion + (Source => Cnode_Addr, Target => Cnode_Common); + + function To_Cnode_Addr is new Ada.Unchecked_Conversion + (Source => Cnode_Common, Target => Cnode_Addr); + function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode) return O_Cnode is @@ -273,6 +324,7 @@ package body Ortho_Code.Consts is function Get_Const_Decl (Cst : O_Cnode) return O_Dnode is begin + pragma Assert (Get_Const_Kind (Cst) = OC_Subprg_Address); return To_Cnode_Addr (Cnodes.Table (Cst + 1)).Decl; end Get_Const_Decl; @@ -512,6 +564,74 @@ package body Ortho_Code.Consts is (Rtype, Unsigned_64 (Get_Field_Offset (Field))); end New_Offsetof; + function Get_Global_Decl (Global : O_Gnode) return O_Dnode is + begin + pragma Assert (Get_Global_Kind (Global) = OG_Decl); + return O_Dnode (Gnodes.Table (Global).Ref); + end Get_Global_Decl; + + function Get_Global_Field (Global : O_Gnode) return O_Fnode is + begin + pragma Assert (Get_Global_Kind (Global) = OG_Record_Ref); + return To_Gnode_Record_Ref (Gnodes.Table (Global + 1)).Field; + end Get_Global_Field; + + function Get_Global_Ref (Global : O_Gnode) return O_Gnode is + begin + pragma Assert (Get_Global_Kind (Global) = OG_Record_Ref); + return O_Gnode (Gnodes.Table (Global).Ref); + end Get_Global_Ref; + + function Get_Global_Type (Global : O_Gnode) return O_Tnode is + begin + case Get_Global_Kind (Global) is + when OG_Decl => + return Decls.Get_Decl_Type (Get_Global_Decl (Global)); + when OG_Record_Ref => + return Get_Field_Type (Get_Global_Field (Global)); + end case; + end Get_Global_Type; + + function New_Global (Decl : O_Dnode) return O_Gnode is + begin + Gnodes.Append (Gnode_Common'(Kind => OG_Decl, + Ref => Int32 (Decl))); + return Gnodes.Last; + end New_Global; + + function New_Global_Selected_Element (Rec : O_Gnode; El : O_Fnode) + return O_Gnode + is + Res : O_Gnode; + begin + -- TODO: Check Ref. + + -- Check type. + pragma Assert + (Get_Type_Kind (Get_Global_Type (Rec)) in OT_Kinds_Record_Union); + + Gnodes.Append (Gnode_Common'(Kind => OG_Record_Ref, + Ref => Int32 (Rec))); + Res := Gnodes.Last; + Gnodes.Append (To_Gnode_Common + (Gnode_Record_Ref'(Field => El, + Off => Get_Field_Offset (El)))); + return Res; + end New_Global_Selected_Element; + + procedure Get_Global_Decl_Offset (Global : O_Gnode; + Decl : out O_Dnode; Off : out Uns32) is + begin + case Get_Global_Kind (Global) is + when OG_Decl => + Decl := Get_Global_Decl (Global); + Off := 0; + when OG_Record_Ref => + Get_Global_Decl_Offset (Get_Global_Ref (Global), Decl, Off); + Off := Off + Get_Field_Offset (Get_Global_Field (Global)); + end case; + end Get_Global_Decl_Offset; + procedure Get_Const_Bytes (Cst : O_Cnode; H, L : out Uns32) is begin case Get_Const_Kind (Cst) is diff --git a/src/ortho/mcode/ortho_code-consts.ads b/src/ortho/mcode/ortho_code-consts.ads index 0a4f347fc..dcb719f26 100644 --- a/src/ortho/mcode/ortho_code-consts.ads +++ b/src/ortho/mcode/ortho_code-consts.ads @@ -24,6 +24,8 @@ package Ortho_Code.Consts is OC_Subprg_Address, OC_Address, OC_Sizeof, OC_Alignof); + type OG_Kind is (OG_Decl, OG_Record_Ref); + function Get_Const_Kind (Cst : O_Cnode) return OC_Kind; function Get_Const_Type (Cst : O_Cnode) return O_Tnode; @@ -54,9 +56,12 @@ package Ortho_Code.Consts is function Get_Const_Union_Field (Cst : O_Cnode) return O_Fnode; function Get_Const_Union_Value (Cst : O_Cnode) return O_Cnode; - -- Declaration for an address. + -- Declaration for a subprogram address. function Get_Const_Decl (Cst : O_Cnode) return O_Dnode; + -- Object for a global object address. + function Get_Const_Global (Cst : O_Cnode) return O_Gnode; + -- Get the type from an OC_Sizeof node. function Get_Sizeof_Type (Cst : O_Cnode) return O_Tnode; @@ -77,14 +82,22 @@ package Ortho_Code.Consts is -- Create a null access literal. function New_Null_Access (Ltype : O_Tnode) return O_Cnode; - function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode) - return O_Cnode; function New_Default_Value (Ltype : O_Tnode) return O_Cnode; - function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) + function New_Global_Unchecked_Address (Lvalue : O_Gnode; Atype : O_Tnode) + return O_Cnode; + function New_Global_Address (Lvalue : O_Gnode; Atype : O_Tnode) return O_Cnode; function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode) return O_Cnode; + function New_Global (Decl : O_Dnode) return O_Gnode; + + function New_Global_Selected_Element (Rec : O_Gnode; El : O_Fnode) + return O_Gnode; + + procedure Get_Global_Decl_Offset (Global : O_Gnode; + Decl : out O_Dnode; Off : out Uns32); + function New_Named_Literal (Atype : O_Tnode; Id : O_Ident; Val : Uns32; Prev : O_Cnode) return O_Cnode; diff --git a/src/ortho/mcode/ortho_code-decls.ads b/src/ortho/mcode/ortho_code-decls.ads index 70a0ba4df..bd84bf2eb 100644 --- a/src/ortho/mcode/ortho_code-decls.ads +++ b/src/ortho/mcode/ortho_code-decls.ads @@ -19,24 +19,27 @@ with Ortho_Code.Abi; package Ortho_Code.Decls is -- Kind of a declaration. - type OD_Kind is (OD_Type, - OD_Const, + type OD_Kind is + ( + OD_Type, + OD_Const, - -- Value of constant, initial value of variable. - OD_Init_Val, + -- Value of constant, initial value of variable. + OD_Init_Val, - -- Global and local variables. - OD_Var, OD_Local, + -- Global and local variables. + OD_Var, OD_Local, - -- Subprograms. - OD_Function, OD_Procedure, + -- Subprograms. + OD_Function, OD_Procedure, - -- Additional node for a subprogram. Internal use only. - OD_Subprg_Ext, + -- Additional node for a subprogram. Internal use only. + OD_Subprg_Ext, - OD_Interface, - OD_Body, - OD_Block); + OD_Interface, + OD_Body, + OD_Block + ); -- Return the kind of declaration DECL. function Get_Decl_Kind (Decl : O_Dnode) return OD_Kind; @@ -126,11 +129,10 @@ package Ortho_Code.Decls is -- This simply gives a name to a constant value or aggregate. -- A constant cannot be modified and its storage cannot be local. -- ATYPE must be constrained. - procedure New_Const_Decl - (Res : out O_Dnode; - Ident : O_Ident; - Storage : O_Storage; - Atype : O_Tnode); + procedure New_Const_Decl (Res : out O_Dnode; + Ident : O_Ident; + Storage : O_Storage; + Atype : O_Tnode); -- Set the value to DECL. procedure New_Init_Value (Decl : O_Dnode; Val : O_Cnode); @@ -138,11 +140,10 @@ package Ortho_Code.Decls is -- Create a variable declaration. -- A variable can be local only inside a function. -- ATYPE must be constrained. - procedure New_Var_Decl - (Res : out O_Dnode; - Ident : O_Ident; - Storage : O_Storage; - Atype : O_Tnode); + procedure New_Var_Decl (Res : out O_Dnode; + Ident : O_Ident; + Storage : O_Storage; + Atype : O_Tnode); type O_Inter_List is limited private; @@ -151,23 +152,20 @@ package Ortho_Code.Decls is -- be declared inside a subprograms. It is not allowed to declare -- o_storage_external subprograms inside a subprograms. -- Return type and interfaces cannot be a composite type. - procedure Start_Function_Decl - (Interfaces : out O_Inter_List; - Ident : O_Ident; - Storage : O_Storage; - Rtype : O_Tnode); + procedure Start_Function_Decl (Interfaces : out O_Inter_List; + Ident : O_Ident; + Storage : O_Storage; + Rtype : O_Tnode); -- For a subprogram without return value. - procedure Start_Procedure_Decl - (Interfaces : out O_Inter_List; - Ident : O_Ident; - Storage : O_Storage); + procedure Start_Procedure_Decl (Interfaces : out O_Inter_List; + Ident : O_Ident; + Storage : O_Storage); -- Add an interface declaration to INTERFACES. - procedure New_Interface_Decl - (Interfaces : in out O_Inter_List; - Res : out O_Dnode; - Ident : O_Ident; - Atype : O_Tnode); + procedure New_Interface_Decl (Interfaces : in out O_Inter_List; + Res : out O_Dnode; + Ident : O_Ident; + Atype : O_Tnode); -- Finish the function declaration, get the node and a statement list. procedure Finish_Subprogram_Decl (Interfaces : in out O_Inter_List; Res : out O_Dnode); diff --git a/src/ortho/mcode/ortho_code-disps.adb b/src/ortho/mcode/ortho_code-disps.adb index d33fe403d..b0b9a353a 100644 --- a/src/ortho/mcode/ortho_code-disps.adb +++ b/src/ortho/mcode/ortho_code-disps.adb @@ -273,18 +273,18 @@ package body Ortho_Code.Disps is begin Op := Get_Expr_Operand (Expr); case Get_Expr_Kind (Op) is - when OE_Addrg + when OE_Addrd | OE_Addrl => - Decls.Disp_Decl_Name (Get_Addr_Object (Op)); + Decls.Disp_Decl_Name (Get_Addr_Decl (Op)); when others => --Put ("*"); Disp_Expr (Op); end case; end; when OE_Addrl - | OE_Addrg => + | OE_Addrd => -- Put ('@'); - Decls.Disp_Decl_Name (Get_Addr_Object (Expr)); + Decls.Disp_Decl_Name (Get_Addr_Decl (Expr)); when OE_Call => Disp_Call (Expr); when OE_Alloca => diff --git a/src/ortho/mcode/ortho_code-exprs.adb b/src/ortho/mcode/ortho_code-exprs.adb index 4e0d6bdc4..fd467e315 100644 --- a/src/ortho/mcode/ortho_code-exprs.adb +++ b/src/ortho/mcode/ortho_code-exprs.adb @@ -160,11 +160,16 @@ package body Ortho_Code.Exprs is Enodes.Table (Enode).Arg2 := Label; end Set_Jump_Label; - function Get_Addr_Object (Enode : O_Enode) return O_Dnode is + function Get_Addr_Object (Enode : O_Enode) return O_Lnode is begin - return O_Dnode (Enodes.Table (Enode).Arg1); + return O_Lnode (Enodes.Table (Enode).Arg1); end Get_Addr_Object; + function Get_Addr_Decl (Enode : O_Enode) return O_Dnode is + begin + return O_Dnode (Enodes.Table (Enode).Arg1); + end Get_Addr_Decl; + function Get_Addrl_Frame (Enode : O_Enode) return O_Enode is begin return Enodes.Table (Enode).Arg2; @@ -492,7 +497,7 @@ package body Ortho_Code.Exprs is Save_Var : O_Dnode; begin Save_Asgn := Get_Stmt_Link (Blk); - Save_Var := Get_Addr_Object (Get_Assign_Target (Save_Asgn)); + Save_Var := Get_Addr_Decl (Get_Assign_Target (Save_Asgn)); New_Enode_Stmt (OE_Set_Stack, New_Value (New_Obj (Save_Var)), O_Enode_Null); end New_Stack_Restore; @@ -696,10 +701,8 @@ package body Ortho_Code.Exprs is function New_Lit (Lit : O_Cnode) return O_Enode is - L_Type : O_Tnode; - H, L : Uns32; + L_Type : constant O_Tnode := Get_Const_Type (Lit); begin - L_Type := Get_Const_Type (Lit); if Flag_Debug_Hli then return New_Enode (OE_Lit, L_Type, O_Enode (Lit), O_Enode_Null); else @@ -709,13 +712,18 @@ package body Ortho_Code.Exprs is | OC_Float | OC_Null | OC_Lit => - Get_Const_Bytes (Lit, H, L); - return New_Enode - (OE_Const, L_Type, - O_Enode (To_Int32 (L)), O_Enode (To_Int32 (H))); - when OC_Address - | OC_Subprg_Address => - return New_Enode (OE_Addrg, L_Type, + declare + H, L : Uns32; + begin + Get_Const_Bytes (Lit, H, L); + return New_Enode + (OE_Const, L_Type, + O_Enode (To_Int32 (L)), O_Enode (To_Int32 (H))); + end; + when OC_Address => + raise Syntax_Error; + when OC_Subprg_Address => + return New_Enode (OE_Addrd, L_Type, O_Enode (Get_Const_Decl (Lit)), O_Enode_Null); when OC_Array | OC_Record @@ -783,7 +791,7 @@ package body Ortho_Code.Exprs is end if; when OD_Var | OD_Const => - Kind := OE_Addrg; + Kind := OE_Addrd; Chain := O_Enode_Null; when others => raise Program_Error; diff --git a/src/ortho/mcode/ortho_code-exprs.ads b/src/ortho/mcode/ortho_code-exprs.ads index 31931702c..0bb5ec2bb 100644 --- a/src/ortho/mcode/ortho_code-exprs.ads +++ b/src/ortho/mcode/ortho_code-exprs.ads @@ -63,9 +63,9 @@ package Ortho_Code.Exprs is -- ARG1 is object. -- ARG2 is the frame pointer or O_Enode_Null for current frame pointer. OE_Addrl, - -- Address of a global variable. - -- ARG1 is object. - OE_Addrg, + -- Address of a declaration. + -- ARG1 is the declaration. + OE_Addrd, -- Pointer dereference. -- ARG1 is operand. @@ -214,7 +214,6 @@ package Ortho_Code.Exprs is subtype OE_Kind_Dyadic is OE_Kind range OE_Add_Ov .. OE_Xor; subtype OE_Kind_Cmp is OE_Kind range OE_Eq .. OE_Gt; - -- BE representation of an instruction. type O_Insn is mod 256; @@ -329,8 +328,11 @@ package Ortho_Code.Exprs is function Get_Jump_Label (Enode : O_Enode) return O_Enode; procedure Set_Jump_Label (Enode : O_Enode; Label : O_Enode); - -- Get the object of addrl,addrp,addrg - function Get_Addr_Object (Enode : O_Enode) return O_Dnode; + -- Get the declaration of addrl,addrp,addrs + function Get_Addr_Decl (Enode : O_Enode) return O_Dnode; + + -- Get the object of addrg + function Get_Addr_Object (Enode : O_Enode) return O_Lnode; -- Get the computed frame for the object. -- If O_Enode_Null, then use current frame. diff --git a/src/ortho/mcode/ortho_code-types.ads b/src/ortho/mcode/ortho_code-types.ads index da6549841..a9d15b60a 100644 --- a/src/ortho/mcode/ortho_code-types.ads +++ b/src/ortho/mcode/ortho_code-types.ads @@ -24,6 +24,8 @@ package Ortho_Code.Types is -- Optionnal. OT_Complete); + subtype OT_Kinds_Record_Union is OT_Kind range OT_Record .. OT_Union; + -- Kind of ATYPE. function Get_Type_Kind (Atype : O_Tnode) return OT_Kind; @@ -237,4 +239,3 @@ private end record; end Ortho_Code.Types; - diff --git a/src/ortho/mcode/ortho_code-x86-abi.adb b/src/ortho/mcode/ortho_code-x86-abi.adb index d76563a3e..ba9b437d9 100644 --- a/src/ortho/mcode/ortho_code-x86-abi.adb +++ b/src/ortho/mcode/ortho_code-x86-abi.adb @@ -243,7 +243,7 @@ package body Ortho_Code.X86.Abi is is use Ada.Text_IO; use Ortho_Code.Debug.Int32_IO; - Obj : constant O_Dnode := Get_Addr_Object (Stmt); + Obj : constant O_Dnode := Get_Addr_Decl (Stmt); Frame : constant O_Enode := Get_Addrl_Frame (Stmt); begin if Frame = O_Enode_Null then @@ -315,9 +315,9 @@ package body Ortho_Code.X86.Abi is case Kind is when OE_Const => Disp_Const (Stmt); - when OE_Addrg => + when OE_Addrd => Put ("&"); - Disp_Decl_Name (Get_Addr_Object (Stmt)); + Disp_Decl_Name (Get_Addr_Decl (Stmt)); when OE_Add => Disp_Irm_Code (Get_Expr_Left (Stmt)); Put ("+"); @@ -348,9 +348,9 @@ package body Ortho_Code.X86.Abi is Disp_Irm_Code (Get_Expr_Left (Stmt)); Put (" + "); Disp_Irm_Code (Get_Expr_Right (Stmt)); - when OE_Addrg => + when OE_Addrd => Put ("&"); - Disp_Decl_Name (Get_Addr_Object (Stmt)); + Disp_Decl_Name (Get_Addr_Decl (Stmt)); when others => raise Program_Error; end case; @@ -587,10 +587,10 @@ package body Ortho_Code.X86.Abi is Disp_Local (Stmt); Put (")"); New_Line; - when OE_Addrg => - Disp_Reg_Op_Name ("lea{addrg}"); + when OE_Addrd => + Disp_Reg_Op_Name ("lea{addrd}"); Put ("&"); - Disp_Decl_Name (Get_Addr_Object (Stmt)); + Disp_Decl_Name (Get_Addr_Decl (Stmt)); New_Line; when OE_Add => Disp_Reg_Op_Name ("lea{add}"); diff --git a/src/ortho/mcode/ortho_code-x86-emits.adb b/src/ortho/mcode/ortho_code-x86-emits.adb index d26a830f7..cc27a3a23 100644 --- a/src/ortho/mcode/ortho_code-x86-emits.adb +++ b/src/ortho/mcode/ortho_code-x86-emits.adb @@ -277,8 +277,8 @@ package body Ortho_Code.X86.Emits is Off := Off + To_Int32 (Get_Expr_Low (C)); P := S; end loop; - pragma Assert (Get_Expr_Kind (P) = OE_Addrg); - Sym := Get_Decl_Symbol (Get_Addr_Object (P)); + pragma Assert (Get_Expr_Kind (P) = OE_Addrd); + Sym := Get_Decl_Symbol (Get_Addr_Decl (P)); Gen_Abs (Sym, Integer_32 (Off)); end Gen_Imm_Addr; @@ -303,7 +303,7 @@ package body Ortho_Code.X86.Emits is Gen_32 (Unsigned_32 (Get_Expr_Low (N))); end case; when OE_Add - | OE_Addrg => + | OE_Addrd => -- Only for 32-bit immediat. pragma Assert (Sz = Sz_32); Gen_Imm_Addr (N); @@ -470,11 +470,11 @@ package body Ortho_Code.X86.Emits is Rm_Base := Get_Expr_Reg (Frame); end if; end; - Rm_Offset := Rm_Offset + Get_Local_Offset (Get_Addr_Object (N)); - when OE_Addrg => + Rm_Offset := Rm_Offset + Get_Local_Offset (Get_Addr_Decl (N)); + when OE_Addrd => -- Cannot add two symbols. pragma Assert (Rm_Sym = Null_Symbol); - Rm_Sym := Get_Decl_Symbol (Get_Addr_Object (N)); + Rm_Sym := Get_Decl_Symbol (Get_Addr_Decl (N)); when OE_Add => Fill_Sib (Get_Expr_Left (N)); Fill_Sib (Get_Expr_Right (N)); @@ -2525,10 +2525,10 @@ package body Ortho_Code.X86.Emits is -- Result is in eflags. pragma Assert (Get_Expr_Reg (Stmt) in Regs_Cc); end; - when OE_Addrg => + when OE_Addrd => pragma Assert (Mode = Abi.Mode_Ptr); if Flags.M64 - and then not Insns.Is_External_Object (Get_Addr_Object (Stmt)) + and then not Insns.Is_External_Object (Get_Addr_Decl (Stmt)) then -- Use RIP relative to load an address. Emit_Lea (Stmt); @@ -3163,8 +3163,15 @@ package body Ortho_Code.X86.Emits is when others => raise Program_Error; end case; - when OC_Address - | OC_Subprg_Address => + when OC_Address => + declare + Decl : O_Dnode; + Off : Uns32; + begin + Get_Global_Decl_Offset (Get_Const_Global (Val), Decl, Off); + Gen_Abs (Get_Decl_Symbol (Decl), Integer_32 (To_Int32 (Off))); + end; + when OC_Subprg_Address => Gen_Abs (Get_Decl_Symbol (Get_Const_Decl (Val)), 0); when OC_Array => for I in 0 .. Get_Const_Aggr_Length (Val) - 1 loop diff --git a/src/ortho/mcode/ortho_code-x86-insns.adb b/src/ortho/mcode/ortho_code-x86-insns.adb index acdcc7746..5429df016 100644 --- a/src/ortho/mcode/ortho_code-x86-insns.adb +++ b/src/ortho/mcode/ortho_code-x86-insns.adb @@ -848,7 +848,7 @@ package body Ortho_Code.X86.Insns is Set_Addrl_Frame (Expr, Reload (Spill, R_Any32, Num)); end if; return Expr; - when OE_Addrg => + when OE_Addrd => return Expr; when others => Error_Reg ("reload: unhandle expr in b_off", Expr, Dest); @@ -938,7 +938,7 @@ package body Ortho_Code.X86.Insns is if Get_Addrl_Frame (Insn) /= O_Enode_Null then Free_Insn_Regs (Get_Addrl_Frame (Insn)); end if; - when OE_Addrg => + when OE_Addrd => -- RIP-relative, no reg to free. null; when others => @@ -1358,11 +1358,11 @@ package body Ortho_Code.X86.Insns is when others => Error_Gen_Insn (Stmt, Reg); end case; - when OE_Addrg => + when OE_Addrd => if Flags.M64 then -- Use RIP-Relative addressing. if Reg = R_Sib - and then not Is_External_Object (Get_Addr_Object (Stmt)) + and then not Is_External_Object (Get_Addr_Decl (Stmt)) then Set_Expr_Reg (Stmt, R_Sib); else diff --git a/src/ortho/mcode/ortho_code.ads b/src/ortho/mcode/ortho_code.ads index 0657b07e6..489eeeccf 100644 --- a/src/ortho/mcode/ortho_code.ads +++ b/src/ortho/mcode/ortho_code.ads @@ -65,6 +65,10 @@ package Ortho_Code is for O_Lnode'Size use 32; O_Lnode_Null : constant O_Lnode := 0; + type O_Gnode is new Int32; + for O_Gnode'Size use 32; + O_Gnode_Null : constant O_Gnode := 0; + type O_Ident is new Int32; O_Ident_Nul : constant O_Ident := 0; diff --git a/src/ortho/mcode/ortho_mcode.adb b/src/ortho/mcode/ortho_mcode.adb index fac45e438..16638300d 100644 --- a/src/ortho/mcode/ortho_mcode.adb +++ b/src/ortho/mcode/ortho_mcode.adb @@ -347,22 +347,36 @@ package body Ortho_Mcode is (Ortho_Code.O_Dnode (Subprg), Ortho_Code.O_Tnode (Atype))); end New_Subprogram_Address; - function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) - return O_Cnode is + function New_Global_Address (Lvalue : O_Gnode; Atype : O_Tnode) + return O_Cnode is begin return O_Cnode (Ortho_Code.Consts.New_Global_Address - (Ortho_Code.O_Dnode (Decl), Ortho_Code.O_Tnode (Atype))); + (Ortho_Code.O_Gnode (Lvalue), Ortho_Code.O_Tnode (Atype))); end New_Global_Address; - function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode) + function New_Global_Unchecked_Address (Lvalue : O_Gnode; Atype : O_Tnode) return O_Cnode is begin return O_Cnode (Ortho_Code.Consts.New_Global_Unchecked_Address - (Ortho_Code.O_Dnode (Decl), Ortho_Code.O_Tnode (Atype))); + (Ortho_Code.O_Gnode (Lvalue), Ortho_Code.O_Tnode (Atype))); end New_Global_Unchecked_Address; + function New_Global (Decl : O_Dnode) return O_Gnode is + begin + return O_Gnode + (Ortho_Code.Consts.New_Global (Ortho_Code.O_Dnode (Decl))); + end New_Global; + + function New_Global_Selected_Element (Rec : O_Gnode; El : O_Fnode) + return O_Gnode is + begin + return O_Gnode + (Ortho_Code.Consts.New_Global_Selected_Element + (Ortho_Code.O_Gnode (Rec), Ortho_Code.O_Fnode (El))); + end New_Global_Selected_Element; + function New_Lit (Lit : O_Cnode) return O_Enode is begin return O_Enode (Ortho_Code.Exprs.New_Lit (Ortho_Code.O_Cnode (Lit))); diff --git a/src/ortho/mcode/ortho_mcode.ads b/src/ortho/mcode/ortho_mcode.ads index dda220f1c..515242561 100644 --- a/src/ortho/mcode/ortho_mcode.ads +++ b/src/ortho/mcode/ortho_mcode.ads @@ -41,10 +41,12 @@ package Ortho_Mcode is type O_Tnode is private; type O_Snode is private; type O_Dnode is private; + type O_Gnode is private; type O_Fnode is private; O_Cnode_Null : constant O_Cnode; O_Dnode_Null : constant O_Dnode; + O_Gnode_Null : constant O_Gnode; O_Enode_Null : constant O_Enode; O_Fnode_Null : constant O_Fnode; O_Lnode_Null : constant O_Lnode; @@ -190,17 +192,17 @@ package Ortho_Mcode is -- Get the address of a subprogram. function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode) - return O_Cnode; + return O_Cnode; -- Get the address of LVALUE. -- ATYPE must be a type access whose designated type is the type of LVALUE. -- FIXME: what about arrays. - function New_Global_Address (Decl : O_Dnode; Atype : O_Tnode) + function New_Global_Address (Lvalue : O_Gnode; Atype : O_Tnode) return O_Cnode; -- Same as New_Address but without any restriction. - function New_Global_Unchecked_Address (Decl : O_Dnode; Atype : O_Tnode) - return O_Cnode; + function New_Global_Unchecked_Address (Lvalue : O_Gnode; Atype : O_Tnode) + return O_Cnode; ------------------- -- Expressions -- @@ -299,12 +301,15 @@ package Ortho_Mcode is -- base type of ARR. -- INDEX must be of the type of the array index. function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode) - return O_Lnode; + return O_Lnode; -- Get an element of a record or a union. -- Type of REC must be a record or a union type. function New_Selected_Element (Rec : O_Lnode; El : O_Fnode) - return O_Lnode; + return O_Lnode; + + function New_Global_Selected_Element (Rec : O_Gnode; El : O_Fnode) + return O_Gnode; -- Reference an access. -- Type of ACC must be an access type. @@ -331,6 +336,9 @@ package Ortho_Mcode is -- Get an lvalue from a declaration. function New_Obj (Obj : O_Dnode) return O_Lnode; + -- Get a global lvalue from a declaration. + function New_Global (Decl : O_Dnode) return O_Gnode; + -- Return a pointer of type RTPE to SIZE bytes allocated on the stack. function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode; @@ -476,9 +484,11 @@ private type O_Enode is new Ortho_Code.O_Enode; type O_Fnode is new Ortho_Code.O_Fnode; type O_Lnode is new Ortho_Code.O_Lnode; + type O_Gnode is new Ortho_Code.O_Gnode; type O_Snode is new Ortho_Code.Exprs.O_Snode; O_Lnode_Null : constant O_Lnode := O_Lnode (Ortho_Code.O_Lnode_Null); + O_Gnode_Null : constant O_Gnode := O_Gnode (Ortho_Code.O_Gnode_Null); O_Cnode_Null : constant O_Cnode := O_Cnode (Ortho_Code.O_Cnode_Null); O_Dnode_Null : constant O_Dnode := O_Dnode (Ortho_Code.O_Dnode_Null); O_Enode_Null : constant O_Enode := O_Enode (Ortho_Code.O_Enode_Null); diff --git a/src/ortho/mcode/ortho_mcode.private.ads b/src/ortho/mcode/ortho_mcode.private.ads index 5374ae978..a78a1a170 100644 --- a/src/ortho/mcode/ortho_mcode.private.ads +++ b/src/ortho/mcode/ortho_mcode.private.ads @@ -40,9 +40,11 @@ private type O_Enode is new Ortho_Code.O_Enode; type O_Fnode is new Ortho_Code.O_Fnode; type O_Lnode is new Ortho_Code.O_Lnode; + type O_Gnode is new Ortho_Code.O_Gnode; type O_Snode is new Ortho_Code.Exprs.O_Snode; O_Lnode_Null : constant O_Lnode := O_Lnode (Ortho_Code.O_Lnode_Null); + O_Gnode_Null : constant O_Gnode := O_Gnode (Ortho_Code.O_Gnode_Null); O_Cnode_Null : constant O_Cnode := O_Cnode (Ortho_Code.O_Cnode_Null); O_Dnode_Null : constant O_Dnode := O_Dnode (Ortho_Code.O_Dnode_Null); O_Enode_Null : constant O_Enode := O_Enode (Ortho_Code.O_Enode_Null); |