-- 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 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; 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 => return R_St0; 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; -- STMT is an OE_END statement. -- Swap Stack_Offset with Max_Stack of STMT. procedure Swap_Stack_Offset (Blk : O_Dnode) is use Ortho_Code.Decls; 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 => 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; 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 => return R_St0; 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 : 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; function Reg_Used (Reg : Regs_R32) return Boolean is begin return Regs (Reg).Used; end Reg_Used; procedure Dump_Reg_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_Reg_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_Reg_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; 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); 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 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; procedure Spill_R32 (Reg : Regs_R32) is N : O_Enode; Orig : O_Enode; Mode : Mode_Type; Reg_Orig : O_Reg; begin Orig := Regs (Reg).Stmt; if Orig = O_Enode_Null then -- This register was not allocated. raise Program_Error; end if; -- 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); -- 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; 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 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 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); return Insert_Move (Expr, Alloc_Reg (Dest, Expr, Num)); when others => Error_Reg ("reload: unhandled dest in R32", Expr, Dest); end case; when Regs_R64 => return Expr; when R_St0 => 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_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; 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_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; Set_Expr_Reg (Stmt, Alloc_Reg (R_St0, 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; Left := Gen_Insn (Left, R_Any32, Num); Set_Expr_Operand (Stmt, Left); Link_Stmt (Left); Free_Insn_Regs (Left); Set_Expr_Reg (Stmt, Alloc_Reg (R_Any32, 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; else Reg_Res := R_Dx; end if; Set_Expr_Reg (Stmt, Alloc_Reg (Reg_Res, Stmt, Pnum)); Link_Stmt (Stmt); return Stmt; when Mode_U64 | Mode_I64 => 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); Set_Expr_Reg (Stmt, Inverse_Cc (Get_Expr_Reg (Left))); 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); Set_Expr_Reg (Stmt, Get_Expr_Reg (Left)); Link_Stmt (Stmt); return Stmt; when OE_Conv => declare O_Mode : Mode_Type; R_Mode : Mode_Type; 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_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 -- Previous argument. 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); Link_Stmt (Stmt); Free_Insn_Regs (Left); return Stmt; when OE_Call => Left := Get_Arg_Link (Stmt); if Left /= O_Enode_Null then -- Generate code for arguments. 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. Reg_Res := Get_Call_Register (Get_Expr_Mode (Stmt)); Set_Expr_Reg (Stmt, Reg_Res); Link_Stmt (Stmt); 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, Stmt, Pnum); return Stmt; when R_Any_Cc => -- Move to register. -- (use the 'test' instruction). Alloc_Cc (Stmt, Pnum); return Insert_Move (Stmt, R_Ne); when R_None => if Reg_Res /= R_None then raise Program_Error; end if; return Stmt; when others => Error_Gen_Insn (Stmt, Reg); end case; 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 => Left := Get_Arg_Link (Stmt); if Left /= O_Enode_Null then -- Generate code for arguments. Left := Gen_Insn (Left, R_None, Num); end if; Set_Expr_Reg (Stmt, R_None); Link_Stmt (Stmt); 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; Last : 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); Last := Get_Entry_Leave (First); 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; Subprg.Stack_Max := Stack_Max; end Gen_Subprg_Insns; end Ortho_Code.X86.Insns;