diff options
Diffstat (limited to 'ortho/mcode/ortho_code-x86-emits.adb')
| -rw-r--r-- | ortho/mcode/ortho_code-x86-emits.adb | 2322 |
1 files changed, 0 insertions, 2322 deletions
diff --git a/ortho/mcode/ortho_code-x86-emits.adb b/ortho/mcode/ortho_code-x86-emits.adb deleted file mode 100644 index ad1ef559b..000000000 --- a/ortho/mcode/ortho_code-x86-emits.adb +++ /dev/null @@ -1,2322 +0,0 @@ --- Mcode back-end for ortho - Binary X86 instructions generator. --- 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.Abi; -with Ortho_Code.Decls; -with Ortho_Code.Types; -with Ortho_Code.Consts; -with Ortho_Code.Debug; -with Ortho_Code.X86.Insns; -with Ortho_Code.X86.Flags; -with Ortho_Code.Flags; -with Ortho_Code.Dwarf; -with Ortho_Code.Binary; use Ortho_Code.Binary; -with Ortho_Ident; -with Ada.Text_IO; -with Interfaces; use Interfaces; - -package body Ortho_Code.X86.Emits is - type Insn_Size is (Sz_8, Sz_16, Sz_32l, Sz_32h); - - type Fp_Size is (Fp_32, Fp_64); - - Sect_Text : Binary_File.Section_Acc; - Sect_Rodata : Binary_File.Section_Acc; - Sect_Bss : Binary_File.Section_Acc; - - Reg_Helper : O_Reg; - - Subprg_Pc : Pc_Type; - - procedure Error_Emit (Msg : String; Insn : O_Enode) - is - use Ada.Text_IO; - begin - Put ("error_emit: "); - Put (Msg); - Put (", insn="); - Put (O_Enode'Image (Insn)); - Put (" ("); - Put (OE_Kind'Image (Get_Expr_Kind (Insn))); - Put (")"); - New_Line; - raise Program_Error; - end Error_Emit; - - - procedure Gen_Insn_Sz (B : Byte; Sz : Insn_Size) is - begin - case Sz is - when Sz_8 => - Gen_B8 (B); - when Sz_16 => - Gen_B8 (16#66#); - Gen_B8 (B + 1); - when Sz_32l - | Sz_32h => - Gen_B8 (B + 1); - end case; - end Gen_Insn_Sz; - - procedure Gen_Insn_Sz_S8 (B : Byte; Sz : Insn_Size) is - begin - case Sz is - when Sz_8 => - Gen_B8 (B); - when Sz_16 => - Gen_B8 (16#66#); - Gen_B8 (B + 3); - when Sz_32l - | Sz_32h => - Gen_B8 (B + 3); - end case; - end Gen_Insn_Sz_S8; - - function Get_Const_Val (C : O_Enode; Sz : Insn_Size) return Uns32 is - begin - case Sz is - when Sz_8 - | Sz_16 - | Sz_32l => - return Get_Expr_Low (C); - when Sz_32h => - return Get_Expr_High (C); - end case; - end Get_Const_Val; - - function Is_Imm8 (N : O_Enode; Sz : Insn_Size) return Boolean is - begin - if Get_Expr_Kind (N) /= OE_Const then - return False; - end if; - return Get_Const_Val (N, Sz) <= 127; - end Is_Imm8; - - procedure Gen_Imm8 (N : O_Enode; Sz : Insn_Size) is - begin - Gen_B8 (Byte (Get_Const_Val (N, Sz))); - end Gen_Imm8; - --- procedure Gen_Imm32 (N : O_Enode; Sz : Insn_Size) --- is --- use Interfaces; --- begin --- case Get_Expr_Kind (N) is --- when OE_Const => --- Gen_Le32 (Unsigned_32 (Get_Const_Val (N, Sz))); --- when OE_Addrg => --- Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (N)), 0); --- when others => --- raise Program_Error; --- end case; --- end Gen_Imm32; - - procedure Gen_Imm (N : O_Enode; Sz : Insn_Size) is - begin - case Get_Expr_Kind (N) is - when OE_Const => - case Sz is - when Sz_8 => - Gen_B8 (Byte (Get_Expr_Low (N) and 16#FF#)); - when Sz_16 => - Gen_Le16 (Unsigned_32 (Get_Expr_Low (N) and 16#FF_FF#)); - when Sz_32l => - Gen_Le32 (Unsigned_32 (Get_Expr_Low (N))); - when Sz_32h => - Gen_Le32 (Unsigned_32 (Get_Expr_High (N))); - end case; - when OE_Addrg => - if Sz /= Sz_32l then - raise Program_Error; - end if; - Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (N)), 0); - when OE_Add => - declare - P : O_Enode; - L, R : O_Enode; - S, C : O_Enode; - Off : Int32; - begin - Off := 0; - P := N; - if Sz /= Sz_32l then - raise Program_Error; - end if; - loop - L := Get_Expr_Left (P); - R := Get_Expr_Right (P); - - -- Extract the const node. - if Get_Expr_Kind (R) = OE_Const then - S := L; - C := R; - elsif Get_Expr_Kind (L) = OE_Const then - S := R; - C := L; - else - raise Program_Error; - end if; - if Get_Expr_Mode (C) /= Mode_U32 then - raise Program_Error; - end if; - Off := Off + To_Int32 (Get_Expr_Low (C)); - - exit when Get_Expr_Kind (S) = OE_Addrg; - P := S; - if Get_Expr_Kind (P) /= OE_Add then - raise Program_Error; - end if; - end loop; - Gen_X86_32 (Get_Decl_Symbol (Get_Addr_Object (S)), - Integer_32 (Off)); - end; - when others => - raise Program_Error; - end case; - end Gen_Imm; - - Rm_Base : O_Reg; - Rm_Index : O_Reg; - Rm_Offset : Int32; - Rm_Sym : Symbol; - Rm_Scale : Byte; - - procedure Fill_Sib (N : O_Enode) - is - use Ortho_Code.Decls; - Reg : O_Reg; - begin - Reg := Get_Expr_Reg (N); - if Reg in Regs_R32 then - if Rm_Base = R_Nil then - Rm_Base := Reg; - elsif Rm_Index = R_Nil then - Rm_Index := Reg; - else - raise Program_Error; - end if; - return; - end if; - case Get_Expr_Kind (N) is - when OE_Indir => - Fill_Sib (Get_Expr_Operand (N)); - when OE_Addrl => - declare - Frame : O_Enode; - begin - Frame := Get_Addrl_Frame (N); - if Frame = O_Enode_Null then - Rm_Base := R_Bp; - else - Rm_Base := Get_Expr_Reg (Frame); - end if; - end; - Rm_Offset := Rm_Offset + Get_Local_Offset (Get_Addr_Object (N)); - when OE_Addrg => - if Rm_Sym /= Null_Symbol then - raise Program_Error; - end if; - Rm_Sym := Get_Decl_Symbol (Get_Addr_Object (N)); - when OE_Add => - Fill_Sib (Get_Expr_Left (N)); - Fill_Sib (Get_Expr_Right (N)); - when OE_Const => - Rm_Offset := Rm_Offset + To_Int32 (Get_Expr_Low (N)); - when OE_Shl => - if Rm_Index /= R_Nil then - raise Program_Error; - end if; - Rm_Index := Get_Expr_Reg (Get_Expr_Left (N)); - Rm_Scale := Byte (Get_Expr_Low (Get_Expr_Right (N))); - when others => - Error_Emit ("fill_sib", N); - end case; - end Fill_Sib; - - function To_Reg32 (R : O_Reg) return Byte is - begin - return O_Reg'Pos (R) - O_Reg'Pos (R_Ax); - end To_Reg32; - pragma Inline (To_Reg32); - - function To_Reg_Xmm (R : O_Reg) return Byte is - begin - return O_Reg'Pos (R) - O_Reg'Pos (R_Xmm0); - end To_Reg_Xmm; - pragma Inline (To_Reg_Xmm); - - function To_Reg32 (R : O_Reg; Sz : Insn_Size) return Byte is - begin - case Sz is - when Sz_8 => - if R in Regs_R8 then - return O_Reg'Pos (R) - O_Reg'Pos (R_Ax); - else - raise Program_Error; - end if; - when Sz_16 => - if R in Regs_R32 then - return O_Reg'Pos (R) - O_Reg'Pos (R_Ax); - else - raise Program_Error; - end if; - when Sz_32l => - case R is - when Regs_R32 => - return O_Reg'Pos (R) - O_Reg'Pos (R_Ax); - when R_Edx_Eax => - return 2#000#; - when R_Ebx_Ecx => - return 2#001#; - when R_Esi_Edi => - return 2#111#; - when others => - raise Program_Error; - end case; - when Sz_32h => - case R is - when R_Edx_Eax => - return 2#010#; - when R_Ebx_Ecx => - return 2#011#; - when R_Esi_Edi => - return 2#110#; - when others => - raise Program_Error; - end case; - end case; - end To_Reg32; - - function To_Cond (R : O_Reg) return Byte is - begin - return O_Reg'Pos (R) - O_Reg'Pos (R_Ov); - end To_Cond; - pragma Inline (To_Cond); - - procedure Gen_Sib is - begin - if Rm_Base = R_Nil then - Gen_B8 (Rm_Scale * 2#1_000_000# - + To_Reg32 (Rm_Index) * 2#1_000# - + 2#101#); - else - Gen_B8 (Rm_Scale * 2#1_000_000# - + To_Reg32 (Rm_Index) * 2#1_000# - + To_Reg32 (Rm_Base)); - end if; - end Gen_Sib; - - -- Generate an R/M (+ SIB) byte. - -- R is added to the R/M byte. - procedure Gen_Rm_Mem (R : Byte; N : O_Enode; Sz : Insn_Size) - is - Reg : O_Reg; - begin - Reg := Get_Expr_Reg (N); - Rm_Base := R_Nil; - Rm_Index := R_Nil; - if Sz = Sz_32h then - Rm_Offset := 4; - else - Rm_Offset := 0; - end if; - Rm_Scale := 0; - Rm_Sym := Null_Symbol; - case Reg is - when R_Mem - | R_Imm - | R_Eq - | R_B_Off - | R_B_I - | R_I_Off - | R_Sib => - Fill_Sib (N); - when Regs_R32 => - Rm_Base := Reg; - when R_Spill => - Rm_Base := R_Bp; - Rm_Offset := Rm_Offset + Get_Spill_Info (N); - when others => - Error_Emit ("gen_rm_mem: unhandled reg", N); - end case; - if Rm_Index /= R_Nil then - -- SIB. - if Rm_Base = R_Nil then - Gen_B8 (2#00_000_100# + R); - Rm_Base := R_Bp; - Gen_Sib; - Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset)); - elsif Rm_Sym = Null_Symbol and Rm_Offset = 0 and Rm_Base /= R_Bp then - Gen_B8 (2#00_000_100# + R); - Gen_Sib; - elsif Rm_Sym = Null_Symbol and Rm_Offset <= 127 and Rm_Offset >= -128 - then - Gen_B8 (2#01_000_100# + R); - Gen_Sib; - Gen_B8 (Byte (To_Uns32 (Rm_Offset) and 16#Ff#)); - else - Gen_B8 (2#10_000_100# + R); - Gen_Sib; - Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset)); - end if; - return; - end if; - case Rm_Base is - when R_Sp => - raise Program_Error; - when R_Nil => - Gen_B8 (2#00_000_101# + R); - Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset)); - when R_Ax - | R_Bx - | R_Cx - | R_Dx - | R_Bp - | R_Si - | R_Di => - if Rm_Offset = 0 and Rm_Sym = Null_Symbol and Rm_Base /= R_Bp then - Gen_B8 (2#00_000_000# + R + To_Reg32 (Rm_Base)); - elsif Rm_Sym = Null_Symbol - and Rm_Offset <= 127 and Rm_Offset >= -128 - then - Gen_B8 (2#01_000_000# + R + To_Reg32 (Rm_Base)); - Gen_B8 (Byte (To_Uns32 (Rm_Offset) and 16#Ff#)); - else - Gen_B8 (2#10_000_000# + R + To_Reg32 (Rm_Base)); - Gen_X86_32 (Rm_Sym, Integer_32 (Rm_Offset)); - end if; - when others => - raise Program_Error; - end case; - end Gen_Rm_Mem; - - procedure Gen_Rm (R : Byte; N : O_Enode; Sz : Insn_Size) - is - Reg : O_Reg; - begin - Reg := Get_Expr_Reg (N); - if Reg in Regs_R32 or Reg in Regs_R64 then - Gen_B8 (2#11_000_000# + R + To_Reg32 (Reg, Sz)); - return; - else - Gen_Rm_Mem (R, N, Sz); - end if; - end Gen_Rm; - - procedure Emit_Op (Op : Byte; Stmt : O_Enode; Sz : Insn_Size) - is - L, R : O_Enode; - Lr, Rr : O_Reg; - begin - L := Get_Expr_Left (Stmt); - R := Get_Expr_Right (Stmt); - Lr := Get_Expr_Reg (L); - Rr := Get_Expr_Reg (R); - Start_Insn; - case Rr is - when R_Imm => - if Is_Imm8 (R, Sz) then - Gen_Insn_Sz_S8 (16#80#, Sz); - Gen_Rm (Op, L, Sz); - Gen_Imm8 (R, Sz); - elsif Lr = R_Ax then - Gen_Insn_Sz (2#000_000_100# + Op, Sz); - Gen_Imm (R, Sz); - else - Gen_Insn_Sz (16#80#, Sz); - Gen_Rm (Op, L, Sz); - Gen_Imm (R, Sz); - end if; - when R_Mem - | R_Spill - | Regs_R32 - | Regs_R64 => - Gen_Insn_Sz (2#00_000_010# + Op, Sz); - Gen_Rm (To_Reg32 (Lr, Sz) * 8, R, Sz); - when others => - Error_Emit ("emit_op", Stmt); - end case; - End_Insn; - end Emit_Op; - - procedure Gen_Into is - begin - Start_Insn; - Gen_B8 (2#1100_1110#); - End_Insn; - end Gen_Into; - - procedure Gen_Cdq is - begin - Start_Insn; - Gen_B8 (2#1001_1001#); - End_Insn; - end Gen_Cdq; - - procedure Gen_Mono_Op (Op : Byte; Val : O_Enode; Sz : Insn_Size) is - begin - Start_Insn; - Gen_Insn_Sz (2#1111_011_0#, Sz); - Gen_Rm (Op, Val, Sz); - End_Insn; - end Gen_Mono_Op; - - procedure Emit_Mono_Op_Stmt (Op : Byte; Stmt : O_Enode; Sz : Insn_Size) - is - begin - Gen_Mono_Op (Op, Get_Expr_Operand (Stmt), Sz); - end Emit_Mono_Op_Stmt; - - procedure Emit_Load_Imm (Stmt : O_Enode; Sz : Insn_Size) - is - Tr : O_Reg; - begin - Tr := Get_Expr_Reg (Stmt); - Start_Insn; - -- FIXME: handle 0. - case Sz is - when Sz_8 => - Gen_B8 (2#1011_0_000# + To_Reg32 (Tr, Sz)); - when Sz_16 => - Gen_B8 (16#66#); - Gen_B8 (2#1011_1_000# + To_Reg32 (Tr, Sz)); - when Sz_32l - | Sz_32h => - Gen_B8 (2#1011_1_000# + To_Reg32 (Tr, Sz)); - end case; - Gen_Imm (Stmt, Sz); - End_Insn; - end Emit_Load_Imm; - - function Fp_Size_To_Mf (Sz : Fp_Size) return Byte is - begin - case Sz is - when Fp_32 => - return 2#00_0#; - when Fp_64 => - return 2#10_0#; - end case; - end Fp_Size_To_Mf; - - procedure Emit_Load_Fp (Stmt : O_Enode; Sz : Fp_Size) - is - Sym : Symbol; - R : O_Reg; - begin - Set_Current_Section (Sect_Rodata); - Gen_Pow_Align (3); - Prealloc (8); - Sym := Create_Local_Symbol; - Set_Symbol_Pc (Sym, False); - Gen_Le32 (Unsigned_32 (Get_Expr_Low (Stmt))); - if Sz = Fp_64 then - Gen_Le32 (Unsigned_32 (Get_Expr_High (Stmt))); - end if; - Set_Current_Section (Sect_Text); - - R := Get_Expr_Reg (Stmt); - case R is - when R_St0 => - Start_Insn; - Gen_B8 (2#11011_001# + Fp_Size_To_Mf (Sz)); - Gen_B8 (2#00_000_101#); - Gen_X86_32 (Sym, 0); - End_Insn; - when Regs_Xmm => - Start_Insn; - case Sz is - when Fp_32 => - Gen_B8 (16#F3#); - when Fp_64 => - Gen_B8 (16#F2#); - end case; - Gen_B8 (16#0f#); - Gen_B8 (16#10#); - Gen_B8 (2#00_000_101# + To_Reg_Xmm (R) * 2#1_000#); - Gen_X86_32 (Sym, 0); - End_Insn; - when others => - raise Program_Error; - end case; - end Emit_Load_Fp; - - procedure Emit_Load_Fp_Mem (Stmt : O_Enode; Sz : Fp_Size) - is - begin - Start_Insn; - Gen_B8 (2#11011_001# + Fp_Size_To_Mf (Sz)); - Gen_Rm_Mem (2#000_000#, Get_Expr_Operand (Stmt), Sz_32l); - End_Insn; - end Emit_Load_Fp_Mem; - - procedure Emit_Load_Mem (Stmt : O_Enode; Sz : Insn_Size) - is - Tr : O_Reg; - Val : O_Enode; - begin - Tr := Get_Expr_Reg (Stmt); - Val := Get_Expr_Operand (Stmt); - case Tr is - when Regs_R32 - | Regs_R64 => - -- mov REG, OP - Start_Insn; - Gen_Insn_Sz (2#1000_101_0#, Sz); - Gen_Rm_Mem (To_Reg32 (Tr, Sz) * 8, Val, Sz); - End_Insn; - when R_Eq => - -- Cmp OP, 1 - Start_Insn; - Gen_Insn_Sz_S8 (2#1000_000_0#, Sz); - Gen_Rm_Mem (2#111_000#, Val, Sz); - Gen_B8 (1); - End_Insn; - when others => - Error_Emit ("emit_load_mem", Stmt); - end case; - end Emit_Load_Mem; - - - procedure Emit_Store (Stmt : O_Enode; Sz : Insn_Size) - is - T, R : O_Enode; - Tr, Rr : O_Reg; - B : Byte; - begin - T := Get_Assign_Target (Stmt); - R := Get_Expr_Operand (Stmt); - Tr := Get_Expr_Reg (T); - Rr := Get_Expr_Reg (R); - Start_Insn; - case Rr is - when R_Imm => - if False and (Tr in Regs_R32 or Tr in Regs_R64) then - B := 2#1011_1_000#; - case Sz is - when Sz_8 => - B := B and not 2#0000_1_000#; - when Sz_16 => - Gen_B8 (16#66#); - when Sz_32l - | Sz_32h => - null; - end case; - Gen_B8 (B + To_Reg32 (Tr, Sz)); - else - Gen_Insn_Sz (2#1100_011_0#, Sz); - Gen_Rm_Mem (16#00#, T, Sz); - end if; - Gen_Imm (R, Sz); - when Regs_R32 - | Regs_R64 => - Gen_Insn_Sz (2#1000_100_0#, Sz); - Gen_Rm_Mem (To_Reg32 (Rr, Sz) * 8, T, Sz); - when others => - Error_Emit ("emit_store", Stmt); - end case; - End_Insn; - end Emit_Store; - - procedure Emit_Store_Fp (Stmt : O_Enode; Sz : Fp_Size) - is - begin - -- fstp - Start_Insn; - Gen_B8 (2#11011_00_1# + Fp_Size_To_Mf (Sz)); - Gen_Rm_Mem (2#011_000#, Get_Assign_Target (Stmt), Sz_32l); - End_Insn; - end Emit_Store_Fp; - - procedure Emit_Push_32 (Val : O_Enode; Sz : Insn_Size) - is - R : O_Reg; - begin - R := Get_Expr_Reg (Val); - Start_Insn; - case R is - when R_Imm => - if Is_Imm8 (Val, Sz) then - Gen_B8 (2#0110_1010#); - Gen_Imm8 (Val, Sz); - else - Gen_B8 (2#0110_1000#); - Gen_Imm (Val, Sz); - end if; - when Regs_R32 - | Regs_R64 => - Gen_B8 (2#01010_000# + To_Reg32 (R, Sz)); - when others => - Gen_B8 (2#1111_1111#); - Gen_Rm (2#110_000#, Val, Sz); - end case; - End_Insn; - end Emit_Push_32; - - procedure Emit_Pop_32 (Val : O_Enode; Sz : Insn_Size) - is - R : O_Reg; - begin - R := Get_Expr_Reg (Val); - Start_Insn; - case R is - when Regs_R32 - | Regs_R64 => - Gen_B8 (2#01011_000# + To_Reg32 (R, Sz)); - when others => - Gen_B8 (2#1000_1111#); - Gen_Rm (2#000_000#, Val, Sz); - end case; - End_Insn; - end Emit_Pop_32; - - procedure Emit_Push_Fp (Op : O_Enode; Sz : Fp_Size) - is - pragma Unreferenced (Op); - begin - Start_Insn; - -- subl esp, val - Gen_B8 (2#100000_11#); - Gen_B8 (2#11_101_100#); - case Sz is - when Fp_32 => - Gen_B8 (4); - when Fp_64 => - Gen_B8 (8); - end case; - End_Insn; - -- fstp st, (esp) - Start_Insn; - Gen_B8 (2#11011_001# + Fp_Size_To_Mf (Sz)); - Gen_B8 (2#00_011_100#); - Gen_B8 (2#00_100_100#); - End_Insn; - end Emit_Push_Fp; - - function Prepare_Label (Label : O_Enode) return Symbol - is - Sym : Symbol; - begin - Sym := Get_Label_Symbol (Label); - if Sym = Null_Symbol then - Sym := Create_Local_Symbol; - Set_Label_Symbol (Label, Sym); - end if; - return Sym; - end Prepare_Label; - - procedure Emit_Jmp_T (Stmt : O_Enode; Reg : O_Reg) - is - Sym : Symbol; - Val : Pc_Type; - Opc : Byte; - begin - Sym := Prepare_Label (Get_Jump_Label (Stmt)); - Val := Get_Symbol_Value (Sym); - Start_Insn; - Opc := To_Cond (Reg); - if Val = 0 then - -- Assume long jmp. - Gen_B8 (16#0f#); - Gen_B8 (16#80# + Opc); - Gen_X86_Pc32 (Sym); - else - if Val + 128 < Get_Current_Pc + 4 then - -- Long jmp. - Gen_B8 (16#0f#); - Gen_B8 (16#80# + Opc); - Gen_Le32 (Unsigned_32 (Val - (Get_Current_Pc + 4))); - else - -- short jmp. - Gen_B8 (16#70# + Opc); - Gen_B8 (Byte (Val - (Get_Current_Pc + 1))); - end if; - end if; - End_Insn; - end Emit_Jmp_T; - - procedure Emit_Jmp (Stmt : O_Enode) - is - Sym : Symbol; - Val : Pc_Type; - begin - Sym := Prepare_Label (Get_Jump_Label (Stmt)); - Val := Get_Symbol_Value (Sym); - Start_Insn; - if Val = 0 then - -- Assume long jmp. - Gen_B8 (16#e9#); - Gen_X86_Pc32 (Sym); - else - if Val + 128 < Get_Current_Pc + 4 then - -- Long jmp. - Gen_B8 (16#e9#); - Gen_Le32 (Unsigned_32 (Val - (Get_Current_Pc + 4))); - else - -- short jmp. - Gen_B8 (16#eb#); - Gen_B8 (Byte ((Val - (Get_Current_Pc + 1)) and 16#Ff#)); - end if; - end if; - End_Insn; - end Emit_Jmp; - - procedure Emit_Label (Stmt : O_Enode) - is - Sym : Symbol; - begin - Sym := Prepare_Label (Stmt); - Set_Symbol_Pc (Sym, False); - end Emit_Label; - - procedure Gen_Call (Sym : Symbol) is - begin - Start_Insn; - Gen_B8 (16#E8#); - Gen_X86_Pc32 (Sym); - End_Insn; - end Gen_Call; - - procedure Emit_Setup_Frame (Stmt : O_Enode) - is - Val : constant Int32 := Get_Stack_Adjust (Stmt); - begin - if Val > 0 then - Start_Insn; - -- subl esp, val - Gen_B8 (2#100000_11#); - Gen_B8 (2#11_101_100#); - Gen_B8 (Byte (Val)); - End_Insn; - elsif Val < 0 then - Start_Insn; - if -Val <= 127 then - -- addl esp, val - Gen_B8 (2#100000_11#); - Gen_B8 (2#11_000_100#); - Gen_B8 (Byte (-Val)); - else - -- addl esp, val - Gen_B8 (2#100000_01#); - Gen_B8 (2#11_000_100#); - Gen_Le32 (Unsigned_32 (-Val)); - end if; - End_Insn; - end if; - end Emit_Setup_Frame; - - procedure Emit_Call (Stmt : O_Enode) - is - use Ortho_Code.Decls; - Subprg : O_Dnode; - Sym : Symbol; - begin - Subprg := Get_Call_Subprg (Stmt); - Sym := Get_Decl_Symbol (Subprg); - Gen_Call (Sym); - end Emit_Call; - - procedure Emit_Intrinsic (Stmt : O_Enode) - is - Op : Int32; - begin - Op := Get_Intrinsic_Operation (Stmt); - Start_Insn; - Gen_B8 (16#E8#); - Gen_X86_Pc32 (Intrinsics_Symbol (Op)); - End_Insn; - - Start_Insn; - -- addl esp, val - Gen_B8 (2#100000_11#); - Gen_B8 (2#11_000_100#); - Gen_B8 (16); - End_Insn; - end Emit_Intrinsic; - - procedure Emit_Setcc (Dest : O_Enode; Cond : O_Reg) - is - begin - if Cond not in Regs_Cc then - raise Program_Error; - end if; - Start_Insn; - Gen_B8 (16#0f#); - Gen_B8 (16#90# + To_Cond (Cond)); - Gen_Rm (2#000_000#, Dest, Sz_8); - End_Insn; - end Emit_Setcc; - - procedure Emit_Setcc_Reg (Reg : O_Reg; Cond : O_Reg) - is - begin - if Cond not in Regs_Cc then - raise Program_Error; - end if; - Start_Insn; - Gen_B8 (16#0f#); - Gen_B8 (16#90# + To_Cond (Cond)); - Gen_B8 (2#11_000_000# + To_Reg32 (Reg, Sz_8)); - End_Insn; - end Emit_Setcc_Reg; - - procedure Emit_Tst (Reg : O_Reg; Sz : Insn_Size) - is - begin - Start_Insn; - Gen_Insn_Sz (2#1000_0100#, Sz); - Gen_B8 (2#11_000_000# + To_Reg32 (Reg, Sz) * 9); - End_Insn; - end Emit_Tst; - - procedure Gen_Cmp_Imm (Reg : O_Reg; Val : Int32; Sz : Insn_Size) - is - B : Byte; - begin - Start_Insn; - if Val <= 127 and Val >= -128 then - B := 2#10#; - else - B := 0; - end if; - Gen_Insn_Sz (2#1000_0000# + B, Sz); - Gen_B8 (2#11_111_000# + To_Reg32 (Reg)); - if B = 0 then - Gen_Le32 (Unsigned_32 (To_Uns32 (Val))); - else - Gen_B8 (Byte (To_Uns32 (Val) and 16#Ff#)); - end if; - End_Insn; - end Gen_Cmp_Imm; - - procedure Emit_Spill (Stmt : O_Enode; Sz : Insn_Size) - is - Reg : O_Reg; - Expr : O_Enode; - begin - Expr := Get_Expr_Operand (Stmt); - Reg := Get_Expr_Reg (Expr); - if Reg = R_Spill then - if Get_Expr_Kind (Expr) = OE_Conv then - return; - else - raise Program_Error; - end if; - end if; - Start_Insn; - Gen_Insn_Sz (2#1000_1000#, Sz); - Gen_Rm (To_Reg32 (Reg, Sz) * 8, Stmt, Sz); - End_Insn; - end Emit_Spill; - - procedure Emit_Load (Reg : O_Reg; Val : O_Enode; Sz : Insn_Size) - is - begin - Start_Insn; - Gen_Insn_Sz (2#1000_1010#, Sz); - Gen_Rm (To_Reg32 (Reg, Sz) * 8, Val, Sz); - End_Insn; - end Emit_Load; - - procedure Emit_Lea (Stmt : O_Enode) - is - Reg : O_Reg; - begin - -- Hack: change the register to use the real address instead of it. - Reg := Get_Expr_Reg (Stmt); - Set_Expr_Reg (Stmt, R_Mem); - - Start_Insn; - Gen_B8 (2#10001101#); - Gen_Rm_Mem (To_Reg32 (Reg) * 8, Stmt, Sz_32l); - End_Insn; - Set_Expr_Reg (Stmt, Reg); - end Emit_Lea; - - procedure Gen_Umul (Stmt : O_Enode; Sz : Insn_Size) - is - begin - if Get_Expr_Reg (Get_Expr_Left (Stmt)) /= R_Ax then - raise Program_Error; - end if; - Start_Insn; - Gen_Insn_Sz (16#F6#, Sz); - Gen_Rm (2#100_000#, Get_Expr_Right (Stmt), Sz); - End_Insn; - end Gen_Umul; - - procedure Gen_Mul (Stmt : O_Enode; Sz : Insn_Size) - is - Reg : O_Reg; - Right : O_Enode; - Reg_R : O_Reg; - begin - Reg := Get_Expr_Reg (Stmt); - Right := Get_Expr_Right (Stmt); - if Get_Expr_Reg (Get_Expr_Left (Stmt)) /= Reg - or Sz /= Sz_32l - then - raise Program_Error; - end if; - Start_Insn; - if Reg = R_Ax then - Gen_Insn_Sz (16#F6#, Sz); - Gen_Rm (2#100_000#, Right, Sz); - else - Reg_R := Get_Expr_Reg (Right); - case Reg_R is - when R_Imm => - if Is_Imm8 (Right, Sz) then - Gen_B8 (16#6B#); - Gen_B8 (To_Reg32 (Reg, Sz) * 9 or 2#11_000_000#); - Gen_Imm8 (Right, Sz); - else - Gen_B8 (16#69#); - Gen_B8 (To_Reg32 (Reg, Sz) * 9 or 2#11_000_000#); - Gen_Imm (Right, Sz); - end if; - when R_Mem - | R_Spill - | Regs_R32 => - Gen_B8 (16#0F#); - Gen_B8 (16#AF#); - Gen_Rm (To_Reg32 (Reg, Sz) * 8, Right, Sz); - when others => - Error_Emit ("gen_mul", Stmt); - end case; - end if; - End_Insn; - end Gen_Mul; - - -- Do not trap if COND is true. - procedure Gen_Ov_Check (Cond : O_Reg) is - begin - -- JXX +2 - Start_Insn; - Gen_B8 (16#70# + To_Cond (Cond)); - Gen_B8 (16#02#); - End_Insn; - -- INT 4 (overflow). - Start_Insn; - Gen_B8 (16#CD#); - Gen_B8 (16#04#); - End_Insn; - end Gen_Ov_Check; - - procedure Emit_Abs (Val : O_Enode; Mode : Mode_Type) - is - Szh : Insn_Size; - Pc_Jmp : Pc_Type; - begin - case Mode is - when Mode_I32 => - Szh := Sz_32l; - when Mode_I64 => - Szh := Sz_32h; - when others => - raise Program_Error; - end case; - Emit_Tst (Get_Expr_Reg (Val), Szh); - -- JXX + - Start_Insn; - Gen_B8 (16#70# + To_Cond (R_Sge)); - Gen_B8 (0); - End_Insn; - Pc_Jmp := Get_Current_Pc; - -- NEG - Gen_Mono_Op (2#011_000#, Val, Sz_32l); - if Mode = Mode_I64 then - -- Propagate carray. - -- Adc reg,0 - -- neg reg - Start_Insn; - Gen_B8 (2#100000_11#); - Gen_Rm (2#010_000#, Val, Sz_32h); - Gen_B8 (0); - End_Insn; - Gen_Mono_Op (2#011_000#, Val, Sz_32h); - end if; - Gen_Into; - Patch_B8 (Pc_Jmp - 1, Unsigned_8 (Get_Current_Pc - Pc_Jmp)); - end Emit_Abs; - - procedure Gen_Alloca (Stmt : O_Enode) - is - Reg : O_Reg; - begin - Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt)); - if Reg not in Regs_R32 or else Reg /= Get_Expr_Reg (Stmt) then - raise Program_Error; - end if; - -- Align stack on word. - -- Add reg, (stack_boundary - 1) - Start_Insn; - Gen_B8 (2#1000_0011#); - Gen_B8 (2#11_000_000# + To_Reg32 (Reg)); - Gen_B8 (Byte (X86.Flags.Stack_Boundary - 1)); - End_Insn; - -- and reg, ~(stack_boundary - 1) - Start_Insn; - Gen_B8 (2#1000_0001#); - Gen_B8 (2#11_100_000# + To_Reg32 (Reg)); - Gen_Le32 (not (X86.Flags.Stack_Boundary - 1)); - End_Insn; - if X86.Flags.Flag_Alloca_Call then - Gen_Call (Chkstk_Symbol); - else - -- subl esp, reg - Start_Insn; - Gen_B8 (2#0001_1011#); - Gen_B8 (2#11_100_000# + To_Reg32 (Reg)); - End_Insn; - end if; - -- movl reg, esp - Start_Insn; - Gen_B8 (2#1000_1001#); - Gen_B8 (2#11_100_000# + To_Reg32 (Reg)); - End_Insn; - end Gen_Alloca; - - -- Byte/word to long. - procedure Gen_Movzx (Reg : Regs_R32; Op : O_Enode; Sz : Insn_Size) - is - B : Byte; - begin - Start_Insn; - Gen_B8 (16#0f#); - case Sz is - when Sz_8 => - B := 0; - when Sz_16 => - B := 1; - when Sz_32l - | Sz_32h => - raise Program_Error; - end case; - Gen_B8 (2#1011_0110# + B); - Gen_Rm (To_Reg32 (Reg) * 8, Op, Sz_8); - End_Insn; - end Gen_Movzx; - - -- Convert U32 to xx. - procedure Gen_Conv_U32 (Stmt : O_Enode) - is - Op : O_Enode; - Reg_Op : O_Reg; - Reg_Res : O_Reg; - begin - Op := Get_Expr_Operand (Stmt); - Reg_Op := Get_Expr_Reg (Op); - Reg_Res := Get_Expr_Reg (Stmt); - case Get_Expr_Mode (Stmt) is - when Mode_I32 => - if Reg_Res not in Regs_R32 then - raise Program_Error; - end if; - if Reg_Op /= Reg_Res then - Emit_Load (Reg_Res, Op, Sz_32l); - end if; - Emit_Tst (Reg_Res, Sz_32l); - Gen_Ov_Check (R_Sge); - when Mode_U8 - | Mode_B2 => - if Reg_Res not in Regs_R32 then - raise Program_Error; - end if; - if Reg_Op /= Reg_Res then - Emit_Load (Reg_Res, Op, Sz_32l); - end if; - -- cmpl VAL, 0xff - Start_Insn; - Gen_B8 (2#1000_0001#); - Gen_Rm (2#111_000#, Op, Sz_32l); - Gen_Le32 (16#00_00_00_Ff#); - End_Insn; - Gen_Ov_Check (R_Ule); - when others => - Error_Emit ("gen_conv_u32", Stmt); - end case; - end Gen_Conv_U32; - - -- Convert I32 to xxx - procedure Gen_Conv_I32 (Stmt : O_Enode) - is - Op : O_Enode; - Reg_Op : O_Reg; - Reg_Res : O_Reg; - begin - Op := Get_Expr_Operand (Stmt); - Reg_Op := Get_Expr_Reg (Op); - Reg_Res := Get_Expr_Reg (Stmt); - case Get_Expr_Mode (Stmt) is - when Mode_I64 => - if Reg_Res /= R_Edx_Eax or Reg_Op /= R_Ax then - raise Program_Error; - end if; - Gen_Cdq; - when Mode_U32 => - if Reg_Res not in Regs_R32 then - raise Program_Error; - end if; - if Reg_Op /= Reg_Res then - Emit_Load (Reg_Res, Op, Sz_32l); - end if; - Emit_Tst (Reg_Res, Sz_32l); - Gen_Ov_Check (R_Sge); - when Mode_B2 => - if Reg_Op /= Reg_Res then - Emit_Load (Reg_Res, Op, Sz_32l); - end if; - Gen_Cmp_Imm (Reg_Res, 1, Sz_32l); - Gen_Ov_Check (R_Ule); - when Mode_U8 => - if Reg_Op /= Reg_Res then - Emit_Load (Reg_Res, Op, Sz_32l); - end if; - Gen_Cmp_Imm (Reg_Res, 16#Ff#, Sz_32l); - Gen_Ov_Check (R_Ule); - when Mode_F64 => - Emit_Push_32 (Op, Sz_32l); - -- fild (%esp) - Start_Insn; - Gen_B8 (2#11011_011#); - Gen_B8 (2#00_000_100#); - Gen_B8 (2#00_100_100#); - End_Insn; - -- addl %esp, 4 - Start_Insn; - Gen_B8 (2#100000_11#); - Gen_B8 (2#11_000_100#); - Gen_B8 (4); - End_Insn; - when others => - Error_Emit ("gen_conv_i32", Stmt); - end case; - end Gen_Conv_I32; - - -- Convert U8 to xxx - procedure Gen_Conv_U8 (Stmt : O_Enode) - is - Op : O_Enode; - Reg_Res : O_Reg; - begin - Op := Get_Expr_Operand (Stmt); - Reg_Res := Get_Expr_Reg (Stmt); - case Get_Expr_Mode (Stmt) is - when Mode_U32 - | Mode_I32 - | Mode_U16 - | Mode_I16 => - if Reg_Res not in Regs_R32 then - raise Program_Error; - end if; - Gen_Movzx (Reg_Res, Op, Sz_8); - when others => - Error_Emit ("gen_conv_U8", Stmt); - end case; - end Gen_Conv_U8; - - -- Convert B2 to xxx - procedure Gen_Conv_B2 (Stmt : O_Enode) - is - Op : O_Enode; - Reg_Res : O_Reg; - begin - Op := Get_Expr_Operand (Stmt); - Reg_Res := Get_Expr_Reg (Stmt); - case Get_Expr_Mode (Stmt) is - when Mode_U32 - | Mode_I32 - | Mode_U16 - | Mode_I16 => - Gen_Movzx (Reg_Res, Op, Sz_8); - when others => - Error_Emit ("gen_conv_B2", Stmt); - end case; - end Gen_Conv_B2; - - -- Convert I64 to xxx - procedure Gen_Conv_I64 (Stmt : O_Enode) - is - Op : O_Enode; - begin - Op := Get_Expr_Operand (Stmt); - case Get_Expr_Mode (Stmt) is - when Mode_I32 => - -- move dx to reg_helper - Start_Insn; - Gen_B8 (2#1000_1001#); - Gen_B8 (2#11_010_000# + To_Reg32 (Reg_Helper)); - End_Insn; - Gen_Cdq; - -- cmp reg_helper, dx - Start_Insn; - Gen_B8 (2#0011_1001#); - Gen_B8 (2#11_010_000# + To_Reg32 (Reg_Helper)); - End_Insn; - Gen_Ov_Check (R_Eq); - when Mode_F64 => - Emit_Push_32 (Op, Sz_32h); - Emit_Push_32 (Op, Sz_32l); - -- fild (%esp) - Start_Insn; - Gen_B8 (2#11011_111#); - Gen_B8 (2#00_101_100#); - Gen_B8 (2#00_100_100#); - End_Insn; - -- addl %esp, 8 - Start_Insn; - Gen_B8 (2#100000_11#); - Gen_B8 (2#11_000_100#); - Gen_B8 (8); - End_Insn; - when others => - Error_Emit ("gen_conv_I64", Stmt); - end case; - end Gen_Conv_I64; - - -- Convert FP to xxx. - procedure Gen_Conv_Fp (Stmt : O_Enode) is - begin - case Get_Expr_Mode (Stmt) is - when Mode_I32 => - -- subl %esp, 4 - Start_Insn; - Gen_B8 (2#100000_11#); - Gen_B8 (2#11_101_100#); - Gen_B8 (4); - End_Insn; - -- fistp (%esp) - Start_Insn; - Gen_B8 (2#11011_011#); - Gen_B8 (2#00_011_100#); - Gen_B8 (2#00_100_100#); - End_Insn; - Emit_Pop_32 (Stmt, Sz_32l); - when Mode_I64 => - -- subl %esp, 8 - Start_Insn; - Gen_B8 (2#100000_11#); - Gen_B8 (2#11_101_100#); - Gen_B8 (8); - End_Insn; - -- fistp (%esp) - Start_Insn; - Gen_B8 (2#11011_111#); - Gen_B8 (2#00_111_100#); - Gen_B8 (2#00_100_100#); - End_Insn; - Emit_Pop_32 (Stmt, Sz_32l); - Emit_Pop_32 (Stmt, Sz_32h); - when others => - Error_Emit ("gen_conv_fp", Stmt); - end case; - end Gen_Conv_Fp; - - procedure Gen_Emit_Op (Stmt : O_Enode; Cl : Byte; Ch : Byte) is - begin - case Get_Expr_Mode (Stmt) is - when Mode_U32 - | Mode_I32 - | Mode_P32 => - Emit_Op (Cl, Stmt, Sz_32l); - when Mode_I64 - | Mode_U64 => - Emit_Op (Cl, Stmt, Sz_32l); - Emit_Op (Ch, Stmt, Sz_32h); - when Mode_B2 - | Mode_I8 - | Mode_U8 => - Emit_Op (Cl, Stmt, Sz_8); - when others => - Error_Emit ("gen_emit_op", Stmt); - end case; - end Gen_Emit_Op; - - procedure Gen_Check_Overflow (Mode : Mode_Type) is - begin - case Mode is - when Mode_I32 - | Mode_I64 - | Mode_I8 => - Gen_Into; - when Mode_U64 - | Mode_U32 - | Mode_U8 => - -- FIXME: check no carry. - null; - when Mode_B2 => - null; - when others => - raise Program_Error; - end case; - end Gen_Check_Overflow; - - procedure Gen_Emit_Fp_Op (Stmt : O_Enode; B_St1 : Byte; B_Mem : Byte) - is - Right : O_Enode; - Reg : O_Reg; - B_Size : Byte; - begin - Right := Get_Expr_Right (Stmt); - Reg := Get_Expr_Reg (Right); - Start_Insn; - case Reg is - when R_St0 => - Gen_B8 (2#11011_110#); - Gen_B8 (2#11_000_001# or B_St1); - when R_Mem => - case Get_Expr_Mode (Stmt) is - when Mode_F32 => - B_Size := 0; - when Mode_F64 => - B_Size := 2#100#; - when others => - raise Program_Error; - end case; - Gen_B8 (2#11011_000# or B_Size); - Gen_Rm_Mem (B_Mem, Right, Sz_32l); - when others => - raise Program_Error; - end case; - End_Insn; - end Gen_Emit_Fp_Op; - - procedure Emit_Mod (Stmt : O_Enode) - is - Right : O_Enode; - Pc1, Pc2, Pc3: Pc_Type; - begin - -- a : EAX - -- d : EDX - -- b : Rm - - -- d := Rm - -- d := d ^ a - -- cltd - -- if cc < 0 then - -- idiv b - -- if edx /= 0 then - -- edx := edx + b - -- end if - -- else - -- idiv b - -- end if - Right := Get_Expr_Right (Stmt); - -- %edx <- right - Emit_Load (R_Dx, Right, Sz_32l); - -- xorl %eax -> %edx - Start_Insn; - Gen_B8 (2#0011_0011#); - Gen_B8 (2#11_010_000#); - End_Insn; - Gen_Cdq; - -- js - Start_Insn; - Gen_B8 (2#0111_1000#); - Gen_B8 (0); - End_Insn; - Pc1 := Get_Current_Pc; - -- idiv - Gen_Mono_Op (2#111_000#, Right, Sz_32l); - -- jmp - Start_Insn; - Gen_B8 (2#1110_1011#); - Gen_B8 (0); - End_Insn; - Pc2 := Get_Current_Pc; - Patch_B8 (Pc1 - 1, Unsigned_8 (Get_Current_Pc - Pc1)); - -- idiv - Gen_Mono_Op (2#111_000#, Right, Sz_32l); - -- tstl %edx,%edx - Start_Insn; - Gen_B8 (2#1000_0101#); - Gen_B8 (2#11_010_010#); - End_Insn; - -- jz - Start_Insn; - Gen_B8 (2#0111_0100#); - Gen_B8 (0); - End_Insn; - Pc3 := Get_Current_Pc; - -- addl b, %edx - Start_Insn; - Gen_B8 (2#00_000_011#); - Gen_Rm (2#010_000#, Right, Sz_32l); - End_Insn; - Patch_B8 (Pc2 - 1, Unsigned_8 (Get_Current_Pc - Pc2)); - Patch_B8 (Pc3 - 1, Unsigned_8 (Get_Current_Pc - Pc3)); - end Emit_Mod; - - procedure Emit_Insn (Stmt : O_Enode) - is - use Ortho_Code.Flags; - Kind : OE_Kind; - Mode : Mode_Type; - Reg : O_Reg; - begin - Kind := Get_Expr_Kind (Stmt); - Mode := Get_Expr_Mode (Stmt); - case Kind is - when OE_Beg => - if Flag_Debug /= Debug_None then - Decls.Set_Block_Info1 (Get_Block_Decls (Stmt), - Int32 (Get_Current_Pc - Subprg_Pc)); - end if; - when OE_End => - if Flag_Debug /= Debug_None then - Decls.Set_Block_Info2 (Get_Block_Decls (Get_End_Beg (Stmt)), - Int32 (Get_Current_Pc - Subprg_Pc)); - end if; - when OE_Leave => - null; - when OE_BB => - null; - when OE_Add_Ov => - if Mode in Mode_Fp then - Gen_Emit_Fp_Op (Stmt, 2#000_000#, 2#000_000#); - else - Gen_Emit_Op (Stmt, 2#000_000#, 2#010_000#); - Gen_Check_Overflow (Mode); - end if; - when OE_Or => - Gen_Emit_Op (Stmt, 2#001_000#, 2#001_000#); - when OE_And => - Gen_Emit_Op (Stmt, 2#100_000#, 2#100_000#); - when OE_Xor => - Gen_Emit_Op (Stmt, 2#110_000#, 2#110_000#); - when OE_Sub_Ov => - if Mode in Mode_Fp then - Gen_Emit_Fp_Op (Stmt, 2#100_000#, 2#100_000#); - else - Gen_Emit_Op (Stmt, 2#101_000#, 2#011_000#); - Gen_Check_Overflow (Mode); - end if; - when OE_Mul_Ov - | OE_Mul => - case Mode is - when Mode_U8 => - Gen_Umul (Stmt, Sz_8); - when Mode_U16 => - Gen_Umul (Stmt, Sz_16); - when Mode_U32 => - Gen_Mul (Stmt, Sz_32l); - when Mode_I32 => - Gen_Mono_Op (2#101_000#, Get_Expr_Right (Stmt), Sz_32l); - when Mode_F32 - | Mode_F64 => - Gen_Emit_Fp_Op (Stmt, 2#001_000#, 2#001_000#); - when others => - Error_Emit ("emit_insn: mul_ov", Stmt); - end case; - when OE_Shl => - declare - Right : O_Enode; - Sz : Insn_Size; - Val : Uns32; - begin - case Mode is - when Mode_U32 => - Sz := Sz_32l; - when others => - Error_Emit ("emit_insn: shl", Stmt); - end case; - Right := Get_Expr_Right (Stmt); - if Get_Expr_Kind (Right) = OE_Const then - Val := Get_Expr_Low (Right); - Start_Insn; - if Val = 1 then - Gen_Insn_Sz (2#1101000_0#, Sz); - Gen_Rm (2#100_000#, Get_Expr_Left (Stmt), Sz); - else - Gen_Insn_Sz (2#1100000_0#, Sz); - Gen_Rm (2#100_000#, Get_Expr_Left (Stmt), Sz); - Gen_B8 (Byte (Val and 31)); - end if; - End_Insn; - else - if Get_Expr_Reg (Right) /= R_Cx then - raise Program_Error; - end if; - Start_Insn; - Gen_Insn_Sz (2#1101001_0#, Sz); - Gen_Rm (2#100_000#, Get_Expr_Left (Stmt), Sz); - End_Insn; - end if; - end; - when OE_Mod - | OE_Rem - | OE_Div_Ov => - case Mode is - when Mode_U32 => - -- Xorl edx, edx - Start_Insn; - Gen_B8 (2#0011_0001#); - Gen_B8 (2#11_010_010#); - End_Insn; - Gen_Mono_Op (2#110_000#, Get_Expr_Right (Stmt), Sz_32l); - when Mode_I32 => - if Kind = OE_Mod then - Emit_Mod (Stmt); - else - Gen_Cdq; - Gen_Mono_Op (2#111_000#, Get_Expr_Right (Stmt), Sz_32l); - end if; - when Mode_F32 - | Mode_F64 => - if Kind = OE_Div_Ov then - Gen_Emit_Fp_Op (Stmt, 2#111_000#, 2#110_000#); - else - raise Program_Error; - end if; - when others => - Error_Emit ("emit_insn: mod_ov", Stmt); - end case; - - when OE_Not => - case Mode is - when Mode_B2 => - -- Xor VAL, $1 - Start_Insn; - Gen_B8 (2#1000_0011#); - Gen_Rm (2#110_000#, Stmt, Sz_8); - Gen_B8 (16#01#); - End_Insn; - when Mode_U8 => - Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_8); - when Mode_U16 => - Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_16); - when Mode_U32 => - Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_32l); - when Mode_U64 => - Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_32l); - Emit_Mono_Op_Stmt (2#010_000#, Stmt, Sz_32h); - when others => - Error_Emit ("emit_insn: not", Stmt); - end case; - - when OE_Neg_Ov => - case Mode is - when Mode_I8 => - Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_8); - --Gen_Into; - when Mode_I16 => - Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_16); - --Gen_Into; - when Mode_I32 => - Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_32l); - --Gen_Into; - when Mode_I64 => - Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_32l); - -- adcl 0, high - Start_Insn; - Gen_B8 (2#100000_11#); - Gen_Rm (2#010_000#, Get_Expr_Operand (Stmt), Sz_32h); - Gen_B8 (0); - End_Insn; - Emit_Mono_Op_Stmt (2#011_000#, Stmt, Sz_32h); - --Gen_Into; - when Mode_F32 - | Mode_F64 => - -- fchs - Start_Insn; - Gen_B8 (2#11011_001#); - Gen_B8 (2#1110_0000#); - End_Insn; - when others => - Error_Emit ("emit_insn: neg_ov", Stmt); - end case; - - when OE_Abs_Ov => - case Mode is - when Mode_I32 - | Mode_I64 => - Emit_Abs (Get_Expr_Operand (Stmt), Mode); - when Mode_F32 - | Mode_F64 => - -- fabs - Start_Insn; - Gen_B8 (2#11011_001#); - Gen_B8 (2#1110_0001#); - End_Insn; - when others => - Error_Emit ("emit_insn: abs_ov", Stmt); - end case; - - when OE_Kind_Cmp => - case Get_Expr_Mode (Get_Expr_Left (Stmt)) is - when Mode_U32 - | Mode_I32 - | Mode_P32 => - Emit_Op (2#111_000#, Stmt, Sz_32l); - when Mode_B2 - | Mode_I8 - | Mode_U8 => - Emit_Op (2#111_000#, Stmt, Sz_8); - when Mode_U64 => - declare - Pc : Pc_Type; - begin - Emit_Op (2#111_000#, Stmt, Sz_32h); - -- jne - Start_Insn; - Gen_B8 (2#0111_0101#); - Gen_B8 (0); - End_Insn; - Pc := Get_Current_Pc; - Emit_Op (2#111_000#, Stmt, Sz_32l); - Patch_B8 (Pc - 1, Unsigned_8 (Get_Current_Pc - Pc)); - end; - when Mode_I64 => - declare - Pc : Pc_Type; - begin - Reg := Get_Expr_Reg (Stmt); - Emit_Op (2#111_000#, Stmt, Sz_32h); - -- Note: this does not clobber a reg due to care in - -- insns. - Emit_Setcc_Reg (Reg, Ekind_Signed_To_Cc (Kind)); - -- jne - Start_Insn; - Gen_B8 (2#0111_0101#); - Gen_B8 (0); - End_Insn; - Pc := Get_Current_Pc; - Emit_Op (2#111_000#, Stmt, Sz_32l); - Emit_Setcc_Reg (Reg, Ekind_Unsigned_To_Cc (Kind)); - Patch_B8 (Pc - 1, Unsigned_8 (Get_Current_Pc - Pc)); - return; - end; - when Mode_F32 - | Mode_F64 => - -- fcomip st, st(1) - Start_Insn; - Gen_B8 (2#11011_111#); - Gen_B8 (2#1111_0001#); - End_Insn; - -- fstp st, st (0) - Start_Insn; - Gen_B8 (2#11011_101#); - Gen_B8 (2#11_011_000#); - End_Insn; - when others => - Error_Emit ("emit_insn: cmp", Stmt); - end case; - Reg := Get_Expr_Reg (Stmt); - if Reg not in Regs_Cc then - Error_Emit ("emit_insn/cmp: not cc", Stmt); - end if; - when OE_Const - | OE_Addrg => - case Mode is - when Mode_U32 - | Mode_I32 - | Mode_P32 => - Emit_Load_Imm (Stmt, Sz_32l); - when Mode_B2 - | Mode_U8 - | Mode_I8 => - Emit_Load_Imm (Stmt, Sz_8); - when Mode_I64 - | Mode_U64 => - Emit_Load_Imm (Stmt, Sz_32l); - Emit_Load_Imm (Stmt, Sz_32h); - when Mode_F32 => - Emit_Load_Fp (Stmt, Fp_32); - when Mode_F64 => - Emit_Load_Fp (Stmt, Fp_64); - when others => - Error_Emit ("emit_insn: const", Stmt); - end case; - when OE_Indir => - case Mode is - when Mode_U32 - | Mode_I32 - | Mode_P32 => - Emit_Load_Mem (Stmt, Sz_32l); - when Mode_B2 - | Mode_U8 - | Mode_I8 => - Emit_Load_Mem (Stmt, Sz_8); - when Mode_U64 - | Mode_I64 => - Emit_Load_Mem (Stmt, Sz_32l); - Emit_Load_Mem (Stmt, Sz_32h); - when Mode_F32 => - Emit_Load_Fp_Mem (Stmt, Fp_32); - when Mode_F64 => - Emit_Load_Fp_Mem (Stmt, Fp_64); - when others => - Error_Emit ("emit_insn: indir", Stmt); - end case; - - when OE_Conv => - case Get_Expr_Mode (Get_Expr_Operand (Stmt)) is - when Mode_U32 => - Gen_Conv_U32 (Stmt); - when Mode_I32 => - Gen_Conv_I32 (Stmt); - when Mode_U8 => - Gen_Conv_U8 (Stmt); - when Mode_B2 => - Gen_Conv_B2 (Stmt); - when Mode_I64 => - Gen_Conv_I64 (Stmt); - when Mode_F32 - | Mode_F64 => - Gen_Conv_Fp (Stmt); - when others => - Error_Emit ("emit_insn: conv", Stmt); - end case; - - when OE_Asgn => - case Mode is - when Mode_U32 - | Mode_I32 - | Mode_P32 => - Emit_Store (Stmt, Sz_32l); - when Mode_B2 - | Mode_U8 - | Mode_I8 => - Emit_Store (Stmt, Sz_8); - when Mode_U64 - | Mode_I64 => - Emit_Store (Stmt, Sz_32l); - Emit_Store (Stmt, Sz_32h); - when Mode_F32 => - Emit_Store_Fp (Stmt, Fp_32); - when Mode_F64 => - Emit_Store_Fp (Stmt, Fp_64); - when others => - Error_Emit ("emit_insn: move", Stmt); - end case; - - when OE_Jump_F => - Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt)); - if Reg not in Regs_Cc then - Error_Emit ("emit_insn/jmp_f: not cc", Stmt); - end if; - Emit_Jmp_T (Stmt, Inverse_Cc (Reg)); - when OE_Jump_T => - Reg := Get_Expr_Reg (Get_Expr_Operand (Stmt)); - if Reg not in Regs_Cc then - Error_Emit ("emit_insn/jmp_t: not cc", Stmt); - end if; - Emit_Jmp_T (Stmt, Reg); - when OE_Jump => - Emit_Jmp (Stmt); - when OE_Label => - Emit_Label (Stmt); - - when OE_Ret => - -- Value already set. - null; - - when OE_Arg => - case Mode is - when Mode_U32 - | Mode_I32 - | Mode_P32 => - Emit_Push_32 (Get_Expr_Operand (Stmt), Sz_32l); - when Mode_U64 - | Mode_I64 => - Emit_Push_32 (Get_Expr_Operand (Stmt), Sz_32h); - Emit_Push_32 (Get_Expr_Operand (Stmt), Sz_32l); - when Mode_F32 => - Emit_Push_Fp (Get_Expr_Operand (Stmt), Fp_32); - when Mode_F64 => - Emit_Push_Fp (Get_Expr_Operand (Stmt), Fp_64); - when others => - Error_Emit ("emit_insn: oe_arg", Stmt); - end case; - when OE_Stack_Adjust => - Emit_Setup_Frame (Stmt); - when OE_Call => - Emit_Call (Stmt); - when OE_Intrinsic => - Emit_Intrinsic (Stmt); - - when OE_Move => - declare - Operand : O_Enode; - Op_Reg : O_Reg; - begin - Reg := Get_Expr_Reg (Stmt); - Operand := Get_Expr_Operand (Stmt); - Op_Reg := Get_Expr_Reg (Operand); - case Mode is - when Mode_B2 => - if Reg in Regs_R32 and then Op_Reg in Regs_Cc then - Emit_Setcc (Stmt, Op_Reg); - elsif (Reg = R_Eq or Reg = R_Ne) - and then Op_Reg in Regs_R32 - then - Emit_Tst (Op_Reg, Sz_8); - else - Error_Emit ("emit_insn: move/b2", Stmt); - end if; - when Mode_U32 - | Mode_I32 => - -- mov REG, OP - Start_Insn; - Gen_Insn_Sz (2#1000_101_0#, Sz_32l); - Gen_Rm (To_Reg32 (Reg, Sz_32l) * 8, Operand, Sz_32l); - End_Insn; - when others => - Error_Emit ("emit_insn: move", Stmt); - end case; - end; - - when OE_Alloca => - if Mode /= Mode_P32 then - raise Program_Error; - end if; - Gen_Alloca (Stmt); - - when OE_Set_Stack => - Emit_Load_Mem (Stmt, Sz_32l); - - when OE_Add - | OE_Addrl => - case Mode is - when Mode_U32 - | Mode_I32 - | Mode_P32 => - Emit_Lea (Stmt); - when others => - Error_Emit ("emit_insn: oe_add", Stmt); - end case; - - when OE_Spill => - case Mode is - when Mode_B2 - | Mode_U8 - | Mode_I8 => - Emit_Spill (Stmt, Sz_8); - when Mode_U32 - | Mode_I32 - | Mode_P32 => - Emit_Spill (Stmt, Sz_32l); - when Mode_U64 - | Mode_I64 => - Emit_Spill (Stmt, Sz_32l); - Emit_Spill (Stmt, Sz_32h); - when others => - Error_Emit ("emit_insn: spill", Stmt); - end case; - - when OE_Reload => - declare - Expr : O_Enode; - begin - Reg := Get_Expr_Reg (Stmt); - Expr := Get_Expr_Operand (Stmt); - case Mode is - when Mode_B2 - | Mode_U8 - | Mode_I8 => - Emit_Load (Reg, Expr, Sz_8); - when Mode_U32 - | Mode_I32 - | Mode_P32 => - Emit_Load (Reg, Expr, Sz_32l); - when Mode_U64 - | Mode_I64 => - Emit_Load (Reg, Expr, Sz_32l); - Emit_Load (Reg, Expr, Sz_32h); - when others => - Error_Emit ("emit_insn: reload", Stmt); - end case; - end; - - when OE_Reg => - Reg_Helper := Get_Expr_Reg (Stmt); - - when OE_Case_Expr - | OE_Case => - null; - - when OE_Line => - if Flag_Debug = Debug_Dwarf then - Dwarf.Set_Line_Stmt (Get_Expr_Line_Number (Stmt)); - Set_Current_Section (Sect_Text); - end if; - when others => - Error_Emit ("cannot handle insn", Stmt); - end case; - end Emit_Insn; - - procedure Push_Reg_If_Used (Reg : Regs_R32) - is - use Ortho_Code.X86.Insns; - begin - if Reg_Used (Reg) then - Start_Insn; - Gen_B8 (2#01010_000# + To_Reg32 (Reg, Sz_32l)); - End_Insn; - end if; - end Push_Reg_If_Used; - - procedure Pop_Reg_If_Used (Reg : Regs_R32) - is - use Ortho_Code.X86.Insns; - begin - if Reg_Used (Reg) then - Start_Insn; - Gen_B8 (2#01011_000# + To_Reg32 (Reg, Sz_32l)); - End_Insn; - end if; - end Pop_Reg_If_Used; - - procedure Emit_Prologue (Subprg : Subprogram_Data_Acc) - is - use Ortho_Code.Decls; - use Ortho_Code.Flags; - use Ortho_Code.X86.Insns; - Sym : Symbol; - Subprg_Decl : O_Dnode; - Is_Global : Boolean; - Frame_Size : Unsigned_32; - Saved_Regs_Size : Unsigned_32; - begin - -- Switch to .text section and align the function (to avoid the nested - -- function trick and for performance). - Set_Current_Section (Sect_Text); - Gen_Pow_Align (2); - - Subprg_Decl := Subprg.D_Decl; - Sym := Get_Decl_Symbol (Subprg_Decl); - case Get_Decl_Storage (Subprg_Decl) is - when O_Storage_Public - | O_Storage_External => - -- FIXME: should not accept the external case. - Is_Global := True; - when others => - Is_Global := False; - end case; - Set_Symbol_Pc (Sym, Is_Global); - Subprg_Pc := Get_Current_Pc; - - Saved_Regs_Size := Boolean'Pos(Reg_Used (R_Di)) * 4 - + Boolean'Pos(Reg_Used (R_Si)) * 4 - + Boolean'Pos(Reg_Used (R_Bx)) * 4; - - -- Compute frame size. - -- 8 bytes are used by return address and saved frame pointer. - Frame_Size := Unsigned_32 (Subprg.Stack_Max) + 8 + Saved_Regs_Size; - -- Align. - Frame_Size := (Frame_Size + X86.Flags.Stack_Boundary - 1) - and not (X86.Flags.Stack_Boundary - 1); - -- The 8 bytes are already allocated. - Frame_Size := Frame_Size - 8 - Saved_Regs_Size; - - -- Emit prolog. - -- push %ebp - Start_Insn; - Gen_B8 (2#01010_101#); - End_Insn; - -- movl %esp, %ebp - Start_Insn; - Gen_B8 (2#1000100_1#); - Gen_B8 (2#11_100_101#); - End_Insn; - -- subl XXX, %esp - if Frame_Size /= 0 then - if not X86.Flags.Flag_Alloca_Call - or else Frame_Size <= 4096 - then - Start_Insn; - if Frame_Size < 128 then - Gen_B8 (2#100000_11#); - Gen_B8 (2#11_101_100#); - Gen_B8 (Byte (Frame_Size)); - else - Gen_B8 (2#100000_01#); - Gen_B8 (2#11_101_100#); - Gen_Le32 (Frame_Size); - end if; - End_Insn; - else - -- mov stack_size,%eax - Start_Insn; - Gen_B8 (2#1011_1_000#); - Gen_Le32 (Frame_Size); - End_Insn; - Gen_Call (Chkstk_Symbol); - end if; - end if; - - if Flag_Profile then - Gen_Call (Mcount_Symbol); - end if; - - -- Save registers. - Push_Reg_If_Used (R_Di); - Push_Reg_If_Used (R_Si); - Push_Reg_If_Used (R_Bx); - end Emit_Prologue; - - procedure Emit_Epilogue (Subprg : Subprogram_Data_Acc) - is - use Ortho_Code.Decls; - use Ortho_Code.Types; - use Ortho_Code.Flags; - Decl : O_Dnode; - begin - -- Restore registers. - Pop_Reg_If_Used (R_Bx); - Pop_Reg_If_Used (R_Si); - Pop_Reg_If_Used (R_Di); - - Decl := Subprg.D_Decl; - if Get_Decl_Kind (Decl) = OD_Function then - case Get_Type_Mode (Get_Decl_Type (Decl)) is - when Mode_U8 - | Mode_B2 => - -- movzx %al,%eax - Start_Insn; - Gen_B8 (16#0f#); - Gen_B8 (2#1011_0110#); - Gen_B8 (2#11_000_000#); - End_Insn; - when Mode_U32 - | Mode_I32 - | Mode_U64 - | Mode_I64 - | Mode_F32 - | Mode_F64 - | Mode_P32 => - null; - when others => - raise Program_Error; - end case; - end if; - - -- leave - Start_Insn; - Gen_B8 (2#1100_1001#); - End_Insn; - - -- ret - Start_Insn; - Gen_B8 (2#1100_0011#); - End_Insn; - - if Flag_Debug = Debug_Dwarf then - Set_Body_Info (Subprg.D_Body, Int32 (Get_Current_Pc - Subprg_Pc)); - end if; - end Emit_Epilogue; - - procedure Emit_Subprg (Subprg : Subprogram_Data_Acc) - is - Stmt : O_Enode; - begin - if Debug.Flag_Debug_Code2 then - Abi.Disp_Subprg_Decl (Subprg.D_Decl); - end if; - - Emit_Prologue (Subprg); - - Stmt := Subprg.E_Entry; - loop - Stmt := Get_Stmt_Link (Stmt); - - if Debug.Flag_Debug_Code2 then - Abi.Disp_Stmt (Stmt); - end if; - - Emit_Insn (Stmt); - exit when Get_Expr_Kind (Stmt) = OE_Leave; - end loop; - - Emit_Epilogue (Subprg); - end Emit_Subprg; - - procedure Emit_Var_Decl (Decl : O_Dnode) - 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)); - 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_Const_Decl (Decl : O_Dnode) - is - use Decls; - use Types; - Sym : Symbol; - begin - Set_Current_Section (Sect_Rodata); - Sym := Create_Symbol (Get_Decl_Ident (Decl)); - Set_Decl_Info (Decl, To_Int32 (Uns32 (Sym))); - Set_Current_Section (Sect_Text); - end Emit_Const_Decl; - - procedure Emit_Const (Val : O_Cnode) - is - use Consts; - use Types; - H, L : Uns32; - begin - case Get_Const_Kind (Val) is - when OC_Signed - | OC_Unsigned - | OC_Float - | OC_Null - | OC_Lit => - Get_Const_Bytes (Val, H, L); - case Get_Type_Mode (Get_Const_Type (Val)) is - when Mode_U8 - | Mode_I8 - | Mode_B2 => - Gen_B8 (Byte (L)); - when Mode_U32 - | Mode_I32 - | Mode_F32 - | Mode_P32 => - Gen_Le32 (Unsigned_32 (L)); - when Mode_F64 - | Mode_I64 - | Mode_U64 => - Gen_Le32 (Unsigned_32 (L)); - Gen_Le32 (Unsigned_32 (H)); - when others => - raise Program_Error; - end case; - when OC_Address - | OC_Subprg_Address => - Gen_X86_32 (Get_Decl_Symbol (Get_Const_Decl (Val)), 0); - when OC_Array => - for I in 0 .. Get_Const_Aggr_Length (Val) - 1 loop - Emit_Const (Get_Const_Aggr_Element (Val, I)); - end loop; - when OC_Record => - declare - E : O_Cnode; - begin - for I in 0 .. Get_Const_Aggr_Length (Val) - 1 loop - E := Get_Const_Aggr_Element (Val, I); - Gen_Pow_Align (Get_Type_Align (Get_Const_Type (E))); - Emit_Const (E); - end loop; - end; - when OC_Sizeof - | OC_Alignof - | OC_Union => - raise Program_Error; - end case; - end Emit_Const; - - procedure Emit_Const_Value (Decl : O_Dnode; Val : O_Cnode) - is - use Decls; - use Types; - Sym : Symbol; - Dtype : O_Tnode; - begin - Set_Current_Section (Sect_Rodata); - Sym := Get_Decl_Symbol (Decl); - - Dtype := Get_Decl_Type (Decl); - Gen_Pow_Align (Get_Type_Align (Dtype)); - Set_Symbol_Pc (Sym, Get_Decl_Storage (Decl) = O_Storage_Public); - Prealloc (Pc_Type (Get_Type_Size (Dtype))); - Emit_Const (Val); - - Set_Current_Section (Sect_Text); - end Emit_Const_Value; - - procedure Init - is - use Ortho_Ident; - use Ortho_Code.Flags; - begin - Arch := Arch_X86; - - Create_Section (Sect_Text, ".text", Section_Exec + Section_Read); - Create_Section (Sect_Rodata, ".rodata", Section_Read); - Create_Section (Sect_Bss, ".bss", - Section_Read + Section_Write + Section_Zero); - - Set_Current_Section (Sect_Text); - - if Flag_Profile then - Mcount_Symbol := Create_Symbol (Get_Identifier ("mcount")); - end if; - - if X86.Flags.Flag_Alloca_Call then - Chkstk_Symbol := Create_Symbol (Get_Identifier ("___chkstk")); - end if; - - Intrinsics_Symbol (Intrinsic_Mul_Ov_U64) := - Create_Symbol (Get_Identifier ("__muldi3")); - Intrinsics_Symbol (Intrinsic_Div_Ov_U64) := - Create_Symbol (Get_Identifier ("__mcode_div_ov_u64")); - Intrinsics_Symbol (Intrinsic_Mod_Ov_U64) := - Create_Symbol (Get_Identifier ("__mcode_mod_ov_u64")); - Intrinsics_Symbol (Intrinsic_Mul_Ov_I64) := - Create_Symbol (Get_Identifier ("__muldi3")); - Intrinsics_Symbol (Intrinsic_Div_Ov_I64) := - Create_Symbol (Get_Identifier ("__divdi3")); - Intrinsics_Symbol (Intrinsic_Mod_Ov_I64) := - Create_Symbol (Get_Identifier ("__mcode_mod_ov_i64")); - Intrinsics_Symbol (Intrinsic_Rem_Ov_I64) := - Create_Symbol (Get_Identifier ("__mcode_rem_ov_i64")); - - if Debug.Flag_Debug_Asm then - Dump_Asm := True; - end if; - if Debug.Flag_Debug_Hex then - Debug_Hex := True; - end if; - - if Flag_Debug = Debug_Dwarf then - Dwarf.Init; - Set_Current_Section (Sect_Text); - end if; - end Init; - - procedure Finish - is - use Ortho_Code.Flags; - begin - if Flag_Debug = Debug_Dwarf then - Set_Current_Section (Sect_Text); - Dwarf.Finish; - end if; - end Finish; - -end Ortho_Code.X86.Emits; - |