path: root/ortho/mcode/ortho_code-x86-insns.adb

--  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;
                     else
                        Reg_Res := R_Dx;
                     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);
                  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;      --  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;