ocaml/asmcomp/emit_i386.mlp

(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
(*                                                                     *)
(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
(*  Automatique.  Distributed only by permission.                      *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

(* Emission of Intel 386 assembly code *)

open Misc
open Cmm
open Arch
open Proc
open Reg
open Mach
open Linearize
open Emitaux

(* Tradeoff between code size and code speed *)

let fastcode_flag = ref true

let stack_offset = ref 0

(* Layout of the stack frame *)

let frame_size () =                     (* includes return address *)
  !stack_offset + 4 * num_stack_slots.(0) + 8 * num_stack_slots.(1) + 4

let slot_offset loc cl =
  match loc with
    Incoming n -> frame_size() + n
  | Local n ->
      if cl = 0
      then !stack_offset + n * 4
      else !stack_offset + num_stack_slots.(0) * 4 + n * 8
  | Outgoing n -> n

(* Symbols are prefixed with _, except under Linux with ELF binaries *)

let symbol_prefix =
  match Config.system with
    "linux_elf" -> ""
  | _ -> "_"

let emit_symbol s =
  emit_string symbol_prefix; Emitaux.emit_symbol '$' s

(* Output a label *)

let label_prefix =
  match Config.system with
    "linux_elf" -> ".L"
  | _ -> "L"

let emit_label lbl =
  emit_string label_prefix; emit_int lbl

(* Output a .align directive.
   The numerical argument to .align is log2 of alignment size, except
   under ELF, where it is the alignment size... *)

let emit_align =
  match Config.system with
    "linux_elf" -> (fun n -> `	.align	{emit_int n}\n`)
  | _           -> (fun n -> `	.align	{emit_int(Misc.log2 n)}\n`)
  
(* Track the position of the floating-point stack *)

let fp_offset = ref 0

let push_fp () =
  incr fp_offset;
  if !fp_offset > 4 then fatal_error "Emit: float expression too complex"

let pop_fp () =
  decr fp_offset

(* Output a pseudo-register *)

let emit_reg = function
    { loc = Reg r; typ = Float } ->
      emit_string (register_name(r + !fp_offset))
  | { loc = Reg r } ->
      emit_string (register_name r)
  | { loc = Stack s } as r ->
      let ofs = slot_offset s (register_class r) in
      `{emit_int ofs}(%esp)`
  | { loc = Unknown } ->
      fatal_error "Emit_i386.emit_reg"

(* Output a reference to the lower 8 bits or lower 16 bits of a register *)

let reg_low_byte_name = [| "%al"; "%bl"; "%cl"; "%dl" |]
let reg_low_half_name = [| "%ax"; "%bx"; "%cx"; "%dx"; "%si"; "%di"; "%bp" |]

let emit_reg8 r =
  match r.loc with
    Reg r when r < 4 -> emit_string (reg_low_byte_name.(r))
  | _ -> fatal_error "Emit_i386.emit_reg8"

let emit_reg16 r =
  match r.loc with
    Reg r when r < 7 -> emit_string (reg_low_half_name.(r))
  | _ -> fatal_error "Emit_i386.emit_reg16"

(* Check if the given register overlaps (same location) with the given
   array of registers *)

let register_overlap reg arr =
  try
    for i = 0 to Array.length arr - 1 do
      if reg.loc = arr.(i).loc then raise Exit
    done;
    false
  with Exit ->
    true

(* Check if a set of registers contains a float *)

let contains_floats arr =
  try
    for i = 0 to Array.length arr - 1 do
      if arr.(i).typ = Float then raise Exit
    done;
    false
  with Exit ->
    true

(* Output an addressing mode *)

let emit_addressing addr r n =
  match addr with
    Ibased(s, d) ->
      `{emit_symbol s}`;
      if d <> 0 then ` + {emit_int d}`
  | Iindexed d ->
      if d <> 0 then emit_int d;
      `({emit_reg r.(n)})`
  | Iindexed2 d ->
      if d <> 0 then emit_int d;
      `({emit_reg r.(n)}, {emit_reg r.(n+1)})`
  | Iscaled(scale, d) ->
      if d <> 0 then emit_int d;
      `(, {emit_reg r.(n)}, {emit_int scale})`
  | Iindexed2scaled(scale, d) ->
      if d <> 0 then emit_int d;
      `({emit_reg r.(n)}, {emit_reg r.(n+1)}, {emit_int scale})`

(* Emit the operand of a floating-point operation *)

let emit_float_operand r =
  match r.loc with
    Stack s -> `l	{emit_reg r}`
  | _       -> `	{emit_reg r}` 

(* Record live pointers at call points *)

type frame_descr =
  { fd_lbl: int;                        (* Return address *)
    fd_frame_size: int;                 (* Size of stack frame *)
    fd_live_offset: int list }          (* Offsets/regs of live addresses *)

let frame_descriptors = ref([] : frame_descr list)

let record_frame_label live =
  let lbl = new_label() in
  let live_offset = ref [] in
  Reg.Set.iter
    (function
        {typ = Addr; loc = Reg r} ->
          live_offset := ((r lsl 1) + 1) :: !live_offset
      | {typ = Addr; loc = Stack s} as reg ->
          live_offset := slot_offset s (register_class reg) :: !live_offset
      | _ -> ())
    live;
  frame_descriptors :=
    { fd_lbl = lbl;
      fd_frame_size = frame_size();
      fd_live_offset = !live_offset } :: !frame_descriptors;
  lbl

let record_frame live =
  let lbl = record_frame_label live in `{emit_label lbl}:`

let emit_frame fd =
  `	.long	{emit_label fd.fd_lbl}\n`;
  `	.word	{emit_int fd.fd_frame_size}\n`;
  `	.word	{emit_int (List.length fd.fd_live_offset)}\n`;
  List.iter
    (fun n ->
      `	.word	{emit_int n}\n`)
    fd.fd_live_offset;
  emit_align 4

(* Record calls to the GC -- we've moved them out of the way *)

type gc_call =
  { gc_lbl: label;                      (* Entry label *)
    gc_return_lbl: label;               (* Where to branch after GC *)
    gc_frame: label }                   (* Label of frame descriptor *)

let call_gc_sites = ref ([] : gc_call list)

let emit_call_gc gc =
  `{emit_label gc.gc_lbl}:	call	{emit_symbol "caml_call_gc"}\n`;
  `{emit_label gc.gc_frame}:	jmp	{emit_label gc.gc_return_lbl}\n`

(* Names for instructions *)

let instr_for_intop = function
    Iadd -> "addl"
  | Isub -> "subl"
  | Imul -> "imull"
  | Iand -> "andl"
  | Ior -> "orl"
  | Ixor -> "xorl"
  | Ilsl -> "sall"
  | Ilsr -> "shrl"
  | Iasr -> "sarl"
  | _ -> fatal_error "Emit_i386: instr_for_intop"

let instr_for_floatop = function
    Inegf -> "fchs"
  | Iabsf -> "fabs"
  | Iaddf -> "fadd"
  | Isubf -> "fsub"
  | Imulf -> "fmul"
  | Idivf -> "fdiv"
  | Ispecific Isubfrev -> "fsubr"
  | Ispecific Idivfrev -> "fdivr"
  | _ -> fatal_error "Emit_i386: instr_for_floatop"

let instr_for_floatop_reversed = function
    Iaddf -> "fadd"
  | Isubf -> "fsubr"
  | Imulf -> "fmul"
  | Idivf -> "fdivr"
  | Ispecific Isubfrev -> "fsub"
  | Ispecific Idivfrev -> "fdiv"
  | _ -> fatal_error "Emit_i386: instr_for_floatop_reversed"

let instr_for_floatop_pop = function
    Iaddf -> "faddp"
  | Isubf -> "fsubp"
  | Imulf -> "fmulp"
  | Idivf -> "fdivp"
  | Ispecific Isubfrev -> "fsubrp"
  | Ispecific Idivfrev -> "fdivrp"
  | _ -> fatal_error "Emit_i386: instr_for_floatop_pop"

let instr_for_floatarithmem = function
    Ifloatadd -> "faddl"
  | Ifloatsub -> "fsubl"
  | Ifloatsubrev -> "fsubrl"
  | Ifloatmul -> "fmull"
  | Ifloatdiv -> "fdivl"
  | Ifloatdivrev -> "fdivrl"

let name_for_cond_branch = function
    Isigned Ceq -> "e"     | Isigned Cne -> "ne"
  | Isigned Cle -> "le"     | Isigned Cgt -> "g"
  | Isigned Clt -> "l"     | Isigned Cge -> "ge"
  | Iunsigned Ceq -> "e"   | Iunsigned Cne -> "ne"
  | Iunsigned Cle -> "be"  | Iunsigned Cgt -> "a"
  | Iunsigned Clt -> "b"  | Iunsigned Cge -> "ae"
    
(* Output an = 0 or <> 0 test. *)

let output_test_zero arg =
  match arg.loc with
    Reg r -> `	testl	{emit_reg arg}, {emit_reg arg}\n`
  | _     -> `	cmpl	$0, {emit_reg arg}\n`

(* Deallocate the stack frame before a return or tail call *)

let output_epilogue () =
  let n = frame_size() - 4 in
  if n > 0 then `	addl	${emit_int n}, %esp\n`

(* Output the assembly code for an instruction *)

(* Name of current function *)
let function_name = ref ""
(* Entry point for tail recursive calls *)
let tailrec_entry_point = ref 0
(* Label of trap for out-of-range accesses *)
let range_check_trap = ref 0

let float_constants = ref ([] : (int * string) list)

let emit_instr i =
    match i.desc with
      Lend -> ()
    | Lop(Imove | Ispill | Ireload) ->
        if i.arg.(0).loc <> i.res.(0).loc then begin
          match i.arg.(0).typ with
            Int | Addr ->
              `	movl	{emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`
          | Float ->
              begin match i.arg.(0).loc with
                Reg 100 ->              (* top of FP stack *)
                  `	fstpl	{emit_reg i.res.(0)}\n`;
                  pop_fp()
              | Reg 101 when !fp_offset = 0 -> (* %st(0) *)
                  `	fstl	{emit_reg i.res.(0)}\n`
              | _ ->
                  `	fldl	{emit_reg i.arg.(0)}\n`;
                  push_fp();
                  `	fstpl	{emit_reg i.res.(0)}\n`;
                  pop_fp()
              end
        end
    | Lop(Iconst_int 0) ->
        begin match i.res.(0).loc with
          Reg n -> `	xorl	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
        | _     -> `	movl	$0, {emit_reg i.res.(0)}\n`
        end
    | Lop(Iconst_int n) ->
        `	movl	${emit_int n}, {emit_reg i.res.(0)}\n`
    | Lop(Iconst_float s) ->
        let f = float_of_string s in
        if f = 0.0 then
          `	fldz\n`
        else if f = 1.0 then
          `	fld1\n`
        else begin
          let lbl = new_label() in
          float_constants := (lbl, s) :: !float_constants;
          `	fldl	{emit_label lbl}\n`
        end;
        push_fp()
    | Lop(Iconst_symbol s) ->
        `	movl	${emit_symbol s}, {emit_reg i.res.(0)}\n`
    | Lop(Icall_ind) ->
        `	call	*{emit_reg i.arg.(0)}\n`;
        record_frame i.live
    | Lop(Icall_imm s) ->
        `	call	{emit_symbol s}\n`;
        record_frame i.live
    | Lop(Itailcall_ind) ->
        output_epilogue();
        `	jmp	*{emit_reg i.arg.(0)}\n`
    | Lop(Itailcall_imm s) ->
        if s = !function_name then
          `	jmp	{emit_label !tailrec_entry_point}\n`
        else begin
          output_epilogue();
          `	jmp	{emit_symbol s}\n`
        end
    | Lop(Iextcall(s, alloc)) ->
        if alloc then begin
          `	movl	${emit_symbol s}, %eax\n`;
          `	call	{emit_symbol "caml_c_call"}\n`;
          record_frame i.live
        end else begin
          if contains_floats i.arg or contains_floats i.res then begin
            `	ffree	%st(0)\n`;
            `	ffree	%st(1)\n`;
            `	ffree	%st(2)\n`;
            `	ffree	%st(3)\n`
          end;
          `	call	{emit_symbol s}\n`
        end
    | Lop(Istackoffset n) ->
        if n >= 0
        then `	subl	${emit_int n}, %esp\n`
        else `	addl	${emit_int(-n)}, %esp\n`;
        stack_offset := !stack_offset + n
    | Lop(Iload(chunk, addr)) ->
        let dest = i.res.(0) in
        begin match dest.typ with
          Int | Addr ->
            begin match (chunk, dest.loc) with
              (Word, _) ->
                `	movl	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
            | (Byte_unsigned, Reg r) when r < 4 & not (register_overlap dest i.arg) ->
                `	xorl	{emit_reg dest}, {emit_reg dest}\n`;
                `	movb	{emit_addressing addr i.arg 0}, {emit_reg8 dest}\n`
            | (Byte_unsigned, _) ->
                `	movzbl	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
            | (Byte_signed, _) ->
                `	movsbl	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
            | (Sixteen_unsigned, Reg r) when not (register_overlap dest i.arg) ->
                `	xorl	{emit_reg dest}, {emit_reg dest}\n`;
                `	movw	{emit_addressing addr i.arg 0}, {emit_reg16 dest}\n`
            | (Sixteen_unsigned, _) ->
                `	movzwl	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
            | (Sixteen_signed, _) ->
                `	movswl	{emit_addressing addr i.arg 0}, {emit_reg dest}\n`
            end
        | Float ->
            `	fldl	{emit_addressing addr i.arg 0}\n`;
            push_fp()
        end
    | Lop(Istore(Word, addr)) ->
        begin match i.arg.(0).typ with
          Int | Addr ->
            `	movl	{emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
        | Float ->
            begin match i.arg.(0).loc with
              Reg 100 ->                (* top of FP stack *)
                `	fstpl	{emit_addressing addr i.arg 1}\n`;
                pop_fp()
            | Reg 101 when !fp_offset = 0 -> (* %st(0) *)
                `	fstl	{emit_addressing addr i.arg 1}\n`
            | _ ->
                `	fldl	{emit_reg i.arg.(0)}\n`;
                `	fstpl	{emit_addressing addr i.arg 1}\n`
            end
        end
    | Lop(Istore(chunk, addr)) ->
        (* i.arg.(0) is guaranteed to be in %edx, actually *)
        begin match chunk with
          Word -> fatal_error "Emit_i386: store word"
        | Byte_unsigned | Byte_signed ->
            `	movb	{emit_reg8 i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
        | Sixteen_unsigned | Sixteen_signed ->
            `	movw	{emit_reg16 i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
        end
    | Lop(Ialloc n) ->
        if !fastcode_flag then begin
          let lbl_redo = new_label() in
          `{emit_label lbl_redo}:	movl	{emit_symbol "young_ptr"}, %eax\n`;
          `	subl	${emit_int n}, %eax\n`;
          `	movl	%eax, {emit_symbol "young_ptr"}\n`;
          `	cmpl	{emit_symbol "young_limit"}, %eax\n`;
          let lbl_call_gc = new_label() in
          let lbl_frame = record_frame_label i.live in
          `	jb	{emit_label lbl_call_gc}\n`;
          `	leal	4(%eax), {emit_reg i.res.(0)}\n`;
          call_gc_sites :=
            { gc_lbl = lbl_call_gc;
              gc_return_lbl = lbl_redo;
              gc_frame = lbl_frame } :: !call_gc_sites
        end else begin
          begin match n with
            8  -> `	call	{emit_symbol "caml_alloc1"}\n`
          | 12 -> `	call	{emit_symbol "caml_alloc2"}\n`
          | 16 -> `	call	{emit_symbol "caml_alloc3"}\n`
          | _  -> `	movl	${emit_int n}, %eax\n`;
                  `	call	{emit_symbol "caml_alloc"}\n`
          end;
          `{record_frame i.live}	leal	4(%eax), {emit_reg i.res.(0)}\n`
        end
    | Lop(Iintop(Icomp cmp)) ->
        `	cmpl	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
        let b = name_for_cond_branch cmp in
        `	set{emit_string b}	%al\n`;
        `	movzbl	%al, {emit_reg i.res.(0)}\n`
    | Lop(Iintop_imm(Icomp cmp, n)) ->
        `	cmpl	${emit_int n}, {emit_reg i.arg.(0)}\n`;
        let b = name_for_cond_branch cmp in
        `	set{emit_string b}	%al\n`;
        `	movzbl	%al, {emit_reg i.res.(0)}\n`
    | Lop(Iintop Icheckbound) ->
        if !range_check_trap = 0 then range_check_trap := new_label();
        `	cmpl	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
        `	jbe	{emit_label !range_check_trap}\n`
    | Lop(Iintop_imm(Icheckbound, n)) ->
        if !range_check_trap = 0 then range_check_trap := new_label();
        `	cmpl	${emit_int n}, {emit_reg i.arg.(0)}\n`;
        `	jbe	{emit_label !range_check_trap}\n`
    | Lop(Iintop(Idiv | Imod)) ->
        `	cltd\n`;
        `	idivl	{emit_reg i.arg.(1)}\n`
    | Lop(Iintop(Ilsl | Ilsr | Iasr as op)) ->
        (* We have i.arg.(0) = i.res.(0) and i.arg.(1) = %ecx *)
        `	{emit_string(instr_for_intop op)}	%cl, {emit_reg i.res.(0)}\n`
    | Lop(Iintop op) ->
        (* We have i.arg.(0) = i.res.(0) *)
        `	{emit_string(instr_for_intop op)}	{emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
    | Lop(Iintop_imm(Iadd, 1) | Iintop_imm(Isub, -1)) ->
        `	incl	{emit_reg i.res.(0)}\n`
    | Lop(Iintop_imm(Iadd, -1) | Iintop_imm(Isub, 1)) ->
        `	decl	{emit_reg i.res.(0)}\n`
    | Lop(Iintop_imm(Idiv, n)) ->
        let l = Misc.log2 n in
        let lbl = new_label() in
        output_test_zero i.arg.(0);
        `	jge	{emit_label lbl}\n`;
        `	addl	${emit_int(n-1)}, {emit_reg i.arg.(0)}\n`;
        `{emit_label lbl}:	sarl	${emit_int l}, {emit_reg i.arg.(0)}\n`
    | Lop(Iintop_imm(Imod, n)) ->
        let l = Misc.log2 n in
        let lbl = new_label() in
        `	movl	{emit_reg i.arg.(0)}, %eax\n`;
        `	testl	%eax, %eax\n`;
        `	jge	{emit_label lbl}\n`;
        `	addl	${emit_int(n-1)}, %eax\n`;
        `{emit_label lbl}:	andl	${emit_int(-n)}, %eax\n`;
        `	subl	%eax, {emit_reg i.arg.(0)}\n`
    | Lop(Iintop_imm(op, n)) ->
        (* We have i.arg.(0) = i.res.(0) *)
        `	{emit_string(instr_for_intop op)}	${emit_int n}, {emit_reg i.res.(0)}\n`
    | Lop(Inegf | Iabsf as floatop) ->
        if i.arg.(0).loc <> Reg 100 then begin
          `	fldl	{emit_reg i.arg.(0)}\n`;
          push_fp()
        end;
        `	{emit_string(instr_for_floatop floatop)}\n`
    | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific(Isubfrev | Idivfrev)
          as floatop) ->
        begin match (i.arg.(0).loc, i.arg.(1).loc) with
          (Reg 100, Reg 100) ->         (* both operands on top of FP stack *)
            `	{emit_string(instr_for_floatop_pop floatop)}	%st(0), %st(1)\n`;
            pop_fp()
        | (Reg 100, _) ->               (* first operand on stack *)
            `	{emit_string(instr_for_floatop floatop)}{emit_float_operand i.arg.(1)}\n`
        | (_, Reg 100) ->               (* second operand on stack *)
            `	{emit_string(instr_for_floatop_reversed floatop)}{emit_float_operand i.arg.(0)}\n`
        | (_, _) ->                     (* both in regs or on stack *)
            `	fldl	{emit_reg i.arg.(0)}\n`;
            push_fp();
            `	{emit_string(instr_for_floatop floatop)}{emit_float_operand i.arg.(1)}\n`
        end
    | Lop(Ifloatofint) ->
        begin match i.arg.(0).loc with
          Stack s ->
            `	fildl	{emit_reg i.arg.(0)}\n`
        | _ ->
            `	pushl	{emit_reg i.arg.(0)}\n`;
            `	fildl	(%esp)\n`;
            `	addl	$4, %esp\n`
        end;
        push_fp()
    | Lop(Iintoffloat) ->
        if i.arg.(0).loc <> Reg 100 then begin
          `	fldl	{emit_reg i.arg.(0)}\n`;
          push_fp()
        end;
        stack_offset := !stack_offset - 8;
        `	subl	$8, %esp\n`;
        `	fnstcw	4(%esp)\n`;
        `	movl	4(%esp), %eax\n`;
        `	movb    $12, %ah\n`;
        `	movl	%eax, (%esp)\n`;
        `	fldcw	(%esp)\n`;
        begin match i.res.(0).loc with
          Stack s ->
            `	fistpl	{emit_reg i.res.(0)}\n`
        | _ ->
            `	fistpl	(%esp)\n`;
            `	movl	(%esp), {emit_reg i.res.(0)}\n`
        end;
        pop_fp();
        `	fldcw	4(%esp)\n`;
        `	addl	$8, %esp\n`;
        stack_offset := !stack_offset + 8
    | Lop(Ispecific(Ilea addr)) ->
        `	lea	{emit_addressing addr i.arg 0}, {emit_reg i.res.(0)}\n`
    | Lop(Ispecific(Istore_int(n, addr))) ->
        `	movl	${emit_int n}, {emit_addressing addr i.arg 0}\n`
    | Lop(Ispecific(Istore_symbol(s, addr))) ->
        `	movl	${emit_symbol s}, {emit_addressing addr i.arg 0}\n`
    | Lop(Ispecific(Ioffset_loc(n, addr))) ->
        `	addl	${emit_int n}, {emit_addressing addr i.arg 0}\n`
    | Lop(Ispecific(Ifloatarithmem(op, addr))) ->
        if i.arg.(0).loc <> Reg 100 then begin
          `	fldl	{emit_reg i.arg.(0)}\n`;
          push_fp()
        end;
        `	{emit_string(instr_for_floatarithmem op)}	{emit_addressing addr i.arg 1}\n`
    | Lreloadretaddr ->
        ()
    | Lreturn ->
        output_epilogue();
        `	ret\n`
    | Llabel lbl ->
        `{emit_label lbl}:\n`
    | Lbranch lbl ->
        `	jmp	{emit_label lbl}\n`
    | Lcondbranch(tst, lbl) ->
        begin match tst with
          Itruetest ->
            output_test_zero i.arg.(0);
            `	jne	{emit_label lbl}\n`
        | Ifalsetest ->
            output_test_zero i.arg.(0);
            `	je	{emit_label lbl}\n`
        | Iinttest cmp ->
            `	cmpl	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
            let b = name_for_cond_branch cmp in
            `	j{emit_string b}	{emit_label lbl}\n`
        | Iinttest_imm((Isigned Ceq | Isigned Cne | 
                        Iunsigned Ceq | Iunsigned Cne) as cmp, 0) ->
            output_test_zero i.arg.(0);
            let b = name_for_cond_branch cmp in
            `	j{emit_string b}	{emit_label lbl}\n`
        | Iinttest_imm(cmp, n) ->
            `	cmpl	${emit_int n}, {emit_reg i.arg.(0)}\n`;
            let b = name_for_cond_branch cmp in
            `	j{emit_string b}	{emit_label lbl}\n`
        | Ifloattest(cmp, neg) ->
            let instr =
              match cmp with
                Ceq | Cne -> "fucom"
              | _         -> "fcom" in
            let actual_cmp =
              match (i.arg.(0).loc, i.arg.(1).loc) with
                (Reg 100, Reg 100) ->     (* both args on top of FP stack *)
                  `	{emit_string instr}pp\n`;
                  fp_offset := !fp_offset - 2;
                  cmp
              | (Reg 100, _) ->           (* first arg on top of FP stack *)
                  `	{emit_string instr}p{emit_float_operand i.arg.(1)}\n`;
                  pop_fp();
                  cmp
              | (_, Reg 100) ->           (* second arg on top of FP stack *)
                  `	{emit_string instr}p{emit_float_operand i.arg.(0)}\n`;
                  pop_fp();
                  Cmm.swap_comparison cmp
              | (_, _) ->
                  `	fldl	{emit_reg i.arg.(0)}\n`;
                  push_fp();
                  `	{emit_string instr}p{emit_float_operand i.arg.(1)}\n`;
                  pop_fp();
                  cmp in
            `	fnstsw	%ax\n`;
            begin match actual_cmp with
              Ceq ->
                if neg then begin
                  `	andb	$68, %ah\n`;
                  `	xorb	$64, %ah\n`;
                  `	jne	`
                end else begin
                  `	andb	$69, %ah\n`;
                  `	cmpb	$64, %ah\n`;
                  `	je	`
                end
            | Cne ->
                if neg then begin
                  `	andb	$69, %ah\n`;
                  `	cmpb	$64, %ah\n`;
                  `	je	`
                end else begin
                  `	andb	$68, %ah\n`;
                  `	xorb	$64, %ah\n`;
                  `	jne	`
                end
            | Cle ->
                `	andb	$69, %ah\n`;
                `	decb	%ah\n`;
                `	cmpb	$64, %ah\n`;
                if neg
                then `	jae	`
                else `	jb	`
            | Cge ->
                `	andb	$5, %ah\n`;
                if neg
                then `	jne	`
                else `	je	`
            | Clt ->
                `	andb	$69, %ah\n`;
                `	cmpb	$1, %ah\n`;
                if neg
                then `	jne	`
                else `	je	`
            | Cgt ->
                `	andb	$69, %ah\n`;
                if neg
                then `	jne	`
                else `	je	`
            end;
            `{emit_label lbl}\n`
        | Ioddtest ->
            `	testl	$1, {emit_reg i.arg.(0)}\n`;
            `	jne	{emit_label lbl}\n`
        | Ieventest ->
            `	testl	$1, {emit_reg i.arg.(0)}\n`;
            `	je	{emit_label lbl}\n`
        end
    | Lcondbranch3(lbl0, lbl1, lbl2) ->
            `	cmpl	$1, {emit_reg i.arg.(0)}\n`;
            begin match lbl0 with
              None -> ()
            | Some lbl -> `	jb	{emit_label lbl}\n`
            end;
            begin match lbl1 with
              None -> ()
            | Some lbl -> `	je	{emit_label lbl}\n`
            end;
            begin match lbl2 with
              None -> ()
            | Some lbl -> `	jg	{emit_label lbl}\n`
            end
    | Lswitch jumptbl ->
        let lbl = new_label() in
        `	jmp	*{emit_label lbl}(, {emit_reg i.arg.(0)}, 4)\n`;
        `	.data\n`;
        `{emit_label lbl}:`;
        for i = 0 to Array.length jumptbl - 1 do
          `	.long	{emit_label jumptbl.(i)}\n`
        done;
        `	.text\n`
    | Lsetuptrap lbl ->
        `	call	{emit_label lbl}\n`
    | Lpushtrap ->
        `	pushl	{emit_symbol "caml_exception_pointer"}\n`;
        `	movl	%esp, {emit_symbol "caml_exception_pointer"}\n`;
        stack_offset := !stack_offset + 8
    | Lpoptrap ->
        `	popl	{emit_symbol "caml_exception_pointer"}\n`;
        `	addl	$4, %esp\n`;
        stack_offset := !stack_offset - 8
    | Lraise ->
        `	movl	{emit_symbol "caml_exception_pointer"}, %esp\n`;
        `	popl    {emit_symbol "caml_exception_pointer"}\n`;
        `	ret\n`

let rec emit_all i =
  match i.desc with Lend -> () | _ -> emit_instr i; emit_all i.next

(* Emission of the floating-point constants *)

let emit_float_constant (lbl, cst) =
  `	.data\n`;
  `{emit_label lbl}:	.double	{emit_string cst}\n`

(* Emission of a function declaration *)

let fundecl fundecl =
  function_name := fundecl.fun_name;
  fastcode_flag := fundecl.fun_fast;
  tailrec_entry_point := new_label();
  stack_offset := 0;
  float_constants := [];
  call_gc_sites := [];
  range_check_trap := 0;
  `	.text\n`;
  emit_align 16; (* 16-byte alignment is recommended for the 486 *)
  `	.globl	{emit_symbol fundecl.fun_name}\n`;
  `{emit_symbol fundecl.fun_name}:\n`;
  let n = frame_size() - 4 in
  if n > 0 then
    `	subl	${emit_int n}, %esp\n`;
  `{emit_label !tailrec_entry_point}:`;
  emit_all fundecl.fun_body;
  List.iter emit_call_gc !call_gc_sites;
  if !range_check_trap > 0 then
    `{emit_label !range_check_trap}:	jmp	{emit_symbol "array_bound_error"}\n`;
  List.iter emit_float_constant !float_constants

(* Emission of data *)

let emit_item = function
    Cdefine_symbol s ->
      `	.globl	{emit_symbol s}\n`;
      `{emit_symbol s}:\n`
  | Cdefine_label lbl ->
      `{emit_label (10000 + lbl)}:\n`
  | Cint8 n ->
      `	.byte	{emit_int n}\n`
  | Cint16 n ->
      `	.word	{emit_int n}\n`
  | Cint n ->
      `	.long	{emit_int n}\n`
  | Cintlit n ->
      `	.long	{emit_string n}\n`
  | Cfloat f ->
      `	.double	{emit_string f}\n`
  | Csymbol_address s ->
      `	.long	{emit_symbol s}\n`
  | Clabel_address lbl ->
      `	.long	{emit_label (10000 + lbl)}\n`
  | Cstring s ->
      let l = String.length s in
      if l = 0 then ()
      else if l < 80 then
        `	.ascii	{emit_string_literal s}\n`
      else begin
        let i = ref 0 in
        while !i < l do
          let n = min (l - !i) 80 in
          `	.ascii	{emit_string_literal(String.sub s !i n)}\n`;
          i := !i + n
        done
      end
  | Cskip n ->
      if n > 0 then `	.space	{emit_int n}\n`
  | Calign n ->
      emit_align n

let data l =
  `	.data\n`;
  List.iter emit_item l

(* Beginning / end of an assembly file *)

let begin_assembly() =
  let lbl_begin = Compilenv.current_unit_name() ^ "_begin" in
  `	.data\n`;
  `	.globl	{emit_symbol lbl_begin}\n`;
  `{emit_symbol lbl_begin}:\n`

let end_assembly() =
  `	.data\n`;
  let lbl_end = Compilenv.current_unit_name() ^ "_end" in
  `	.globl	{emit_symbol lbl_end}\n`;
  `{emit_symbol lbl_end}:\n`;
  `	.long	0\n`;
  let lbl = Compilenv.current_unit_name() ^ "_frametable" in
  `	.globl	{emit_symbol lbl}\n`;
  `{emit_symbol lbl}:\n`;
  `	.long	{emit_int (List.length !frame_descriptors)}\n`;
  List.iter emit_frame !frame_descriptors;
  frame_descriptors := []