ocaml/asmcomp/mips/emit.mlp

(***********************************************************************)
(*                                                                     *)
(*                           Objective Caml                            *)
(*                                                                     *)
(*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
(*                                                                     *)
(*  Copyright 1996 Institut National de Recherche en Informatique et   *)
(*  en Automatique.  All rights reserved.  This file is distributed    *)
(*  under the terms of the Q Public License version 1.0.               *)
(*                                                                     *)
(***********************************************************************)

(* $Id$ *)

(* Emission of Mips assembly code *)

open Location
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

(* Output a label *)

let emit_label lbl =
  emit_string "$"; emit_int lbl

(* Output a symbol *)

let emit_symbol s =
  Emitaux.emit_symbol '$' s

(* Output a pseudo-register *)

let emit_reg r =
  match r.loc with
    Reg r -> emit_string (register_name r)
  | _ -> fatal_error "Emit_mips.emit_reg"

(* Record if $gp is needed *)

let uses_gp = ref false

(* Layout of the stack frame *)

let stack_offset = ref 0

let frame_size () =
  let size =
    !stack_offset +
    4 * num_stack_slots.(0) + 8 * num_stack_slots.(1) +
    (if !contains_calls then if !uses_gp then 8 else 4 else 0) in
  Misc.align size 16

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

(* Output a stack reference *)

let emit_stack r =
  match r.loc with
    Stack s ->
      let ofs = slot_offset s (register_class r) in `{emit_int ofs}($sp)`
  | _ -> fatal_error "Emit_mips.emit_stack"

(* Output an addressing mode *)

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

(* Communicate live registers at call points to the assembler *)

let int_reg_number =
  [| 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21 |]
  
let float_reg_number =
  [| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19;
     20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30 |]

let liveregs instr extra_msk =
  (* $22, $23, $30 always live *)
  let int_mask = ref(0x00000302 lor extra_msk)
  and float_mask = ref 0 in
  let add_register = function
      {loc = Reg r; typ = (Int | Addr)} ->
        int_mask := !int_mask lor (1 lsl (31 - int_reg_number.(r)))
    | {loc = Reg r; typ = Float} ->
        float_mask := !float_mask lor (1 lsl (31 - float_reg_number.(r - 100)))
    | _ -> () in
  Reg.Set.iter add_register instr.live;
  Array.iter add_register instr.arg;
  emit_printf "	.livereg 0x%08x, 0x%08x\n" !int_mask !float_mask

let live_25 = 1 lsl (31 - 25)
let live_24 = 1 lsl (31 - 24)

(* 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 live =
  let lbl = new_label() in
  let live_offset = ref [] in
  Reg.Set.iter
    (function
        {typ = Addr; loc = Reg r} ->
          live_offset := ((int_reg_number.(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;
  `{emit_label lbl}:`

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

(* Determine if $gp is used in the function *)

let rec instr_uses_gp i =
  match i.desc with
    Lend -> false
  | Lop(Iconst_symbol s) -> true
  | Lop(Icall_imm s) -> true
  | Lop(Itailcall_imm s) -> true
  | Lop(Iextcall(_, _)) -> true
  | Lop(Iload(_, Ibased(_, _))) -> true
  | Lop(Istore(_, Ibased(_, _))) -> true
  | Lop(Ialloc _) -> true
  | Lop(Iintop(Icheckbound)) -> true
  | Lop(Iintop_imm(Icheckbound, _)) -> true
  | Lswitch jumptbl -> true
  | _ -> instr_uses_gp i.next

(* Names of various instructions *)

let name_for_comparison = function
    Isigned Ceq -> "eq" | Isigned Cne -> "ne" | Isigned Cle -> "le"
  | Isigned Cge -> "ge" | Isigned Clt -> "lt" | Isigned Cgt -> "gt"
  | Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" | Iunsigned Cle -> "leu"
  | Iunsigned Cge -> "geu" | Iunsigned Clt -> "ltu" | Iunsigned Cgt -> "gtu"

let name_for_float_comparison cmp neg =
  match cmp with
    Ceq -> ("eq", neg) | Cne -> ("eq", not neg)
  | Cle -> ("le", neg) | Cge -> ("ult", not neg)
  | Clt -> ("lt", neg) | Cgt -> ("ule", not neg)

let name_for_int_operation = function
    Iadd -> "addu"
  | Isub -> "subu"
  | Imul -> "mul"
  | Idiv -> "div"
  | Imod -> "rem"
  | Iand -> "and"
  | Ior  -> "or"
  | Ixor -> "xor"
  | Ilsl -> "sll"
  | Ilsr -> "srl"
  | Iasr -> "sra"
  | Icomp cmp -> "s" ^ name_for_comparison cmp
  | _ -> Misc.fatal_error "Emit.name_for_int_operation"

let name_for_float_operation = function
    Inegf -> "neg.d"
  | Iabsf -> "abs.d"
  | Iaddf -> "add.d"
  | Isubf -> "sub.d"
  | Imulf -> "mul.d"
  | Idivf -> "div.d"
  | _ -> Misc.fatal_error "Emit.name_for_float_operation"

(* 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 jump to caml_call_gc *)
let call_gc_label = ref 0
(* Label of trap for out-of-range accesses *)
let range_check_trap = ref 0

let emit_instr i =
    match i.desc with
      Lend -> ()
    | Lop(Imove | Ispill | Ireload) ->
        let src = i.arg.(0) and dst = i.res.(0) in
        if src.loc <> dst.loc then begin
          match (src, dst) with
            {loc = Reg rs; typ = Int|Addr}, {loc = Reg rd; typ = Int|Addr} ->
              `	move	{emit_reg dst}, {emit_reg src}\n`
          | {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = Float} ->
              `	mov.d	{emit_reg dst}, {emit_reg src}\n`
          | {loc = Reg rs; typ = Int|Addr}, {loc = Stack sd} ->
              `	sw	{emit_reg src}, {emit_stack dst}\n`
          | {loc = Reg rs; typ = Float}, {loc = Stack sd} ->
              `	s.d	{emit_reg src}, {emit_stack dst}\n`
          | {loc = Stack ss; typ = Int|Addr}, {loc = Reg rd} ->
              `	lw	{emit_reg dst}, {emit_stack src}\n`
          | {loc = Stack ss; typ = Float}, {loc = Reg rd} ->
              `	l.d	{emit_reg dst}, {emit_stack src}\n`
          | _ ->
              fatal_error "Emit_mips: Imove"
        end
    | Lop(Iconst_int n) ->
        if n = 0n then
          `	move	{emit_reg i.res.(0)}, $0\n`
        else
          `	li	{emit_reg i.res.(0)}, {emit_nativeint n}\n`
    | Lop(Iconst_float s) ->
        `	li.d	{emit_reg i.res.(0)}, {emit_string s}\n`
    | Lop(Iconst_symbol s) ->
        `	la	{emit_reg i.res.(0)}, {emit_symbol s}\n`
    | Lop(Icall_ind) ->
        `	move	$25, {emit_reg i.arg.(0)}\n`;
        liveregs i live_25;
        `	jal	{emit_reg i.arg.(0)}\n`;
        `{record_frame i.live}\n`
    | Lop(Icall_imm s) ->
        liveregs i 0;
        `	jal	{emit_symbol s}\n`;
        `{record_frame i.live}\n`
    | Lop(Itailcall_ind) ->
        let n = frame_size() in
        if !contains_calls then
          `	lw	$31, {emit_int(n - 4)}($sp)\n`;
        if !uses_gp then
          `	lw	$gp, {emit_int(n - 8)}($sp)\n`;
        if n > 0 then
          `	addu	$sp, $sp, {emit_int n}\n`;
        liveregs i 0;
        `	move	$25, {emit_reg i.arg.(0)}\n`;
        liveregs i live_25;
        `	j	{emit_reg i.arg.(0)}\n`
    | Lop(Itailcall_imm s) ->
        if s = !function_name then begin
          `	b	{emit_label !tailrec_entry_point}\n`
        end else begin
          let n = frame_size() in
          if !contains_calls then
            `	lw	$31, {emit_int(n - 4)}($sp)\n`;
          if !uses_gp then
            `	lw	$gp, {emit_int(n - 8)}($sp)\n`;
          if n > 0 then
            `	addu	$sp, $sp, {emit_int n}\n`;
          `	la	$25, {emit_symbol s}\n`;
          liveregs i live_25;
          `	j	$25\n`
        end
    | Lop(Iextcall(s, alloc)) ->
        if alloc then begin
          `	la	$24, {emit_symbol s}\n`;
          liveregs i live_24;
          `	jal	caml_c_call\n`;
          `{record_frame i.live}\n`
        end else begin
          `	jal	{emit_symbol s}\n`
        end
   | Lop(Istackoffset n) ->
        if n >= 0 then
          `	subu	$sp, $sp, {emit_int n}\n`
        else
          `	addu	$sp, $sp, {emit_int (-n)}\n`;
        stack_offset := !stack_offset + n
    | Lop(Iload(chunk, addr)) ->
        let dest = i.res.(0) in
        begin match chunk with
          Double_u ->
            (* Destination is not 8-aligned, hence cannot use l.d *)
            `	ldl	$24, {emit_addressing addr i.arg 0}\n`;
            `	ldr	$24, {emit_addressing (offset_addressing addr 7) i.arg 0}\n`;
            `	dmtc1	$24, {emit_reg dest}\n`
        | Single ->
            `	l.s	{emit_reg dest}, {emit_addressing addr i.arg 0}\n`;
            `	cvt.d.s	{emit_reg dest}, {emit_reg dest}\n`
        | _ ->
            let load_instr =
              match chunk with
                Byte_unsigned -> "lbu"
              | Byte_signed -> "lb"
              | Sixteen_unsigned -> "lhu"
              | Sixteen_signed -> "lh"
              | Double -> "l.d"
              | _ -> "lw" in
            `	{emit_string load_instr}	{emit_reg dest}, {emit_addressing addr i.arg 0}\n`
        end
    | Lop(Istore(chunk, addr)) ->
        let src = i.arg.(0) in
        begin match chunk with
          Double_u ->
            (* Destination is not 8-aligned, hence cannot use l.d *)
            `	dmfc1	$24, {emit_reg src}\n`;
            `	sdl	$24, {emit_addressing addr i.arg 1}\n`;
            `	sdr	$24, {emit_addressing (offset_addressing addr 7) i.arg 1}\n`
        | Single ->
            `	cvt.s.d	$f31, {emit_reg src}\n`;
            `	s.s	$f31, {emit_addressing addr i.arg 1}\n`
        | _ ->
            let store_instr =
              match chunk with
                Byte_unsigned | Byte_signed -> "sb"
              | Sixteen_unsigned | Sixteen_signed -> "sh"
              | Double -> "s.d"
              | _ -> "sw" in
            `	{emit_string store_instr}	{emit_reg src}, {emit_addressing addr i.arg 1}\n`
        end
    | Lop(Ialloc n) ->
        if !call_gc_label = 0 then call_gc_label := new_label();
        `	.set	noreorder\n`;
        `	subu	$22, $22, {emit_int n}\n`;
        `	subu	$24, $22, $23\n`;
        `	bltzal	$24, {emit_label !call_gc_label}\n`;
        `	addu	{emit_reg i.res.(0)}, $22, 4\n`;
        `{record_frame i.live}\n`;
        `	.set	reorder\n`
    | Lop(Iintop(Icheckbound)) ->
        if !range_check_trap = 0 then range_check_trap := new_label();
        `	bleu	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label !range_check_trap}\n`
    | Lop(Iintop op) ->
        let instr = name_for_int_operation op in
        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
    | Lop(Iintop_imm(Icheckbound, n)) ->
        if !range_check_trap = 0 then range_check_trap := new_label();
        `	bleu	{emit_reg i.arg.(0)}, {emit_int n}, {emit_label !range_check_trap}\n`
    | Lop(Iintop_imm(op, n)) ->
        let instr = name_for_int_operation op in
        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n`
    | Lop(Inegf | Iabsf as op) ->
        let instr = name_for_float_operation op in
        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
    | Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
        let instr = name_for_float_operation op in
        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
    | Lop(Ifloatofint) ->
        `	mtc1	{emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`;
        `	cvt.d.w	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
    | Lop(Iintoffloat) ->
        `	trunc.w.d	$f31, {emit_reg i.arg.(0)}, $24\n`;
        `	mfc1	{emit_reg i.res.(0)}, $f31\n`
    | Lop(Ispecific sop) ->
        fatal_error "Emit_mips: Ispecific"
    | Lreloadretaddr ->
        let n = frame_size() in
        `	lw	$31, {emit_int(n - 4)}($sp)\n`;
    | Lreturn ->
        let n = frame_size() in
        if !uses_gp then
          `	lw	$gp, {emit_int(n - 8)}($sp)\n`;
        if n > 0 then
          `	addu	$sp, $sp, {emit_int n}\n`;
        liveregs i 0;
        `	j	$31\n`
    | Llabel lbl ->
        `{emit_label lbl}:\n`
    | Lbranch lbl ->
        `	b	{emit_label lbl}\n`
    | Lcondbranch(tst, lbl) ->
        begin match tst with
          Itruetest ->
            `	bne	{emit_reg i.arg.(0)}, $0, {emit_label lbl}\n`
        | Ifalsetest ->
            `	beq	{emit_reg i.arg.(0)}, $0, {emit_label lbl}\n`
        | Iinttest cmp ->
            let comp = name_for_comparison cmp in
            `	b{emit_string comp}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
        | Iinttest_imm(cmp, n) ->
            let comp = name_for_comparison cmp in
            `	b{emit_string comp}	{emit_reg i.arg.(0)}, {emit_int n}, {emit_label lbl}\n`
        | Ifloattest(cmp, neg) ->
            let (comp, branch) = name_for_float_comparison cmp neg in
            `	c.{emit_string comp}.d	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
            if branch
            then `	bc1f	{emit_label lbl}\n`
            else `	bc1t	{emit_label lbl}\n`
        | Ioddtest ->
            `	and	$24, {emit_reg i.arg.(0)}, 1\n`;
            `	bne	$24, $0, {emit_label lbl}\n`
        | Ieventest ->
            `	and	$24, {emit_reg i.arg.(0)}, 1\n`;
            `	beq	$24, $0, {emit_label lbl}\n`
        end
  | Lcondbranch3(lbl0, lbl1, lbl2) ->
        `	subu	$24, {emit_reg i.arg.(0)}, 1\n`;
        begin match lbl0 with
          None -> ()
        | Some lbl -> `	beq	{emit_reg i.arg.(0)}, $0, {emit_label lbl}\n`
        end;
        begin match lbl1 with
          None -> ()
        | Some lbl -> `	beq	$24, $0, {emit_label lbl}\n`
        end;
        begin match lbl2 with
          None -> ()
        | Some lbl -> `	bgtz	$24, {emit_label lbl}\n`
        end
  | Lswitch jumptbl ->
        let lbl_jumptbl = new_label() in
        `	sll     $24, {emit_reg i.arg.(0)}, 2\n`;
        `	lw	$24, {emit_label lbl_jumptbl}($24)\n`;
        liveregs i live_24;
        `	j	$24\n`;
        `	.rdata\n`;
        `{emit_label lbl_jumptbl}:\n`;
        for i = 0 to Array.length jumptbl - 1 do
          `	.word	{emit_label jumptbl.(i)}\n`
        done;
        `	.text\n`
    | Lsetuptrap lbl ->
        `	subu	$sp, $sp, 16\n`;
        `	bal	{emit_label lbl}\n`
    | Lpushtrap ->
        stack_offset := !stack_offset + 16;
        `	sw	$30, 0($sp)\n`;
        `	sw	$31, 4($sp)\n`;
        `	sw	$gp, 8($sp)\n`;
        `	move	$30, $sp\n`
    | Lpoptrap ->
        `	lw	$30, 0($sp)\n`;
        `	addu	$sp, $sp, 16\n`;
        stack_offset := !stack_offset - 16
    | Lraise ->
        `	lw	$25, 4($30)\n`;
        `	move	$sp, $30\n`;
        `	lw	$30, 0($sp)\n`;
        `	lw	$gp, 8($sp)\n`;
        `	addu	$sp, $sp, 16\n`;
        liveregs i live_25;
        `	jal	$25\n` (* Keep retaddr in $31 for debugging *)

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

(* Emission of a function declaration *)

let fundecl fundecl =
  function_name := fundecl.fun_name;
  fastcode_flag := fundecl.fun_fast;
  uses_gp := instr_uses_gp fundecl.fun_body;
  if !uses_gp then contains_calls := true;
  tailrec_entry_point := new_label();
  stack_offset := 0;
  call_gc_label := 0;
  range_check_trap := 0;
  `	.text\n`;
  `	.align	2\n`;
  `	.globl	{emit_symbol fundecl.fun_name}\n`;
  `	.ent	{emit_symbol fundecl.fun_name}\n`;
  `{emit_symbol fundecl.fun_name}:\n`;
  let n = frame_size() in
  if n > 0 then
    `	subu	$sp, $sp, {emit_int n}\n`;
  if !contains_calls then
    `	sw	$31, {emit_int(n - 4)}($sp)\n`;
  if !uses_gp then begin
    `	sw	$gp, {emit_int(n - 8)}($sp)\n`;
    `	lui	$24, %hi(%neg(%gp_rel({emit_symbol fundecl.fun_name})))\n`;
    `	addiu	$24, $24, %lo(%neg(%gp_rel({emit_symbol fundecl.fun_name})))\n`;
    `	daddu	$gp, $25, $24\n`
  end;
  `{emit_label !tailrec_entry_point}:\n`;
  emit_all fundecl.fun_body;
  if !call_gc_label > 0 then begin
    `{emit_label !call_gc_label}:\n`;
    `	la	$25, caml_call_gc\n`;
    `	j	$25\n`
  end;
  if !range_check_trap > 0 then begin
    `{emit_label !range_check_trap}:\n`;
    `	la	$25, caml_ml_array_bound_error\n`;
    `	j	$25\n`
  end;
  `	.end	{emit_symbol fundecl.fun_name}\n`

(* Emission of data *)

let emit_item = function
    Cglobal_symbol s ->
      `	.globl	{emit_symbol s}\n`;
  | Cdefine_symbol s ->
      `{emit_symbol s}:\n`
  | Cdefine_label lbl ->
      `{emit_label (100000 + lbl)}:\n`
  | Cint8 n ->
      `	.byte	{emit_int n}\n`
  | Cint16 n ->
      `	.half	{emit_int n}\n`
  | Cint32 n ->
      `	.word	{emit_nativeint n}\n`
  | Cint n ->
      `	.word	{emit_nativeint n}\n`
  | Csingle f ->
      `	.float	{emit_string f}\n`
  | Cdouble f ->
      `	.align	0\n`; (* Prevent alignment on 8-byte boundary *)
      `	.double	{emit_string f}\n`
  | Csymbol_address s ->
      `	.word	{emit_symbol s}\n`
  | Clabel_address lbl ->
      `	.word	{emit_label (100000 + lbl)}\n`
  | Cstring s ->
      emit_string_directive "	.ascii	" s
  | Cskip n ->
      if n > 0 then `	.space	{emit_int n}\n`
  | Calign n ->
      `	.align	{emit_int(Misc.log2 n)}\n`

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

(* Beginning / end of an assembly file *)

let begin_assembly() =
  (* There are really two groups of registers:
      $sp and $30 always point to stack locations
      $2 - $21 never point to stack locations. *)
  `	.noalias $2,$sp;  .noalias $2,$30;  .noalias $3,$sp;  .noalias $3,$30\n`;
  `	.noalias $4,$sp;  .noalias $4,$30;  .noalias $5,$sp;  .noalias $5,$30\n`;
  `	.noalias $6,$sp;  .noalias $6,$30;  .noalias $7,$sp;  .noalias $7,$30\n`;
  `	.noalias $8,$sp;  .noalias $8,$30;  .noalias $9,$sp;  .noalias $9,$30\n`;
  `	.noalias $10,$sp; .noalias $10,$30; .noalias $11,$sp; .noalias $11,$30\n`;
  `	.noalias $12,$sp; .noalias $12,$30; .noalias $13,$sp; .noalias $13,$30\n`;
  `	.noalias $14,$sp; .noalias $14,$30; .noalias $15,$sp; .noalias $15,$30\n`;
  `	.noalias $16,$sp; .noalias $16,$30; .noalias $17,$sp; .noalias $17,$30\n`;
  `	.noalias $18,$sp; .noalias $18,$30; .noalias $19,$sp; .noalias $19,$30\n`;
  `	.noalias $20,$sp; .noalias $20,$30; .noalias $21,$sp; .noalias $21,$30\n\n`;
  let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
  `	.data\n`;
  `	.globl	{emit_symbol lbl_begin}\n`;
  `{emit_symbol lbl_begin}:\n`;
  let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
  `	.text\n`;
  `	.globl	{emit_symbol lbl_begin}\n`;
  `	.ent	{emit_symbol lbl_begin}\n`;
  `{emit_symbol lbl_begin}:\n`;
  `	.end	{emit_symbol lbl_begin}\n`

let end_assembly () =
  let lbl_end = Compilenv.make_symbol (Some "code_end") in
  `	.text\n`;
  `	.globl	{emit_symbol lbl_end}\n`;
  `	.ent	{emit_symbol lbl_end}\n`;
  `{emit_symbol lbl_end}:\n`;
  `	.end	{emit_symbol lbl_end}\n`;
  let lbl_end = Compilenv.make_symbol (Some "data_end") in
  `	.data\n`;
  `	.globl	{emit_symbol lbl_end}\n`;
  `{emit_symbol lbl_end}:\n`;
  `	.word	0\n`;
  let lbl = Compilenv.make_symbol (Some "frametable") in
  `	.rdata\n`;
  `	.globl	{emit_symbol lbl}\n`;
  `{emit_symbol lbl}:\n`;
  `	.word	{emit_int (List.length !frame_descriptors)}\n`;
  List.iter emit_frame !frame_descriptors;
  frame_descriptors := []