-- Mcode back-end for ortho - mcode to X86 instructions.
-- 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 Interfaces;
with Ada.Text_IO;
with Ortho_Code.Abi;
with Ortho_Code.Decls; use Ortho_Code.Decls;
with Ortho_Code.Types; use Ortho_Code.Types;
with Ortho_Code.Debug;
with Ortho_Code.X86.Flags;
package body Ortho_Code.X86.Insns is
procedure Link_Stmt (Stmt : O_Enode)
is
use Ortho_Code.Abi;
begin
Set_Stmt_Link (Last_Link, Stmt);
Last_Link := Stmt;
if Debug.Flag_Debug_Insn then
Disp_Stmt (Stmt);
end if;
end Link_Stmt;
function Get_Reg_Any (Mode : Mode_Type) return O_Reg is
begin
case Mode is
when Mode_I16 .. Mode_I32
| Mode_U16 .. Mode_U32
| Mode_P32 =>
return R_Any32;
when Mode_I8
| Mode_U8
| Mode_B2 =>
return R_Any8;
when Mode_U64
| Mode_I64 =>
return R_Any64;
when Mode_F32
| Mode_F64 =>
if Abi.Flag_Sse2 then
return R_Any_Xmm;
else
return R_St0;
end if;
when Mode_P64
| Mode_X1
| Mode_Nil
| Mode_Blk =>
raise Program_Error;
end case;
end Get_Reg_Any;
function Get_Reg_Any (Stmt : O_Enode) return O_Reg is
begin
return Get_Reg_Any (Get_Expr_Mode (Stmt));
end Get_Reg_Any;
-- Stack slot management.
Stack_Offset : Uns32 := 0;
Stack_Max : Uns32 := 0;
-- Count how many bytes have been pushed on the stack, during a call. This
-- is used to correctly align the stack for nested calls.
Push_Offset : Uns32 := 0;
-- STMT is an OE_END statement.
-- Swap Stack_Offset with Max_Stack of STMT.
procedure Swap_Stack_Offset (Blk : O_Dnode)
is
Prev_Offset : Uns32;
begin
Prev_Offset := Get_Block_Max_Stack (Blk);
Set_Block_Max_Stack (Blk, Stack_Offset);
Stack_Offset := Prev_Offset;
end Swap_Stack_Offset;
procedure Expand_Decls (Block : O_Dnode)
is
Last : O_Dnode;
Decl : O_Dnode;
Decl_Type : O_Tnode;
begin
if Get_Decl_Kind (Block) /= OD_Block then
raise Program_Error;
end if;
Last := Get_Block_Last (Block);
Decl := Block + 1;
while Decl <= Last loop
case Get_Decl_Kind (Decl) is
when OD_Local =>
Decl_Type := Get_Decl_Type (Decl);
Stack_Offset := Do_Align (Stack_Offset, Decl_Type);
Stack_Offset := Stack_Offset + Get_Type_Size (Decl_Type);
Set_Local_Offset (Decl, -Int32 (Stack_Offset));
if Stack_Offset > Stack_Max then
Stack_Max := Stack_Offset;
end if;
when OD_Type
| OD_Const
| OD_Const_Val
| OD_Var
| OD_Function
| OD_Procedure
| OD_Interface
| OD_Body
| OD_Subprg_Ext =>
null;
when OD_Block =>
Decl := Get_Block_Last (Decl);
end case;
Decl := Decl + 1;
end loop;
end Expand_Decls;
function Ekind_To_Cc (Stmt : O_Enode; Mode : Mode_Type) return O_Reg
is
Kind : OE_Kind;
begin
Kind := Get_Expr_Kind (Stmt);
case Mode is
when Mode_U8 .. Mode_U64
| Mode_F32 .. Mode_F64
| Mode_P32
| Mode_P64
| Mode_B2 =>
return Ekind_Unsigned_To_Cc (Kind);
when Mode_I8 .. Mode_I64 =>
return Ekind_Signed_To_Cc (Kind);
when others =>
raise Program_Error;
end case;
end Ekind_To_Cc;
-- CC is the result of A CMP B.
-- Returns the condition for B CMP A.
function Reverse_Cc (Cc : O_Reg) return O_Reg is
begin
case Cc is
when R_Ult =>
return R_Ugt;
when R_Uge =>
return R_Ule;
when R_Eq =>
return R_Eq;
when R_Ne =>
return R_Ne;
when R_Ule =>
return R_Uge;
when R_Ugt =>
return R_Ult;
when R_Slt =>
return R_Sgt;
when R_Sge =>
return R_Sle;
when R_Sle =>
return R_Sge;
when R_Sgt =>
return R_Slt;
when others =>
raise Program_Error;
end case;
end Reverse_Cc;
-- Get the register in which a result of MODE is returned.
function Get_Call_Register (Mode : Mode_Type) return O_Reg is
begin
case Mode is
when Mode_U8 .. Mode_U32
| Mode_I8 .. Mode_I32
| Mode_P32
| Mode_B2 =>
return R_Ax;
when Mode_U64
| Mode_I64 =>
return R_Edx_Eax;
when Mode_F32
| Mode_F64 =>
if Abi.Flag_Sse2 and True then
-- Note: this shouldn't be enabled as the svr4 ABI specifies
-- ST0.
return R_Xmm0;
else
return R_St0;
end if;
when Mode_Nil =>
return R_None;
when Mode_X1
| Mode_Blk
| Mode_P64 =>
raise Program_Error;
end case;
end Get_Call_Register;
-- function Ensure_Rm (Stmt : O_Enode) return O_Enode
-- is
-- begin
-- case Get_Expr_Reg (Stmt) is
-- when R_Mem
-- | Regs_Any32 =>
-- return Stmt;
-- when others =>
-- raise Program_Error;
-- end case;
-- end Ensure_Rm;
-- function Ensure_Ireg (Stmt : O_Enode) return O_Enode
-- is
-- Reg : O_Reg;
-- begin
-- Reg := Get_Expr_Reg (Stmt);
-- case Reg is
-- when Regs_Any32
-- | R_Imm =>
-- return Stmt;
-- when others =>
-- raise Program_Error;
-- end case;
-- end Ensure_Ireg;
function Insert_Move (Expr : O_Enode; Dest : O_Reg) return O_Enode
is
N : O_Enode;
begin
N := New_Enode (OE_Move, Get_Expr_Mode (Expr), O_Tnode_Null,
Expr, O_Enode_Null);
Set_Expr_Reg (N, Dest);
Link_Stmt (N);
return N;
end Insert_Move;
-- function Insert_Spill (Expr : O_Enode) return O_Enode
-- is
-- N : O_Enode;
-- begin
-- N := New_Enode (OE_Spill, Get_Expr_Mode (Expr), O_Tnode_Null,
-- Expr, O_Enode_Null);
-- Set_Expr_Reg (N, R_Spill);
-- Link_Stmt (N);
-- return N;
-- end Insert_Spill;
procedure Error_Gen_Insn (Stmt : O_Enode; Reg : O_Reg)
is
use Ada.Text_IO;
begin
Put_Line ("gen_insn error: cannot match reg " & Abi.Image_Reg (Reg)
& " with stmt " & OE_Kind'Image (Get_Expr_Kind (Stmt)));
raise Program_Error;
end Error_Gen_Insn;
procedure Error_Gen_Insn (Stmt : O_Enode; Mode : Mode_Type)
is
use Ada.Text_IO;
begin
Put_Line ("gen_insn error: cannot match mode " & Mode_Type'Image (Mode)
& " with stmt " & OE_Kind'Image (Get_Expr_Kind (Stmt))
& " of mode " & Mode_Type'Image (Get_Expr_Mode (Stmt)));
raise Program_Error;
end Error_Gen_Insn;
pragma No_Return (Error_Gen_Insn);
Cur_Block : O_Enode;
type O_Inum is new Int32;
O_Free : constant O_Inum := 0;
O_Iroot : constant O_Inum := 1;
Insn_Num : O_Inum;
function Get_Insn_Num return O_Inum is
begin
Insn_Num := Insn_Num + 1;
return Insn_Num;
end Get_Insn_Num;
type Reg_Info_Type is record
-- Statement number which use this register.
-- This is a distance.
Num : O_Inum;
-- Statement which produces this value.
-- Used to have more info on this register (such as mode to allocate
-- a spill location).
Stmt : O_Enode;
-- If set, this register has been used.
-- All callee-saved registers marked must be saved.
Used : Boolean;
end record;
Init_Reg_Info : constant Reg_Info_Type := (Num => O_Free,
Stmt => O_Enode_Null,
Used => False);
type Reg32_Info_Array is array (Regs_R32) of Reg_Info_Type;
Regs : Reg32_Info_Array := (others => Init_Reg_Info);
Reg_Cc : Reg_Info_Type := Init_Reg_Info;
type Fp_Stack_Type is mod 8;
type RegFp_Info_Array is array (Fp_Stack_Type) of Reg_Info_Type;
Fp_Top : Fp_Stack_Type := 0;
Fp_Regs : RegFp_Info_Array;
type Reg_Xmm_Info_Array is array (Regs_Xmm) of Reg_Info_Type;
Info_Regs_Xmm : Reg_Xmm_Info_Array := (others => Init_Reg_Info);
function Reg_Used (Reg : Regs_R32) return Boolean is
begin
return Regs (Reg).Used;
end Reg_Used;
procedure Dump_Reg32_Info (Reg : Regs_R32)
is
use Ada.Text_IO;
use Ortho_Code.Debug.Int32_IO;
use Abi;
begin
Put (Image_Reg (Reg));
Put (": ");
Put (Int32 (Regs (Reg).Stmt), 0);
Put (", num: ");
Put (Int32 (Regs (Reg).Num), 0);
--Put (", twin: ");
--Put (Image_Reg (Regs (Reg).Twin_Reg));
--Put (", link: ");
--Put (Image_Reg (Regs (Reg).Link));
New_Line;
end Dump_Reg32_Info;
procedure Dump_Regs
is
use Ada.Text_IO;
use Debug.Int32_IO;
begin
-- Put ("free_regs: ");
-- Put (Image_Reg (Free_Regs));
-- Put (", to_free_regs: ");
-- Put (Image_Reg (To_Free_Regs));
-- New_Line;
for I in Regs_R32 loop
Dump_Reg32_Info (I);
end loop;
for I in Fp_Stack_Type loop
Put ("fp" & Fp_Stack_Type'Image (I));
Put (": ");
Put (Int32 (Fp_Regs (I).Stmt), 0);
New_Line;
end loop;
end Dump_Regs;
pragma Unreferenced (Dump_Regs);
procedure Error_Reg (Msg : String; Stmt : O_Enode; Reg : O_Reg)
is
use Ada.Text_IO;
use Ortho_Code.Debug.Int32_IO;
begin
Put ("error reg: ");
Put (Msg);
New_Line;
Put (" stmt: ");
Put (Int32 (Stmt), 0);
Put (", reg: ");
Put (Abi.Image_Reg (Reg));
New_Line;
--Dump_Regs;
raise Program_Error;
end Error_Reg;
pragma No_Return (Error_Reg);
-- Free_XX
-- Mark a register as unused.
procedure Free_R32 (Reg : O_Reg) is
begin
if Regs (Reg).Num = O_Free then
raise Program_Error;
end if;
Regs (Reg).Num := O_Free;
end Free_R32;
procedure Free_Fp is
begin
if Fp_Regs (Fp_Top).Stmt = O_Enode_Null then
raise Program_Error;
end if;
Fp_Regs (Fp_Top).Stmt := O_Enode_Null;
Fp_Top := Fp_Top + 1;
end Free_Fp;
procedure Free_Cc is
begin
if Reg_Cc.Num = O_Free then
raise Program_Error;
end if;
Reg_Cc.Num := O_Free;
end Free_Cc;
procedure Free_Xmm (Reg : O_Reg) is
begin
if Info_Regs_Xmm (Reg).Num = O_Free then
raise Program_Error;
end if;
Info_Regs_Xmm (Reg).Num := O_Free;
end Free_Xmm;
-- Allocate a stack slot for spilling.
procedure Alloc_Spill (N : O_Enode)
is
Mode : Mode_Type;
begin
Mode := Get_Expr_Mode (N);
-- Allocate on the stack.
Stack_Offset := Types.Do_Align (Stack_Offset, Mode);
Stack_Offset := Stack_Offset + Types.Get_Mode_Size (Mode);
if Stack_Offset > Stack_Max then
Stack_Max := Stack_Offset;
end if;
Set_Spill_Info (N, -Int32 (Stack_Offset));
end Alloc_Spill;
-- Insert a spill statement after ORIG: will save register(s) allocated by
-- ORIG.
-- Return the register(s) spilt (There might be several registers if
-- ORIG uses a R64 register).
function Insert_Spill (Orig : O_Enode) return O_Reg
is
N : O_Enode;
Mode : Mode_Type;
Reg_Orig : O_Reg;
begin
-- Add a spill statement.
Mode := Get_Expr_Mode (Orig);
N := New_Enode (OE_Spill, Mode, O_Tnode_Null, Orig, O_Enode_Null);
Alloc_Spill (N);
-- Insert the statement after the one that set the register
-- being spilled.
-- That's very important to be able to easily find the spill location,
-- when it will be reloaded.
if Orig = Abi.Last_Link then
Link_Stmt (N);
else
Set_Stmt_Link (N, Get_Stmt_Link (Orig));
Set_Stmt_Link (Orig, N);
end if;
Reg_Orig := Get_Expr_Reg (Orig);
Set_Expr_Reg (N, Reg_Orig);
Set_Expr_Reg (Orig, R_Spill);
return Reg_Orig;
end Insert_Spill;
procedure Spill_R32 (Reg : Regs_R32)
is
Reg_Orig : O_Reg;
begin
if Regs (Reg).Num = O_Free then
-- This register was not allocated.
raise Program_Error;
end if;
Reg_Orig := Insert_Spill (Regs (Reg).Stmt);
-- Free the register.
case Reg_Orig is
when Regs_R32 =>
if Reg_Orig /= Reg then
raise Program_Error;
end if;
Free_R32 (Reg);
when Regs_R64 =>
Free_R32 (Get_R64_High (Reg_Orig));
Free_R32 (Get_R64_Low (Reg_Orig));
when others =>
raise Program_Error;
end case;
end Spill_R32;
procedure Alloc_R32 (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) is
begin
if Regs (Reg).Num /= O_Free then
Spill_R32 (Reg);
end if;
Regs (Reg) := (Num => Num, Stmt => Stmt, Used => True);
end Alloc_R32;
procedure Clobber_R32 (Reg : O_Reg) is
begin
if Regs (Reg).Num /= O_Free then
Spill_R32 (Reg);
end if;
end Clobber_R32;
procedure Alloc_Fp (Stmt : O_Enode)
is
begin
Fp_Top := Fp_Top - 1;
if Fp_Regs (Fp_Top).Stmt /= O_Enode_Null then
-- Must spill-out.
raise Program_Error;
end if;
Fp_Regs (Fp_Top).Stmt := Stmt;
end Alloc_Fp;
procedure Alloc_R64 (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum)
is
Rh, Rl : O_Reg;
begin
Rl := Get_R64_Low (Reg);
Rh := Get_R64_High (Reg);
if Regs (Rl).Num /= O_Free
or Regs (Rh).Num /= O_Free
then
Spill_R32 (Rl);
end if;
Regs (Rh) := (Num => Num, Stmt => Stmt, Used => True);
Regs (Rl) := (Num => Num, Stmt => Stmt, Used => True);
end Alloc_R64;
procedure Alloc_Cc (Stmt : O_Enode; Num : O_Inum) is
begin
if Reg_Cc.Num /= O_Free then
raise Program_Error;
end if;
Reg_Cc := (Num => Num, Stmt => Stmt, Used => True);
end Alloc_Cc;
procedure Spill_Xmm (Reg : Regs_Xmm)
is
Reg_Orig : O_Reg;
begin
if Info_Regs_Xmm (Reg).Num = O_Free then
-- This register was not allocated.
raise Program_Error;
end if;
Reg_Orig := Insert_Spill (Info_Regs_Xmm (Reg).Stmt);
-- Free the register.
if Reg_Orig /= Reg then
raise Program_Error;
end if;
Free_Xmm (Reg);
end Spill_Xmm;
procedure Alloc_Xmm (Reg : Regs_Xmm; Stmt : O_Enode; Num : O_Inum) is
begin
if Info_Regs_Xmm (Reg).Num /= O_Free then
Spill_Xmm (Reg);
end if;
Info_Regs_Xmm (Reg) := (Num => Num, Stmt => Stmt, Used => True);
end Alloc_Xmm;
procedure Clobber_Xmm (Reg : Regs_Xmm) is
begin
if Info_Regs_Xmm (Reg).Num /= O_Free then
Spill_Xmm (Reg);
end if;
end Clobber_Xmm;
pragma Unreferenced (Clobber_Xmm);
function Alloc_Reg (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) return O_Reg
is
Best_Reg : O_Reg;
Best_Num : O_Inum;
begin
case Reg is
when Regs_R32 =>
Alloc_R32 (Reg, Stmt, Num);
return Reg;
when Regs_R64 =>
Alloc_R64 (Reg, Stmt, Num);
return Reg;
when R_St0 =>
Alloc_Fp (Stmt);
return Reg;
when Regs_Xmm =>
Alloc_Xmm (Reg, Stmt, Num);
return Reg;
when R_Any32 =>
Best_Num := O_Inum'Last;
Best_Reg := R_None;
for I in Regs_R32 loop
if I not in R_Sp .. R_Bp then
if Regs (I).Num = O_Free then
Alloc_R32 (I, Stmt, Num);
return I;
elsif Regs (I).Num <= Best_Num then
Best_Reg := I;
Best_Num := Regs (I).Num;
end if;
end if;
end loop;
Alloc_R32 (Best_Reg, Stmt, Num);
return Best_Reg;
when R_Any8 =>
Best_Num := O_Inum'Last;
Best_Reg := R_None;
for I in Regs_R8 loop
if Regs (I).Num = O_Free then
Alloc_R32 (I, Stmt, Num);
return I;
elsif Regs (I).Num <= Best_Num then
Best_Reg := I;
Best_Num := Regs (I).Num;
end if;
end loop;
Alloc_R32 (Best_Reg, Stmt, Num);
return Best_Reg;
when R_Any64 =>
declare
Rh, Rl : O_Reg;
begin
Best_Num := O_Inum'Last;
Best_Reg := R_None;
for I in Regs_R64 loop
Rh := Get_R64_High (I);
Rl := Get_R64_Low (I);
if Regs (Rh).Num = O_Free
and then Regs (Rl).Num = O_Free
then
Alloc_R64 (I, Stmt, Num);
return I;
elsif Regs (Rh).Num <= Best_Num
and Regs (Rl).Num <= Best_Num
then
Best_Reg := I;
Best_Num := O_Inum'Max (Regs (Rh).Num,
Regs (Rl).Num);
end if;
end loop;
Alloc_R64 (Best_Reg, Stmt, Num);
return Best_Reg;
end;
when R_Any_Xmm =>
Best_Num := O_Inum'Last;
Best_Reg := R_None;
for I in Regs_X86_Xmm loop
if Info_Regs_Xmm (I).Num = O_Free then
Alloc_Xmm (I, Stmt, Num);
return I;
elsif Info_Regs_Xmm (I).Num <= Best_Num then
Best_Reg := I;
Best_Num := Info_Regs_Xmm (I).Num;
end if;
end loop;
Alloc_Xmm (Best_Reg, Stmt, Num);
return Best_Reg;
when others =>
Error_Reg ("alloc_reg: unknown reg", O_Enode_Null, Reg);
raise Program_Error;
end case;
end Alloc_Reg;
function Gen_Reload (Spill : O_Enode; Reg : O_Reg; Num : O_Inum)
return O_Enode
is
N : O_Enode;
Mode : Mode_Type;
begin
-- Add a reload node.
Mode := Get_Expr_Mode (Spill);
N := New_Enode (OE_Reload, Mode, O_Tnode_Null, Spill, O_Enode_Null);
-- Note: this does not use a just-freed register, since
-- this case only occurs at the first call.
Set_Expr_Reg (N, Alloc_Reg (Reg, N, Num));
Link_Stmt (N);
return N;
end Gen_Reload;
function Reload (Expr : O_Enode; Dest : O_Reg; Num : O_Inum) return O_Enode
is
Reg : O_Reg;
Spill : O_Enode;
begin
Reg := Get_Expr_Reg (Expr);
case Reg is
when R_Spill =>
-- Restore the register between the statement and the spill.
Spill := Get_Stmt_Link (Expr);
Set_Expr_Reg (Expr, Get_Expr_Reg (Spill));
Set_Expr_Reg (Spill, R_Spill);
case Dest is
when R_Mem
| R_Irm
| R_Rm =>
return Spill;
when Regs_R32
| R_Any32
| Regs_R64
| R_Any64
| R_Any8 =>
return Gen_Reload (Spill, Dest, Num);
when R_Sib =>
return Gen_Reload (Spill, R_Any32, Num);
when R_Ir =>
return Gen_Reload (Spill, Get_Reg_Any (Expr), Num);
when others =>
Error_Reg ("reload: unhandled dest in spill", Expr, Dest);
end case;
when Regs_R32 =>
case Dest is
when R_Irm
| R_Rm
| R_Ir
| R_Any32
| R_Any8
| R_Sib =>
return Expr;
when Regs_R32 =>
if Dest = Reg then
return Expr;
end if;
Free_R32 (Reg);
Spill := Insert_Move (Expr, Dest);
Alloc_R32 (Dest, Spill, Num);
return Spill;
when others =>
Error_Reg ("reload: unhandled dest in R32", Expr, Dest);
end case;
when Regs_R64 =>
return Expr;
when R_St0 =>
return Expr;
when Regs_Xmm =>
return Expr;
when R_Mem =>
if Get_Expr_Kind (Expr) = OE_Indir then
Set_Expr_Operand (Expr,
Reload (Get_Expr_Operand (Expr), R_Sib, Num));
return Expr;
else
raise Program_Error;
end if;
when R_B_Off
| R_B_I
| R_I_Off
| R_Sib =>
case Get_Expr_Kind (Expr) is
when OE_Add =>
Set_Expr_Left
(Expr, Reload (Get_Expr_Left (Expr), R_Any32, Num));
Set_Expr_Right
(Expr, Reload (Get_Expr_Right (Expr), R_Any32, Num));
return Expr;
when OE_Addrl =>
Spill := Get_Addrl_Frame (Expr);
if Spill /= O_Enode_Null then
Set_Addrl_Frame (Expr, Reload (Spill, R_Any32, Num));
end if;
return Expr;
when others =>
Error_Reg ("reload: unhandle expr in b_off", Expr, Dest);
end case;
when R_I =>
Set_Expr_Left (Expr, Reload (Get_Expr_Left (Expr), R_Any32, Num));
return Expr;
when R_Imm =>
return Expr;
when others =>
Error_Reg ("reload: unhandled reg", Expr, Reg);
end case;
end Reload;
procedure Renum_Reg (Reg : O_Reg; Stmt : O_Enode; Num : O_Inum) is
begin
case Reg is
when Regs_R32 =>
Regs (Reg).Num := Num;
Regs (Reg).Stmt := Stmt;
when Regs_Cc =>
Reg_Cc.Num := Num;
Reg_Cc.Stmt := Stmt;
when R_St0 =>
null;
when Regs_R64 =>
declare
L, H : O_Reg;
begin
L := Get_R64_Low (Reg);
Regs (L).Num := Num;
Regs (L).Stmt := Stmt;
H := Get_R64_High (Reg);
Regs (H).Num := Num;
Regs (H).Stmt := Stmt;
end;
when others =>
Error_Reg ("renum_reg", Stmt, Reg);
end case;
end Renum_Reg;
procedure Free_Insn_Regs (Insn : O_Enode)
is
R : O_Reg;
begin
R := Get_Expr_Reg (Insn);
case R is
when R_Ax
| R_Bx
| R_Cx
| R_Dx
| R_Si
| R_Di =>
Free_R32 (R);
when R_Sp
| R_Bp =>
null;
when R_St0 =>
Free_Fp;
when Regs_Xmm =>
Free_Xmm (R);
when Regs_R64 =>
Free_R32 (Get_R64_High (R));
Free_R32 (Get_R64_Low (R));
when R_Mem =>
if Get_Expr_Kind (Insn) = OE_Indir then
Free_Insn_Regs (Get_Expr_Operand (Insn));
else
raise Program_Error;
end if;
when R_B_Off
| R_B_I
| R_I_Off
| R_Sib =>
case Get_Expr_Kind (Insn) is
when OE_Add =>
Free_Insn_Regs (Get_Expr_Left (Insn));
Free_Insn_Regs (Get_Expr_Right (Insn));
when OE_Addrl =>
if Get_Addrl_Frame (Insn) /= O_Enode_Null then
Free_Insn_Regs (Get_Addrl_Frame (Insn));
end if;
when others =>
raise Program_Error;
end case;
when R_I =>
Free_Insn_Regs (Get_Expr_Left (Insn));
when R_Imm =>
null;
when R_Spill =>
null;
when others =>
Error_Reg ("free_insn_regs: unknown reg", Insn, R);
end case;
end Free_Insn_Regs;
procedure Insert_Reg (Mode : Mode_Type)
is
N : O_Enode;
Num : O_Inum;
begin
Num := Get_Insn_Num;
N := New_Enode (OE_Reg, Mode, O_Tnode_Null,
O_Enode_Null, O_Enode_Null);
Set_Expr_Reg (N, Alloc_Reg (Get_Reg_Any (Mode), N, Num));
Link_Stmt (N);
Free_Insn_Regs (N);
end Insert_Reg;
procedure Insert_Arg (Expr : O_Enode)
is
N : O_Enode;
begin
Free_Insn_Regs (Expr);
N := New_Enode (OE_Arg, Get_Expr_Mode (Expr), O_Tnode_Null,
Expr, O_Enode_Null);
Set_Expr_Reg (N, R_None);
Link_Stmt (N);
end Insert_Arg;
function Insert_Intrinsic (Stmt : O_Enode; Reg : O_Reg; Num : O_Inum)
return O_Enode
is
N : O_Enode;
Op : Int32;
Mode : Mode_Type;
begin
Mode := Get_Expr_Mode (Stmt);
case Get_Expr_Kind (Stmt) is
when OE_Mul_Ov =>
case Mode is
when Mode_U64 =>
Op := Intrinsic_Mul_Ov_U64;
when Mode_I64 =>
Op := Intrinsic_Mul_Ov_I64;
when others =>
raise Program_Error;
end case;
when OE_Div_Ov =>
case Mode is
when Mode_U64 =>
Op := Intrinsic_Div_Ov_U64;
when Mode_I64 =>
Op := Intrinsic_Div_Ov_I64;
when others =>
raise Program_Error;
end case;
when OE_Mod =>
case Mode is
when Mode_U64 =>
Op := Intrinsic_Mod_Ov_U64;
when Mode_I64 =>
Op := Intrinsic_Mod_Ov_I64;
when others =>
raise Program_Error;
end case;
when OE_Rem =>
case Mode is
when Mode_U64 =>
-- For unsigned, MOD == REM.
Op := Intrinsic_Mod_Ov_U64;
when Mode_I64 =>
Op := Intrinsic_Rem_Ov_I64;
when others =>
raise Program_Error;
end case;
when others =>
raise Program_Error;
end case;
-- Save caller-saved registers.
Clobber_R32 (R_Ax);
Clobber_R32 (R_Dx);
Clobber_R32 (R_Cx);
N := New_Enode (OE_Intrinsic, Mode, O_Tnode_Null,
O_Enode (Op), O_Enode_Null);
Set_Expr_Reg (N, Alloc_Reg (Reg, N, Num));
Link_Stmt (N);
return N;
end Insert_Intrinsic;
-- REG is mandatory: the result of STMT must satisfy the REG constraint.
function Gen_Insn (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum)
return O_Enode;
function Gen_Conv_From_Fp_Insn (Stmt : O_Enode;
Reg : O_Reg;
Pnum : O_Inum)
return O_Enode
is
Num : O_Inum;
Left : O_Enode;
begin
Left := Get_Expr_Operand (Stmt);
Num := Get_Insn_Num;
Left := Gen_Insn (Left, R_St0, Num);
Free_Insn_Regs (Left);
Set_Expr_Operand (Stmt, Left);
case Reg is
when Regs_R32
| R_Any32
| Regs_R64
| R_Any64 =>
Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
when R_Rm
| R_Irm
| R_Ir =>
Set_Expr_Reg (Stmt, Alloc_Reg (Get_Reg_Any (Stmt), Stmt, Pnum));
when others =>
raise Program_Error;
end case;
Link_Stmt (Stmt);
return Stmt;
-- declare
-- Spill : O_Enode;
-- begin
-- Num := Get_Insn_Num;
-- Left := Gen_Insn (Left, R_St0, Num);
-- Set_Expr_Operand (Stmt, Left);
-- Set_Expr_Reg (Stmt, R_Spill);
-- Free_Insn_Regs (Left);
-- Link_Stmt (Stmt);
-- Spill := Insert_Spill (Stmt);
-- case Reg is
-- when R_Any32
-- | Regs_R32 =>
-- return Gen_Reload (Spill, Reg, Pnum);
-- when R_Ir =>
-- return Gen_Reload (Spill, R_Any32, Pnum);
-- when R_Rm
-- | R_Irm =>
-- return Spill;
-- when others =>
-- Error_Reg
-- ("gen_insn:oe_conv(fp)", Stmt, Reg);
-- end case;
-- end;
end Gen_Conv_From_Fp_Insn;
function Gen_Call (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum)
return O_Enode
is
use Interfaces;
Left : O_Enode;
Reg_Res : O_Reg;
Subprg : O_Dnode;
Push_Size : Uns32;
Pad : Uns32;
Res_Stmt : O_Enode;
begin
-- Emit Setup_Frame (to align stack).
Subprg := Get_Call_Subprg (Stmt);
Push_Size := Uns32 (Get_Subprg_Stack (Subprg));
-- Pad the stack if necessary.
Pad := (Push_Size + Push_Offset) and Uns32 (Flags.Stack_Boundary - 1);
if Pad /= 0 then
Pad := Uns32 (Flags.Stack_Boundary) - Pad;
Link_Stmt (New_Enode (OE_Stack_Adjust, Mode_Nil, O_Tnode_Null,
O_Enode (Pad), O_Enode_Null));
end if;
-- The stack has been adjusted by Pad bytes.
Push_Offset := Push_Offset + Pad;
-- Generate code for arguments (if any).
Left := Get_Arg_Link (Stmt);
if Left /= O_Enode_Null then
Left := Gen_Insn (Left, R_None, Pnum);
end if;
-- Clobber registers.
Clobber_R32 (R_Ax);
Clobber_R32 (R_Dx);
Clobber_R32 (R_Cx);
-- FIXME: fp regs.
-- Add the call.
Reg_Res := Get_Call_Register (Get_Expr_Mode (Stmt));
Set_Expr_Reg (Stmt, Reg_Res);
Link_Stmt (Stmt);
Res_Stmt := Stmt;
if Push_Size + Pad /= 0 then
Res_Stmt :=
New_Enode (OE_Stack_Adjust, Get_Expr_Mode (Stmt), O_Tnode_Null,
O_Enode (-Int32 (Push_Size + Pad)), O_Enode_Null);
Set_Expr_Reg (Res_Stmt, Reg_Res);
Link_Stmt (Res_Stmt);
end if;
-- The stack has been restored (just after the call).
Push_Offset := Push_Offset - (Push_Size + Pad);
case Reg is
when R_Any32
| R_Any64
| R_Any8
| R_Irm
| R_Rm
| R_Ir
| R_Sib
| R_Ax
| R_St0
| R_Edx_Eax =>
Reg_Res := Alloc_Reg (Reg_Res, Res_Stmt, Pnum);
return Res_Stmt;
when R_Any_Cc =>
-- Move to register.
-- (use the 'test' instruction).
Alloc_Cc (Res_Stmt, Pnum);
return Insert_Move (Res_Stmt, R_Ne);
when R_None =>
if Reg_Res /= R_None then
raise Program_Error;
end if;
return Res_Stmt;
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
end Gen_Call;
function Gen_Insn (Stmt : O_Enode; Reg : O_Reg; Pnum : O_Inum)
return O_Enode
is
Kind : OE_Kind;
Left : O_Enode;
Right : O_Enode;
Reg1 : O_Reg;
-- P_Reg : O_Reg;
Reg_L : O_Reg;
Reg_Res : O_Reg;
Num : O_Inum;
begin
Kind := Get_Expr_Kind (Stmt);
case Kind is
when OE_Addrl =>
Right := Get_Addrl_Frame (Stmt);
if Right /= O_Enode_Null then
Num := Get_Insn_Num;
Right := Gen_Insn (Right, R_Any32, Num);
Set_Addrl_Frame (Stmt, Right);
else
Num := O_Free;
end if;
case Reg is
when R_Sib =>
Set_Expr_Reg (Stmt, R_B_Off);
return Stmt;
when R_Irm
| R_Ir =>
if Right /= O_Enode_Null then
Free_Insn_Regs (Right);
end if;
Set_Expr_Reg (Stmt, Alloc_Reg (R_Any32, Stmt, Pnum));
Link_Stmt (Stmt);
return Stmt;
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
when OE_Addrg =>
case Reg is
when R_Sib
| R_Irm
| R_Ir =>
Set_Expr_Reg (Stmt, R_Imm);
return Stmt;
when R_Any32
| Regs_R32 =>
Set_Expr_Reg (Stmt, Reg);
Link_Stmt (Stmt);
return Stmt;
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
when OE_Indir =>
Left := Get_Expr_Operand (Stmt);
case Reg is
when R_Irm
| R_Rm =>
Left := Gen_Insn (Left, R_Sib, Pnum);
Set_Expr_Reg (Stmt, R_Mem);
Set_Expr_Operand (Stmt, Left);
when R_Ir
| R_Sib
| R_I_Off =>
Num := Get_Insn_Num;
Left := Gen_Insn (Left, R_Sib, Num);
Reg1 := Get_Reg_Any (Stmt);
if Reg1 = R_Any64 then
Reg1 := Alloc_Reg (Reg1, Stmt, Pnum);
Free_Insn_Regs (Left);
else
Free_Insn_Regs (Left);
Reg1 := Alloc_Reg (Reg1, Stmt, Pnum);
end if;
Set_Expr_Reg (Stmt, Reg1);
Set_Expr_Operand (Stmt, Left);
Link_Stmt (Stmt);
when Regs_R32
| R_Any32
| R_Any8
| Regs_Fp =>
Num := Get_Insn_Num;
Left := Gen_Insn (Left, R_Sib, Num);
Free_Insn_Regs (Left);
Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
Set_Expr_Operand (Stmt, Left);
Link_Stmt (Stmt);
when Regs_R64
| R_Any64 =>
-- Avoid overwritting:
-- Eg: axdx = indir (ax)
-- axdx = indir (ax+dx)
Num := Get_Insn_Num;
Left := Gen_Insn (Left, R_Sib, Num);
Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
Left := Reload (Left, R_Sib, Num);
Free_Insn_Regs (Left);
Set_Expr_Operand (Stmt, Left);
Link_Stmt (Stmt);
when R_Any_Cc =>
Num := Get_Insn_Num;
Left := Gen_Insn (Left, R_Sib, Num);
-- Generate a cmp $1, XX
Set_Expr_Reg (Stmt, R_Eq);
Set_Expr_Operand (Stmt, Left);
Free_Insn_Regs (Left);
Link_Stmt (Stmt);
Alloc_Cc (Stmt, Pnum);
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
return Stmt;
when OE_Conv_Ptr =>
-- Delete nops.
return Gen_Insn (Get_Expr_Operand (Stmt), Reg, Pnum);
when OE_Const =>
case Get_Expr_Mode (Stmt) is
when Mode_U8 .. Mode_U32
| Mode_I8 .. Mode_I32
| Mode_P32
| Mode_B2 =>
case Reg is
when R_Imm
| Regs_Imm32 =>
Set_Expr_Reg (Stmt, R_Imm);
when Regs_R32
| R_Any32
| R_Any8 =>
Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
Link_Stmt (Stmt);
when R_Rm =>
Set_Expr_Reg
(Stmt, Alloc_Reg (Get_Reg_Any (Stmt), Stmt, Pnum));
Link_Stmt (Stmt);
when R_Any_Cc =>
Num := Get_Insn_Num;
Set_Expr_Reg (Stmt, Alloc_Reg (R_Any8, Stmt, Num));
Link_Stmt (Stmt);
Free_Insn_Regs (Stmt);
Right := Insert_Move (Stmt, R_Ne);
Alloc_Cc (Right, Pnum);
return Right;
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
when Mode_F32
| Mode_F64 =>
case Reg is
when R_Ir
| R_Irm
| R_Rm
| R_St0 =>
Num := Get_Insn_Num;
if Reg = R_St0 or not Abi.Flag_Sse2 then
Reg1 := R_St0;
else
Reg1 := R_Any_Xmm;
end if;
Set_Expr_Reg (Stmt, Alloc_Reg (Reg1, Stmt, Num));
Link_Stmt (Stmt);
when others =>
raise Program_Error;
end case;
when Mode_U64
| Mode_I64 =>
case Reg is
when R_Irm
| R_Ir
| R_Rm =>
Set_Expr_Reg (Stmt, R_Imm);
when R_Mem =>
Set_Expr_Reg (Stmt, R_Mem);
when Regs_R64
| R_Any64 =>
Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
Link_Stmt (Stmt);
when others =>
raise Program_Error;
end case;
when others =>
raise Program_Error;
end case;
return Stmt;
when OE_Alloca =>
-- Roughly speaking, emited code is: (MASK is a constant).
-- VAL := (VAL + MASK) & ~MASK
-- SP := SP - VAL
-- res <- SP
Left := Get_Expr_Operand (Stmt);
case Reg is
when R_Ir
| R_Irm
| R_Any32 =>
Num := Get_Insn_Num;
if X86.Flags.Flag_Alloca_Call then
Reg_L := R_Ax;
else
Reg_L := R_Any32;
end if;
Left := Gen_Insn (Left, Reg_L, Num);
Set_Expr_Operand (Stmt, Left);
Link_Stmt (Left);
Free_Insn_Regs (Left);
Set_Expr_Reg (Stmt, Alloc_Reg (Reg_L, Stmt, Pnum));
Link_Stmt (Stmt);
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
return Stmt;
when OE_Kind_Cmp =>
-- Return LEFT cmp RIGHT, ie compute RIGHT - LEFT
Num := Get_Insn_Num;
Left := Get_Expr_Left (Stmt);
Reg_L := Get_Reg_Any (Left);
Left := Gen_Insn (Left, Reg_L, Num);
Right := Get_Expr_Right (Stmt);
case Get_Expr_Mode (Right) is
when Mode_F32
| Mode_F64 =>
Reg1 := R_St0;
when others =>
Reg1 := R_Irm;
end case;
Right := Gen_Insn (Right, Reg1, Num);
-- FIXME: what about if right was spilled out of FP regs ?
-- (it is reloaded in reverse).
Left := Reload (Left, Reg_L, Num);
Set_Expr_Right (Stmt, Right);
Set_Expr_Left (Stmt, Left);
Link_Stmt (Stmt);
Reg_Res := Ekind_To_Cc (Stmt, Get_Expr_Mode (Left));
case Get_Expr_Mode (Left) is
when Mode_F32
| Mode_F64 =>
Reg_Res := Reverse_Cc (Reg_Res);
when Mode_I64 =>
-- I64 is a little bit special...
Reg_Res := Get_R64_High (Get_Expr_Reg (Left));
if Reg_Res not in Regs_R8 then
Reg_Res := R_Nil;
for I in Regs_R8 loop
if Regs (I).Num = O_Free then
Reg_Res := I;
exit;
end if;
end loop;
if Reg_Res = R_Nil then
-- FIXME: to be handled.
-- Can this happen ?
raise Program_Error;
end if;
end if;
Free_Insn_Regs (Left);
Free_Insn_Regs (Right);
Set_Expr_Reg (Stmt, Reg_Res);
case Reg is
when R_Any_Cc =>
Right := Insert_Move (Stmt, R_Ne);
Alloc_Cc (Right, Pnum);
return Right;
when R_Any8
| Regs_R8
| R_Irm
| R_Ir
| R_Rm =>
Reg_Res := Alloc_Reg (Reg_Res, Stmt, Pnum);
return Stmt;
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
when others =>
null;
end case;
Set_Expr_Reg (Stmt, Reg_Res);
Free_Insn_Regs (Left);
Free_Insn_Regs (Right);
case Reg is
when R_Any_Cc =>
Alloc_Cc (Stmt, Pnum);
return Stmt;
when R_Any8
| Regs_R8 =>
Reg_Res := Alloc_Reg (Reg, Stmt, Pnum);
return Insert_Move (Stmt, Reg_Res);
when R_Irm
| R_Ir
| R_Rm =>
Reg_Res := Alloc_Reg (R_Any8, Stmt, Pnum);
return Insert_Move (Stmt, Reg_Res);
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
when OE_Add =>
declare
R_L : O_Reg;
R_R : O_Reg;
begin
Left := Gen_Insn (Get_Expr_Left (Stmt), R_Sib, Pnum);
Right := Gen_Insn (Get_Expr_Right (Stmt), R_Sib, Pnum);
Left := Reload (Left, R_Sib, Pnum);
Set_Expr_Right (Stmt, Right);
Set_Expr_Left (Stmt, Left);
R_L := Get_Expr_Reg (Left);
R_R := Get_Expr_Reg (Right);
-- Results can be: Reg, R_B_Off, R_Sib, R_Imm, R_B_I
case R_L is
when R_Any32
| Regs_R32 =>
case R_R is
when R_Imm =>
Set_Expr_Reg (Stmt, R_B_Off);
when R_B_Off
| R_I
| R_I_Off =>
Set_Expr_Reg (Stmt, R_Sib);
when R_Any32
| Regs_R32 =>
Set_Expr_Reg (Stmt, R_B_I);
when others =>
Error_Gen_Insn (Stmt, R_R);
end case;
when R_Imm =>
case R_R is
when R_Imm =>
Set_Expr_Reg (Stmt, R_Imm);
when R_Any32
| Regs_R32
| R_B_Off =>
Set_Expr_Reg (Stmt, R_B_Off);
when R_I
| R_I_Off =>
Set_Expr_Reg (Stmt, R_I_Off);
when others =>
Error_Gen_Insn (Stmt, R_R);
end case;
when R_B_Off =>
case R_R is
when R_Imm =>
Set_Expr_Reg (Stmt, R_B_Off);
when R_Any32
| Regs_R32
| R_I =>
Set_Expr_Reg (Stmt, R_Sib);
when others =>
Error_Gen_Insn (Stmt, R_R);
end case;
when R_I_Off =>
case R_R is
when R_Imm =>
Set_Expr_Reg (Stmt, R_I_Off);
when R_Any32
| Regs_R32 =>
Set_Expr_Reg (Stmt, R_Sib);
when others =>
Error_Gen_Insn (Stmt, R_R);
end case;
when R_I =>
case R_R is
when R_Imm
| Regs_R32
| R_B_Off =>
Set_Expr_Reg (Stmt, R_Sib);
when others =>
Error_Gen_Insn (Stmt, R_R);
end case;
when R_Sib
| R_B_I =>
if R_R = R_Imm then
Set_Expr_Reg (Stmt, R_Sib);
else
Num := Get_Insn_Num;
Free_Insn_Regs (Left);
Set_Expr_Reg (Left, Alloc_Reg (R_Any32, Left, Num));
Link_Stmt (Left);
case R_R is
when R_Any32
| Regs_R32
| R_I =>
Set_Expr_Reg (Stmt, R_B_I);
when others =>
Error_Gen_Insn (Stmt, R_R);
end case;
end if;
when others =>
Error_Gen_Insn (Stmt, R_L);
end case;
case Reg is
when R_Sib =>
null;
when R_Ir
| R_Irm =>
if Get_Expr_Reg (Stmt) /= R_Imm then
Set_Expr_Reg (Stmt, Alloc_Reg (R_Any32, Stmt, Pnum));
Free_Insn_Regs (Left);
Free_Insn_Regs (Right);
Link_Stmt (Stmt);
end if;
when R_Any32
| Regs_R32 =>
Set_Expr_Reg (Stmt, Alloc_Reg (Reg, Stmt, Pnum));
Link_Stmt (Stmt);
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
end;
return Stmt;
when OE_Mul =>
Num := Get_Insn_Num;
Left := Gen_Insn (Get_Expr_Left (Stmt), R_Ax, Num);
Set_Expr_Left (Stmt, Left);
Right := Gen_Insn (Get_Expr_Right (Stmt), R_Any32, Num);
if Get_Expr_Kind (Right) /= OE_Const then
raise Program_Error;
end if;
Set_Expr_Right (Stmt, Right);
Free_Insn_Regs (Left);
Free_Insn_Regs (Right);
Clobber_R32 (R_Dx);
Set_Expr_Reg (Stmt, Alloc_Reg (R_Ax, Stmt, Pnum));
case Reg is
when R_Sib
| R_B_Off =>
null;
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
Link_Stmt (Stmt);
return Stmt;
when OE_Shl =>
Num := Get_Insn_Num;
Right := Get_Expr_Right (Stmt);
if Get_Expr_Kind (Right) /= OE_Const then
Right := Gen_Insn (Right, R_Cx, Num);
else
Right := Gen_Insn (Right, R_Imm, Num);
end if;
Left := Get_Expr_Left (Stmt);
Reg1 := Get_Reg_Any (Stmt);
Left := Gen_Insn (Left, Reg1, Pnum);
if Get_Expr_Kind (Right) /= OE_Const then
Right := Reload (Right, R_Cx, Num);
end if;
Left := Reload (Left, Reg1, Pnum);
Set_Expr_Left (Stmt, Left);
Set_Expr_Right (Stmt, Right);
if Reg = R_Sib
and then Get_Expr_Kind (Right) = OE_Const
and then Get_Expr_Low (Right) in 0 .. 3
then
Set_Expr_Reg (Stmt, R_I);
else
Link_Stmt (Stmt);
Set_Expr_Reg (Stmt, Get_Expr_Reg (Left));
Free_Insn_Regs (Right);
end if;
return Stmt;
when OE_Add_Ov
| OE_Sub_Ov
| OE_And
| OE_Xor
| OE_Or =>
-- Accepted is: R with IMM or R/M
Num := Get_Insn_Num;
Right := Get_Expr_Right (Stmt);
Left := Get_Expr_Left (Stmt);
case Reg is
when R_Irm
| R_Rm
| R_Ir
| R_Sib =>
Right := Gen_Insn (Right, R_Irm, Num);
Reg1 := Get_Reg_Any (Stmt);
Left := Gen_Insn (Left, Reg1, Num);
Right := Reload (Right, R_Irm, Num);
Left := Reload (Left, Reg1, Num);
Reg_Res := Get_Expr_Reg (Left);
when R_Any_Cc =>
Right := Gen_Insn (Right, R_Irm, Num);
Left := Gen_Insn (Left, R_Any8, Num);
Reg_Res := R_Ne;
Alloc_Cc (Stmt, Num);
Free_Insn_Regs (Left);
when R_Any32
| Regs_R32
| R_Any8
| R_Any64
| Regs_R64
| Regs_Fp =>
Right := Gen_Insn (Right, R_Irm, Num);
Left := Gen_Insn (Left, Reg, Num);
Right := Reload (Right, R_Irm, Num);
Left := Reload (Left, Reg, Num);
Reg_Res := Get_Expr_Reg (Left);
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
Set_Expr_Right (Stmt, Right);
Set_Expr_Left (Stmt, Left);
Set_Expr_Reg (Stmt, Reg_Res);
Renum_Reg (Reg_Res, Stmt, Pnum);
Link_Stmt (Stmt);
Free_Insn_Regs (Right);
return Stmt;
when OE_Mod
| OE_Rem
| OE_Mul_Ov
| OE_Div_Ov =>
declare
Mode : Mode_Type;
begin
Num := Get_Insn_Num;
Mode := Get_Expr_Mode (Stmt);
Left := Get_Expr_Left (Stmt);
Right := Get_Expr_Right (Stmt);
case Mode is
when Mode_I32
| Mode_U32
| Mode_I16
| Mode_U16 =>
Left := Gen_Insn (Left, R_Ax, Num);
Right := Gen_Insn (Right, R_Rm, Num);
Left := Reload (Left, R_Ax, Num);
case Kind is
when OE_Div_Ov
| OE_Rem
| OE_Mod =>
-- Be sure EDX is free.
Reg_Res := Alloc_Reg (R_Dx, Stmt, Pnum);
when others =>
Reg_Res := R_Nil;
end case;
Right := Reload (Right, R_Rm, Num);
Set_Expr_Right (Stmt, Right);
Set_Expr_Left (Stmt, Left);
Free_Insn_Regs (Left);
Free_Insn_Regs (Right);
if Reg_Res /= R_Nil then
Free_R32 (Reg_Res);
end if;
if Kind = OE_Div_Ov or Kind = OE_Mul_Ov then
Reg_Res := R_Ax;
Clobber_R32 (R_Dx);
else
Reg_Res := R_Dx;
Clobber_R32 (R_Ax);
end if;
Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum));
Link_Stmt (Stmt);
return Reload (Stmt, Reg, Pnum);
when Mode_U64
| Mode_I64 =>
-- FIXME: align stack
Insert_Arg (Gen_Insn (Right, R_Irm, Num));
Insert_Arg (Gen_Insn (Left, R_Irm, Num));
return Insert_Intrinsic (Stmt, R_Edx_Eax, Pnum);
when Mode_F32
| Mode_F64 =>
Left := Gen_Insn (Left, R_St0, Num);
Right := Gen_Insn (Right, R_Rm, Num);
Set_Expr_Left (Stmt, Left);
Set_Expr_Right (Stmt, Right);
Free_Insn_Regs (Right);
Free_Insn_Regs (Left);
Set_Expr_Reg (Stmt, Alloc_Reg (R_St0, Stmt, Pnum));
Link_Stmt (Stmt);
return Stmt;
when others =>
Error_Gen_Insn (Stmt, Mode);
end case;
end;
when OE_Not
| OE_Abs_Ov
| OE_Neg_Ov =>
Left := Get_Expr_Operand (Stmt);
case Reg is
when R_Any32
| Regs_R32
| R_Any64
| Regs_R64
| R_Any8
| R_St0 =>
Reg_Res := Reg;
when R_Any_Cc =>
if Kind /= OE_Not then
raise Program_Error;
end if;
Left := Gen_Insn (Left, R_Any_Cc, Pnum);
Set_Expr_Operand (Stmt, Left);
Reg_Res := Inverse_Cc (Get_Expr_Reg (Left));
Free_Cc;
Set_Expr_Reg (Stmt, Reg_Res);
Alloc_Cc (Stmt, Pnum);
return Stmt;
when R_Irm
| R_Rm
| R_Ir =>
Reg_Res := Get_Reg_Any (Get_Expr_Mode (Left));
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
Left := Gen_Insn (Left, Reg_Res, Pnum);
Set_Expr_Operand (Stmt, Left);
Reg_Res := Get_Expr_Reg (Left);
Free_Insn_Regs (Left);
Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum));
Link_Stmt (Stmt);
return Stmt;
when OE_Conv =>
declare
O_Mode : Mode_Type; -- Operand mode
R_Mode : Mode_Type; -- Result mode
begin
Left := Get_Expr_Operand (Stmt);
O_Mode := Get_Expr_Mode (Left);
R_Mode := Get_Expr_Mode (Stmt);
-- Simple case: no conversion.
-- FIXME: should be handled by EXPR and convert to NOP.
if Get_Expr_Mode (Left) = Get_Expr_Mode (Stmt) then
-- A no-op.
return Gen_Insn (Left, Reg, Pnum);
end if;
case R_Mode is
when Mode_B2 =>
case O_Mode is
when Mode_U32
| Mode_I32 =>
-- Detect for bound.
null;
when others =>
Error_Gen_Insn (Stmt, O_Mode);
end case;
when Mode_U8 =>
case O_Mode is
when Mode_U16
| Mode_U32
| Mode_I32 =>
-- Detect for bound.
null;
when others =>
Error_Gen_Insn (Stmt, O_Mode);
end case;
when Mode_U32 =>
case O_Mode is
when Mode_I32 =>
-- Detect for bound.
null;
when Mode_B2
| Mode_U8
| Mode_U16 =>
-- Zero extend.
null;
when others =>
Error_Gen_Insn (Stmt, O_Mode);
end case;
when Mode_I32 =>
case O_Mode is
when Mode_U8
| Mode_I8
| Mode_B2
| Mode_U16
| Mode_U32 =>
-- Zero extend
-- Detect for bound (U32).
null;
when Mode_I64 =>
-- Detect for bound (U32)
Num := Get_Insn_Num;
Left := Gen_Insn (Left, R_Edx_Eax, Num);
Free_Insn_Regs (Left);
Set_Expr_Operand (Stmt, Left);
case Reg is
when R_Ax
| R_Any32
| R_Rm
| R_Irm
| R_Ir =>
Set_Expr_Reg
(Stmt, Alloc_Reg (R_Ax, Stmt, Num));
when others =>
raise Program_Error;
end case;
Insert_Reg (Mode_U32);
Link_Stmt (Stmt);
return Stmt;
when Mode_F64
| Mode_F32 =>
return Gen_Conv_From_Fp_Insn (Stmt, Reg, Pnum);
when others =>
Error_Gen_Insn (Stmt, O_Mode);
end case;
when Mode_I64 =>
case O_Mode is
when Mode_I32 =>
-- Sign extend.
Num := Get_Insn_Num;
Left := Gen_Insn (Left, R_Ax, Num);
Set_Expr_Operand (Stmt, Left);
Free_Insn_Regs (Left);
case Reg is
when R_Edx_Eax
| R_Any64
| R_Rm
| R_Irm
| R_Ir =>
Set_Expr_Reg
(Stmt, Alloc_Reg (R_Edx_Eax, Stmt, Pnum));
when others =>
raise Program_Error;
end case;
Link_Stmt (Stmt);
return Stmt;
when Mode_F64
| Mode_F32 =>
return Gen_Conv_From_Fp_Insn (Stmt, Reg, Pnum);
when others =>
Error_Gen_Insn (Stmt, O_Mode);
end case;
when Mode_F64 =>
case O_Mode is
when Mode_I32
| Mode_I64 =>
null;
when others =>
Error_Gen_Insn (Stmt, O_Mode);
end case;
when others =>
Error_Gen_Insn (Stmt, O_Mode);
end case;
Left := Gen_Insn (Left, R_Rm, Pnum);
Set_Expr_Operand (Stmt, Left);
case Reg is
when R_Irm
| R_Rm
| R_Ir
| R_Sib
| R_Any32
| Regs_R32
| R_Any64
| R_Any8
| Regs_R64
| Regs_Fp =>
Free_Insn_Regs (Left);
Set_Expr_Reg
(Stmt, Alloc_Reg (Get_Reg_Any (Stmt), Stmt, Pnum));
when others =>
Error_Gen_Insn (Stmt, Reg);
end case;
Link_Stmt (Stmt);
return Stmt;
end;
when OE_Arg =>
if Reg /= R_None then
raise Program_Error;
end if;
Left := Get_Arg_Link (Stmt);
if Left /= O_Enode_Null then
-- Recurse on next argument, so the first argument is pushed
-- the last one.
Left := Gen_Insn (Left, R_None, Pnum);
end if;
Left := Get_Expr_Operand (Stmt);
case Get_Expr_Mode (Left) is
when Mode_F32 .. Mode_F64 =>
-- fstp instruction.
Reg_Res := R_St0;
when others =>
-- Push instruction.
Reg_Res := R_Irm;
end case;
Left := Gen_Insn (Left, Reg_Res, Pnum);
Set_Expr_Operand (Stmt, Left);
Push_Offset := Push_Offset +
Do_Align (Get_Mode_Size (Get_Expr_Mode (Left)), Mode_U32);
Link_Stmt (Stmt);
Free_Insn_Regs (Left);
return Stmt;
when OE_Call =>
return Gen_Call (Stmt, Reg, Pnum);
when OE_Case_Expr =>
Left := Get_Expr_Operand (Stmt);
Set_Expr_Reg (Stmt, Alloc_Reg (Get_Expr_Reg (Left), Stmt, Pnum));
return Stmt;
when OE_Get_Stack =>
Set_Expr_Reg (Stmt, R_Sp);
return Stmt;
when OE_Get_Frame =>
Set_Expr_Reg (Stmt, R_Bp);
return Stmt;
when others =>
Ada.Text_IO.Put_Line
("gen_insn: unhandled enode " & OE_Kind'Image (Kind));
raise Program_Error;
end case;
end Gen_Insn;
procedure Assert_Free_Regs (Stmt : O_Enode) is
begin
for I in Regs_R32 loop
if Regs (I).Num /= O_Free then
Error_Reg ("gen_insn_stmt: reg is not free", Stmt, I);
end if;
end loop;
for I in Fp_Stack_Type loop
if Fp_Regs (I).Stmt /= O_Enode_Null then
Error_Reg ("gen_insn_stmt: reg is not free", Stmt, R_St0);
end if;
end loop;
end Assert_Free_Regs;
procedure Gen_Insn_Stmt (Stmt : O_Enode)
is
Kind : OE_Kind;
Left : O_Enode;
Right : O_Enode;
P_Reg : O_Reg;
Num : O_Inum;
Prev_Stack_Offset : Uns32;
begin
Insn_Num := O_Iroot;
Num := Get_Insn_Num;
Prev_Stack_Offset := Stack_Offset;
Kind := Get_Expr_Kind (Stmt);
case Kind is
when OE_Asgn =>
Left := Gen_Insn (Get_Expr_Operand (Stmt), R_Ir, Num);
Right := Gen_Insn (Get_Assign_Target (Stmt), R_Sib, Num);
Left := Reload (Left, R_Ir, Num);
--Right := Reload (Right, R_Sib, Num);
Set_Expr_Operand (Stmt, Left);
Set_Assign_Target (Stmt, Right);
Link_Stmt (Stmt);
Free_Insn_Regs (Left);
Free_Insn_Regs (Right);
when OE_Set_Stack =>
Left := Gen_Insn (Get_Expr_Operand (Stmt), R_Rm, Num);
Set_Expr_Operand (Stmt, Left);
Set_Expr_Reg (Stmt, R_Sp);
Link_Stmt (Stmt);
when OE_Jump_F
| OE_Jump_T =>
Left := Gen_Insn (Get_Expr_Operand (Stmt), R_Any_Cc, Num);
Set_Expr_Operand (Stmt, Left);
Link_Stmt (Stmt);
Free_Cc;
when OE_Beg =>
declare
Block_Decl : O_Dnode;
begin
Cur_Block := Stmt;
Block_Decl := Get_Block_Decls (Cur_Block);
Set_Block_Max_Stack (Block_Decl, Stack_Offset);
Expand_Decls (Block_Decl);
end;
Link_Stmt (Stmt);
when OE_End =>
Swap_Stack_Offset (Get_Block_Decls (Cur_Block));
Cur_Block := Get_Block_Parent (Cur_Block);
Link_Stmt (Stmt);
when OE_Jump
| OE_Label =>
Link_Stmt (Stmt);
when OE_Leave =>
Link_Stmt (Stmt);
when OE_Call =>
Link_Stmt (Gen_Call (Stmt, R_None, Num));
when OE_Ret =>
Left := Get_Expr_Operand (Stmt);
P_Reg := Get_Call_Register (Get_Expr_Mode (Stmt));
Left := Gen_Insn (Left, P_Reg, Num);
Set_Expr_Operand (Stmt, Left);
Link_Stmt (Stmt);
Free_Insn_Regs (Left);
when OE_Case =>
Left := Gen_Insn (Get_Expr_Operand (Stmt),
Get_Reg_Any (Get_Expr_Mode (Stmt)),
Num);
Set_Expr_Operand (Stmt, Left);
Set_Expr_Reg (Stmt, Get_Expr_Reg (Left));
Link_Stmt (Stmt);
Free_Insn_Regs (Left);
when OE_Line =>
Set_Expr_Reg (Stmt, R_None);
Link_Stmt (Stmt);
when OE_BB =>
-- Keep BB.
Link_Stmt (Stmt);
when others =>
Ada.Text_IO.Put_Line
("gen_insn_stmt: unhandled enode " & OE_Kind'Image (Kind));
raise Program_Error;
end case;
-- Free any spill stack slots.
case Kind is
when OE_Beg
| OE_End =>
null;
when others =>
Stack_Offset := Prev_Stack_Offset;
end case;
-- Check all registers are free.
if Debug.Flag_Debug_Assert then
Assert_Free_Regs (Stmt);
end if;
end Gen_Insn_Stmt;
procedure Gen_Subprg_Insns (Subprg : Subprogram_Data_Acc)
is
First : O_Enode;
Stmt : O_Enode;
N_Stmt : O_Enode;
begin
if Debug.Flag_Debug_Insn then
declare
Inter : O_Dnode;
begin
Disp_Decl (1, Subprg.D_Decl);
Inter := Get_Subprg_Interfaces (Subprg.D_Decl);
while Inter /= O_Dnode_Null loop
Disp_Decl (2, Inter);
Inter := Get_Interface_Chain (Inter);
end loop;
end;
end if;
for I in Regs_R32 loop
Regs (I).Used := False;
end loop;
Stack_Max := 0;
Stack_Offset := 0;
First := Subprg.E_Entry;
Expand_Decls (Subprg.D_Body + 1);
Abi.Last_Link := First;
-- Generate instructions.
-- Skip OE_Entry.
Stmt := Get_Stmt_Link (First);
loop
N_Stmt := Get_Stmt_Link (Stmt);
Gen_Insn_Stmt (Stmt);
exit when Get_Expr_Kind (Stmt) = OE_Leave;
Stmt := N_Stmt;
end loop;
-- Keep stack depth for this subprogram.
Subprg.Stack_Max := Stack_Max;
-- Sanity check: there must be no remaining pushed bytes.
if Push_Offset /= 0 then
raise Program_Error with "gen_subprg_insn: push_offset not 0";
end if;
end Gen_Subprg_Insns;
end Ortho_Code.X86.Insns;