diff options
Diffstat (limited to 'src/ortho/mcode/ortho_code-x86-emits.adb')
| -rw-r--r-- | src/ortho/mcode/ortho_code-x86-emits.adb | 2322 |
1 files changed, 2322 insertions, 0 deletions
diff --git a/src/ortho/mcode/ortho_code-x86-emits.adb b/src/ortho/mcode/ortho_code-x86-emits.adb new file mode 100644 index 0000000..ad1ef55 --- /dev/null +++ b/src/ortho/mcode/ortho_code-x86-emits.adb @@ -0,0 +1,2322 @@ +-- 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; + |