diff options
Diffstat (limited to 'ortho/mcode/ortho_code-x86-abi.adb')
| -rw-r--r-- | ortho/mcode/ortho_code-x86-abi.adb | 762 |
1 files changed, 0 insertions, 762 deletions
diff --git a/ortho/mcode/ortho_code-x86-abi.adb b/ortho/mcode/ortho_code-x86-abi.adb deleted file mode 100644 index bb06d51d4..000000000 --- a/ortho/mcode/ortho_code-x86-abi.adb +++ /dev/null @@ -1,762 +0,0 @@ --- X86 ABI definitions. --- Copyright (C) 2006 Tristan Gingold --- --- GHDL is free software; you can redistribute it and/or modify it under --- the terms of the GNU General Public License as published by the Free --- Software Foundation; either version 2, or (at your option) any later --- version. --- --- GHDL is distributed in the hope that it will be useful, but WITHOUT ANY --- WARRANTY; without even the implied warranty of MERCHANTABILITY or --- FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --- for more details. --- --- You should have received a copy of the GNU General Public License --- along with GCC; see the file COPYING. If not, write to the Free --- Software Foundation, 59 Temple Place - Suite 330, Boston, MA --- 02111-1307, USA. -with Ortho_Code.Decls; use Ortho_Code.Decls; -with Ortho_Code.Exprs; use Ortho_Code.Exprs; -with Ortho_Code.Consts; -with Ortho_Code.Debug; -with Ortho_Code.Disps; -with Ortho_Code.Flags; -with Ortho_Code.Dwarf; -with Ortho_Code.X86; use Ortho_Code.X86; -with Ortho_Code.X86.Insns; -with Ortho_Code.X86.Emits; -with Ortho_Code.X86.Flags; -with Binary_File; -with Binary_File.Memory; -with Ada.Text_IO; - -package body Ortho_Code.X86.Abi is - procedure Start_Subprogram (Subprg : O_Dnode; Abi : out O_Abi_Subprg) - is - pragma Unreferenced (Subprg); - begin - -- First argument is at %ebp + 8 - Abi.Offset := 8; - end Start_Subprogram; - - procedure New_Interface (Inter : O_Dnode; Abi : in out O_Abi_Subprg) - is - Itype : O_Tnode; - Size : Uns32; - begin - Itype := Get_Decl_Type (Inter); - Size := Get_Type_Size (Itype); - Size := (Size + 3) and not 3; - Set_Local_Offset (Inter, Abi.Offset); - Abi.Offset := Abi.Offset + Int32 (Size); - end New_Interface; - - procedure Finish_Subprogram (Subprg : O_Dnode; Abi : in out O_Abi_Subprg) - is - use Binary_File; - function To_Int32 is new Ada.Unchecked_Conversion - (Source => Symbol, Target => Int32); - begin - Set_Decl_Info (Subprg, - To_Int32 (Create_Symbol (Get_Decl_Ident (Subprg)))); - -- Offset is 8 biased. - Set_Subprg_Stack (Subprg, Abi.Offset - 8); - end Finish_Subprogram; - - procedure Link_Stmt (Stmt : O_Enode) is - begin - Set_Stmt_Link (Last_Link, Stmt); - Last_Link := Stmt; - end Link_Stmt; - - procedure Disp_Subprg (Subprg : O_Dnode); - - - Exprs_Mark : Exprs.Mark_Type; - Decls_Mark : Decls.Mark_Type; - Consts_Mark : Consts.Mark_Type; - Types_Mark : Types.Mark_Type; - Dwarf_Mark : Dwarf.Mark_Type; - - procedure Start_Body (Subprg : O_Dnode) - is - pragma Unreferenced (Subprg); - begin - if not Debug.Flag_Debug_Keep then - Mark (Exprs_Mark); - Mark (Decls_Mark); - Consts.Mark (Consts_Mark); - Mark (Types_Mark); - end if; - end Start_Body; - - procedure Finish_Body (Subprg : Subprogram_Data_Acc) - is - use Ortho_Code.Flags; - - Child : Subprogram_Data_Acc; - begin - if Debug.Flag_Debug_Hli then - Disps.Disp_Subprg (Subprg); - return; - end if; - - Insns.Gen_Subprg_Insns (Subprg); - - if Ortho_Code.Debug.Flag_Debug_Body2 then - Disp_Subprg_Body (1, Subprg.E_Entry); - end if; - - if Ortho_Code.Debug.Flag_Debug_Code then - Disp_Subprg (Subprg.D_Body); - end if; - - Emits.Emit_Subprg (Subprg); - - if Get_Decl_Depth (Subprg.D_Decl) = O_Toplevel - and then Flag_Debug = Debug_Dwarf - then - Dwarf.Emit_Decls_Until (Subprg.D_Body); - if not Debug.Flag_Debug_Keep then - Dwarf.Mark (Dwarf_Mark); - end if; - end if; - - -- Recurse on nested subprograms. - Child := Subprg.First_Child; - while Child /= null loop - Finish_Body (Child); - Child := Child.Brother; - end loop; - - if Get_Decl_Depth (Subprg.D_Decl) = O_Toplevel then - if Flag_Debug = Debug_Dwarf then - Dwarf.Emit_Subprg (Subprg.D_Body); - end if; - - if not Debug.Flag_Debug_Keep then - Release (Exprs_Mark); - Release (Decls_Mark); - Consts.Release (Consts_Mark); - Release (Types_Mark); - Dwarf.Release (Dwarf_Mark); - end if; - end if; - end Finish_Body; - - procedure Expand_Const_Decl (Decl : O_Dnode) is - begin - Emits.Emit_Const_Decl (Decl); - end Expand_Const_Decl; - - procedure Expand_Var_Decl (Decl : O_Dnode) is - begin - Emits.Emit_Var_Decl (Decl); - end Expand_Var_Decl; - - procedure Expand_Const_Value (Decl : O_Dnode; Val : O_Cnode) is - begin - Emits.Emit_Const_Value (Decl, Val); - end Expand_Const_Value; - - procedure Disp_Label (Label : O_Enode) - is - use Ada.Text_IO; - use Ortho_Code.Debug.Int32_IO; - begin - Put ("L"); - Put (Int32 (Label), 0); - end Disp_Label; - - procedure Disp_Reg (Reg : O_Enode) - is - use Ada.Text_IO; - use Ortho_Code.Debug.Int32_IO; - begin - Put ("reg_"); - Put (Int32 (Reg), 0); - Put ("{"); - Put (Image_Reg (Get_Expr_Reg (Reg))); - Put ("}"); - end Disp_Reg; - - procedure Disp_Local (Stmt : O_Enode) - is - use Ada.Text_IO; - use Ortho_Code.Debug.Int32_IO; - Obj : constant O_Dnode := Get_Addr_Object (Stmt); - Frame : constant O_Enode := Get_Addrl_Frame (Stmt); - begin - if Frame = O_Enode_Null then - Put ("fp"); - else - Disp_Reg (Frame); - end if; - Put (","); - Put (Get_Local_Offset (Obj), 0); - Put (" {"); - Disp_Decl_Name (Obj); - Put ("}"); - end Disp_Local; - - procedure Disp_Uns32 (Val : Uns32) - is - use Ada.Text_IO; - U2c : constant array (Uns32 range 0 .. 15) of Character - := "0123456789abcdef"; - V : Uns32 := Val; - begin - for I in 0 .. 7 loop - Put (U2c (Shift_Right (V, 28))); - V := Shift_Left (V, 4); - end loop; - end Disp_Uns32; - - procedure Disp_Const (Stmt : O_Enode) - is - use Ada.Text_IO; - begin - Put ("["); - case Get_Expr_Mode (Stmt) is - when Mode_U64 - | Mode_I64 - | Mode_F64 => - Disp_Uns32 (Get_Expr_High (Stmt)); - Put (","); - when others => - null; - end case; - Disp_Uns32 (Get_Expr_Low (Stmt)); - Put ("]"); - end Disp_Const; - - procedure Disp_Irm_Code (Stmt : O_Enode) - is - use Ortho_Code.Debug.Int32_IO; - use Ada.Text_IO; - Reg : O_Reg; - Kind : OE_Kind; - begin - Reg := Get_Expr_Reg (Stmt); - Kind := Get_Expr_Kind (Stmt); - case Reg is - when R_Mem => - case Kind is - when OE_Indir => - Put ('('); - Disp_Irm_Code (Get_Expr_Operand (Stmt)); - Put (')'); --- when OE_Lit => --- Put ("(&n)"); - when others => - raise Program_Error; - end case; - when R_Imm => - case Kind is - when OE_Const => - Disp_Const (Stmt); - when OE_Addrg => - Put ("&"); - Disp_Decl_Name (Get_Addr_Object (Stmt)); - when OE_Add => - Disp_Irm_Code (Get_Expr_Left (Stmt)); - Put ("+"); - Disp_Irm_Code (Get_Expr_Right (Stmt)); - when others => - raise Program_Error; - end case; - when Regs_R32 - | R_Any32 - | R_Any8 - | Regs_R64 - | R_Any64 - | Regs_Cc - | Regs_Fp - | Regs_Xmm => - Disp_Reg (Stmt); - when R_Spill => - Disp_Reg (Stmt); - --Disp_Irm_Code (Get_Stmt_Link (Stmt)); - when R_B_Off - | R_I_Off - | R_B_I - | R_Sib => - case Kind is - when OE_Addrl => - Disp_Local (Stmt); - when OE_Add => - Disp_Irm_Code (Get_Expr_Left (Stmt)); - Put (" + "); - Disp_Irm_Code (Get_Expr_Right (Stmt)); - when others => - raise Program_Error; - end case; - when R_I => - Disp_Irm_Code (Get_Expr_Left (Stmt)); - Put (" * "); - case Get_Expr_Low (Get_Expr_Right (Stmt)) is - when 0 => - Put ('1'); - when 1 => - Put ('2'); - when 2 => - Put ('4'); - when 3 => - Put ('8'); - when others => - Put ('?'); - end case; - when others => - Ada.Text_IO.Put_Line - ("abi.disp_irm_code: unhandled reg=" & Image_Reg (Reg) - & ", stmt=" & O_Enode'Image (Stmt)); - raise Program_Error; - end case; - end Disp_Irm_Code; - - procedure Disp_Decls (Block : O_Dnode) - is - Decl : O_Dnode; - Last : O_Dnode; - begin - Last := Get_Block_Last (Block); - Disp_Decl (2, Block); - Decl := Block + 1; - while Decl <= Last loop - case Get_Decl_Kind (Decl) is - when OD_Local => - Disp_Decl (2, Decl); - when OD_Block => - -- Skip internal blocks. - Decl := Get_Block_Last (Decl); - when others => - Disp_Decl (2, Decl); - null; - end case; - Decl := Decl + 1; - end loop; - end Disp_Decls; - - procedure Disp_Stmt (Stmt : O_Enode) - is - use Ada.Text_IO; - use Debug.Int32_IO; - Kind : OE_Kind; - Mode : Mode_Type; - - procedure Disp_Op_Name (Name : String) is - begin - Put (Name); - Put (":"); - Debug.Disp_Mode (Mode); - Put (" "); - end Disp_Op_Name; - - procedure Disp_Reg_Op_Name (Name : String) is - begin - Put (" "); - Disp_Reg (Stmt); - Put (" = "); - Disp_Op_Name (Name); - end Disp_Reg_Op_Name; - - begin - Kind := Get_Expr_Kind (Stmt); - Mode := Get_Expr_Mode (Stmt); - - case Kind is - when OE_Beg => - Put (" # block start"); - if Get_Block_Has_Alloca (Stmt) then - Put (" [alloca]"); - end if; - New_Line; - Disp_Decls (Get_Block_Decls (Stmt)); - when OE_End => - Put_Line (" # block end"); - when OE_Indir => - Disp_Reg_Op_Name ("indir"); - Put ("("); - Disp_Irm_Code (Get_Expr_Operand (Stmt)); - Put_Line (")"); - when OE_Alloca => - Disp_Reg_Op_Name ("alloca"); - Put ("("); - Disp_Irm_Code (Get_Expr_Operand (Stmt)); - Put_Line (")"); - when OE_Kind_Cmp - | OE_Kind_Dyadic => - Disp_Reg_Op_Name ("op"); - Put ("{"); - Put (OE_Kind'Image (Kind)); - Put ("} "); - Disp_Irm_Code (Get_Expr_Left (Stmt)); - Put (", "); - Disp_Irm_Code (Get_Expr_Right (Stmt)); - New_Line; - when OE_Abs_Ov - | OE_Neg_Ov - | OE_Not => - Disp_Reg_Op_Name ("op"); - Put ("{"); - Put (OE_Kind'Image (Kind)); - Put ("} "); - Disp_Irm_Code (Get_Expr_Operand (Stmt)); - New_Line; - when OE_Const => - Disp_Reg_Op_Name ("const"); - Disp_Const (Stmt); - New_Line; - when OE_Jump_F => - Put (" jump_f "); - Disp_Reg (Get_Expr_Operand (Stmt)); - Put (" "); - Disp_Label (Get_Jump_Label (Stmt)); - New_Line; - when OE_Jump_T => - Put (" jump_t "); - Disp_Reg (Get_Expr_Operand (Stmt)); - Put (" "); - Disp_Label (Get_Jump_Label (Stmt)); - New_Line; - when OE_Jump => - Put (" jump "); - Disp_Label (Get_Jump_Label (Stmt)); - New_Line; - when OE_Label => - Disp_Label (Stmt); - Put_Line (":"); - when OE_Asgn => - Put (" assign:"); - Debug.Disp_Mode (Mode); - Put (" ("); - Disp_Irm_Code (Get_Assign_Target (Stmt)); - Put (") <- "); - Disp_Irm_Code (Get_Expr_Operand (Stmt)); - New_Line; - when OE_Set_Stack => - Put (" set_stack"); - Put (" <- "); - Disp_Irm_Code (Get_Expr_Operand (Stmt)); - New_Line; - when OE_Spill => - Disp_Reg_Op_Name ("spill"); - Disp_Reg (Get_Expr_Operand (Stmt)); - Put (", offset="); - Put (Int32'Image (Get_Spill_Info (Stmt))); - New_Line; - when OE_Reload => - Disp_Reg_Op_Name ("reload"); - Disp_Reg (Get_Expr_Operand (Stmt)); - New_Line; - when OE_Arg => - Put (" push "); - Disp_Irm_Code (Get_Expr_Operand (Stmt)); - New_Line; - when OE_Call => - if Get_Expr_Mode (Stmt) /= Mode_Nil then - Disp_Reg_Op_Name ("call"); - else - Put (" "); - Disp_Op_Name ("call"); - Put (" "); - end if; - Disp_Decl_Name (Get_Call_Subprg (Stmt)); - New_Line; - when OE_Stack_Adjust => - Put (" stack_adjust: "); - Put (Int32'Image (Get_Stack_Adjust (Stmt))); - New_Line; - when OE_Intrinsic => - Disp_Reg_Op_Name ("intrinsic"); - --Disp_Decl_Name (Get_Call_Subprg (Stmt)); - New_Line; - when OE_Conv => - Disp_Reg_Op_Name ("conv"); - Disp_Irm_Code (Get_Expr_Operand (Stmt)); - New_Line; - when OE_Move => - Disp_Reg_Op_Name ("move"); - Disp_Irm_Code (Get_Expr_Operand (Stmt)); - New_Line; - when OE_Ret => - Put (" ret"); - if Get_Expr_Mode (Stmt) /= Mode_Nil then - Put (" "); - Disp_Reg (Get_Expr_Operand (Stmt)); - end if; - New_Line; - when OE_Case => - Disp_Reg_Op_Name ("case"); - Disp_Irm_Code (Get_Expr_Operand (Stmt)); - New_Line; - when OE_Case_Expr => - Disp_Reg_Op_Name ("case_expr"); - Disp_Irm_Code (Get_Expr_Operand (Stmt)); - New_Line; - when OE_Leave => - Put_Line ("leave"); - when OE_Entry => - Put_Line ("entry"); - when OE_Line => - Put (" # line #"); - Put (Get_Expr_Line_Number (Stmt), 0); - New_Line; - when OE_Addrl => - Disp_Reg_Op_Name ("lea{addrl}"); - Put ("("); - Disp_Local (Stmt); - Put (")"); - New_Line; - when OE_Addrg => - Disp_Reg_Op_Name ("lea{addrg}"); - Put ("&"); - Disp_Decl_Name (Get_Addr_Object (Stmt)); - New_Line; - when OE_Add => - Disp_Reg_Op_Name ("lea{add}"); - Put ("("); - Disp_Irm_Code (Get_Expr_Left (Stmt)); - Put (" + "); - Disp_Irm_Code (Get_Expr_Right (Stmt)); - Put (")"); - New_Line; - when OE_Mul => - Disp_Reg_Op_Name ("mul"); - Disp_Irm_Code (Get_Expr_Left (Stmt)); - Put (", "); - Disp_Irm_Code (Get_Expr_Right (Stmt)); - New_Line; - when OE_Shl => - Disp_Reg_Op_Name ("shl"); - Disp_Irm_Code (Get_Expr_Left (Stmt)); - Put (", "); - Disp_Irm_Code (Get_Expr_Right (Stmt)); - New_Line; - when OE_Reg => - Disp_Reg_Op_Name ("reg"); - New_Line; - when others => - Ada.Text_IO.Put_Line - ("abi.disp_stmt: unhandled enode " & OE_Kind'Image (Kind)); - raise Program_Error; - end case; - end Disp_Stmt; - - procedure Disp_Subprg_Decl (Decl : O_Dnode) - is - use Ada.Text_IO; - Arg : O_Dnode; - begin - Put ("subprogram "); - Disp_Decl_Name (Decl); - Put_Line (":"); - Arg := Decl + 1; - while Get_Decl_Kind (Arg) = OD_Interface loop - Disp_Decl (2, Arg); - Arg := Arg + 1; - end loop; - end Disp_Subprg_Decl; - - procedure Disp_Subprg (Subprg : O_Dnode) - is - use Ada.Text_IO; - - Stmt : O_Enode; - begin - Disp_Subprg_Decl (Get_Body_Decl (Subprg)); - - Stmt := Get_Body_Stmt (Subprg); - loop - exit when Stmt = O_Enode_Null; - Disp_Stmt (Stmt); - exit when Get_Expr_Kind (Stmt) = OE_Leave; - Stmt := Get_Stmt_Link (Stmt); - end loop; - end Disp_Subprg; - - procedure New_Debug_Filename_Decl (Filename : String) - is - use Ortho_Code.Flags; - begin - if Flag_Debug = Debug_Dwarf then - Dwarf.Set_Filename ("", Filename); - end if; - end New_Debug_Filename_Decl; - - procedure Init - is - use Ortho_Code.Debug; - begin - -- Alignment of doubles is platform dependent. - Mode_Align (Mode_F64) := X86.Flags.Mode_F64_Align; - - if Flag_Debug_Hli then - Disps.Init; - else - Emits.Init; - end if; - end Init; - - procedure Finish - is - use Ortho_Code.Debug; - begin - if Flag_Debug_Hli then - Disps.Finish; - else - Emits.Finish; - end if; - end Finish; - --- function Image_Insn (Insn : O_Insn) return String is --- begin --- case Insn is --- when Insn_Nil => --- return "nil"; --- when Insn_Imm => --- return "imm"; --- when Insn_Base_Off => --- return "B+O"; --- when Insn_Loadm => --- return "ldm"; --- when Insn_Loadi => --- return "ldi"; --- when Insn_Mem => --- return "mem"; --- when Insn_Cmp => --- return "cmp"; --- when Insn_Op => --- return "op "; --- when Insn_Rop => --- return "rop"; --- when Insn_Call => --- return "cal"; --- when others => --- return "???"; --- end case; --- end Image_Insn; - - function Image_Reg (Reg : O_Reg) return String is - begin - case Reg is - when R_Nil => - return "nil "; - when R_None => - return " -- "; - when R_Spill => - return "spil"; - when R_Mem => - return "mem "; - when R_Imm => - return "imm "; - when R_Irm => - return "irm "; - when R_Rm => - return "rm "; - when R_Sib => - return "sib "; - when R_B_Off => - return "b+o "; - when R_B_I => - return "b+i "; - when R_I => - return "s*i "; - when R_Ir => - return " ir "; - when R_I_Off => - return "i+o "; - when R_Any32 => - return "r32 "; - when R_Any_Cc => - return "cc "; - when R_Any8 => - return "r8 "; - when R_Any64 => - return "r64 "; - - when R_St0 => - return "st0 "; - when R_Ax => - return "ax "; - when R_Dx => - return "dx "; - when R_Cx => - return "cx "; - when R_Bx => - return "bx "; - when R_Si => - return "si "; - when R_Di => - return "di "; - when R_Sp => - return "sp "; - when R_Bp => - return "bp "; - when R_Edx_Eax => - return "dxax"; - when R_Ebx_Ecx => - return "bxcx"; - when R_Esi_Edi => - return "sidi"; - when R_Eq => - return "eq? "; - when R_Ne => - return "ne? "; - when R_Uge => - return "uge?"; - when R_Sge => - return "sge?"; - when R_Ugt => - return "ugt?"; - when R_Sgt => - return "sgt?"; - when R_Ule => - return "ule?"; - when R_Sle => - return "sle?"; - when R_Ult => - return "ult?"; - when R_Slt => - return "slt?"; - when R_Xmm0 => - return "xmm0"; - when R_Xmm1 => - return "xmm1"; - when R_Xmm2 => - return "xmm2"; - when R_Xmm3 => - return "xmm3"; - when others => - return "????"; - end case; - end Image_Reg; - - -- From GCC. - -- FIXME: these don't handle overflow! - function Divdi3 (A, B : Long_Integer) return Long_Integer; - pragma Import (C, Divdi3, "__divdi3"); - - function Muldi3 (A, B : Long_Integer) return Long_Integer; - pragma Import (C, Muldi3, "__muldi3"); - - procedure Chkstk (Sz : Integer); - pragma Import (C, Chkstk, "__chkstk"); - - procedure Link_Intrinsics - is - begin - Binary_File.Memory.Set_Symbol_Address - (Ortho_Code.X86.Emits.Intrinsics_Symbol - (Ortho_Code.X86.Intrinsic_Mul_Ov_I64), - Muldi3'Address); - Binary_File.Memory.Set_Symbol_Address - (Ortho_Code.X86.Emits.Intrinsics_Symbol - (Ortho_Code.X86.Intrinsic_Div_Ov_I64), - Divdi3'Address); - if X86.Flags.Flag_Alloca_Call then - Binary_File.Memory.Set_Symbol_Address - (Ortho_Code.X86.Emits.Chkstk_Symbol, Chkstk'Address); - end if; - end Link_Intrinsics; -end Ortho_Code.X86.Abi; |