aboutsummaryrefslogtreecommitdiffstats
path: root/src/ortho/mcode/ortho_code-x86-emits.adb
diff options
context:
space:
mode:
authorTristan Gingold <tgingold@free.fr>2014-11-04 20:14:19 +0100
committerTristan Gingold <tgingold@free.fr>2014-11-04 20:14:19 +0100
commit9c195bf5d86d67ea5eb419ccf6e48dc153e57c68 (patch)
tree575346e529b99e26382b4a06f6ff2caa0b391ab2 /src/ortho/mcode/ortho_code-x86-emits.adb
parent184a123f91e07c927292d67462561dc84f3a920d (diff)
downloadghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.gz
ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.tar.bz2
ghdl-9c195bf5d86d67ea5eb419ccf6e48dc153e57c68.zip
Move sources to src/ subdirectory.
Diffstat (limited to 'src/ortho/mcode/ortho_code-x86-emits.adb')
-rw-r--r--src/ortho/mcode/ortho_code-x86-emits.adb2322
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 000000000..ad1ef559b
--- /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;
+