# 2 "asmcomp/riscv/emit.mlp"
(**************************************************************************)
(*                                                                        *)
(*                                 OCaml                                  *)
(*                                                                        *)
(*                Nicolas Ojeda Bar <n.oje.bar@gmail.com>                 *)
(*                                                                        *)
(*   Copyright 2016 Institut National de Recherche en Informatique et     *)
(*     en Automatique.                                                    *)
(*                                                                        *)
(*   All rights reserved.  This file is distributed under the terms of    *)
(*   the GNU Lesser General Public License version 2.1, with the          *)
(*   special exception on linking described in the file LICENSE.          *)
(*                                                                        *)
(**************************************************************************)

(* Emission of RISC-V assembly code *)

open Cmm
open Arch
open Proc
open Reg
open Mach
open Linear
open Emitaux
open Emitenv

(* Layout of the stack.  The stack is kept 16-aligned. *)

let frame_size env =
  let size =
    env.stack_offset +                     (* Trap frame, outgoing parameters *)
    size_int * env.f.fun_num_stack_slots.(0) +    (* Local int variables *)
    size_float * env.f.fun_num_stack_slots.(1) +  (* Local float variables *)
    (if env.f.fun_contains_calls then size_addr else 0) (* Return address *)
  in
  Misc.align size 16

let slot_offset env loc cls =
  match loc with
  | Local n ->
      ("sp",
       if cls = 0
       then env.stack_offset + env.f.fun_num_stack_slots.(1) * size_float
            + n * size_int
       else env.stack_offset + n * size_float)
  | Incoming n ->
      ("sp", frame_size env + n)
  | Outgoing n ->
      ("sp", n)
  | Domainstate n ->
      ("s11", n + Domainstate.(idx_of_field Domain_extra_params) * 8)

(* Output a symbol *)

let emit_symbol s =
  emit_symbol '$' s

let emit_jump op s =
  if !Clflags.dlcode || !Clflags.pic_code
  then `{emit_string op}	{emit_symbol s}@plt`
  else `{emit_string op}	{emit_symbol s}`

let emit_call = emit_jump "call"
let emit_tail = emit_jump "tail"

(* Output a label *)

let emit_label lbl =
  emit_string ".L"; emit_int lbl

(* Section switching *)

let data_space =
  ".section .data"

let code_space =
  ".section .text"

let rodata_space =
  ".section .rodata"

(* Names for special regs *)

let reg_tmp = phys_reg 23
let reg_t2 = phys_reg 16
let reg_domain_state_ptr = phys_reg 26
let reg_trap = phys_reg 24
let reg_alloc_ptr = phys_reg 25

(* Output a pseudo-register *)

let reg_name = function
  | {loc = Reg r} -> register_name r
  | _ -> Misc.fatal_error "Emit.reg_name"

let emit_reg r =
  emit_string (reg_name r)

(* Adjust sp by the given byte amount *)

let emit_stack_adjustment = function
  | 0 -> ()
  | n when is_immediate n ->
      `	addi	sp, sp, {emit_int n}\n`
  | n ->
      `	li	{emit_reg reg_tmp}, {emit_int n}\n`;
      `	add	sp, sp, {emit_reg reg_tmp}\n`

(* Adjust stack_offset and emit corresponding CFI directive *)

let adjust_stack_offset env delta =
  env.stack_offset <- env.stack_offset + delta;
  cfi_adjust_cfa_offset delta

let emit_mem_op ?(base = "sp") op src ofs =
  if is_immediate ofs then
    `	{emit_string op}	{emit_string src}, {emit_int ofs}({emit_string base})\n`
  else begin
    `	li	{emit_reg reg_tmp}, {emit_int ofs}\n`;
    `	add	{emit_reg reg_tmp}, {emit_string base}, {emit_reg reg_tmp}\n`;
    `	{emit_string op}	{emit_string src}, 0({emit_reg reg_tmp})\n`
  end

let reload_ra n =
  emit_mem_op "ld" "ra" (n - size_addr)

let store_ra n =
  emit_mem_op "sd" "ra" (n - size_addr)

let emit_store ?base src ofs =
  emit_mem_op ?base "sd" (reg_name src) ofs

let emit_load ?base dst ofs =
  emit_mem_op ?base "ld" (reg_name dst) ofs

let emit_float_load ?base dst ofs =
  emit_mem_op ?base "fld" (reg_name dst) ofs

let emit_float_store ?base src ofs =
  emit_mem_op ?base "fsd" (reg_name src) ofs

(* Record live pointers at call points *)

let record_frame_label env live dbg =
  let lbl = new_label () in
  let live_offset = ref [] in
  Reg.Set.iter
    (function
        {typ = Val; loc = Reg r} ->
          live_offset := (r lsl 1) + 1 :: !live_offset
      | {typ = Val; loc = Stack s} as reg ->
          let (base, ofs) = slot_offset env s (register_class reg) in
          assert (base = "sp");
          live_offset := ofs :: !live_offset
      | {typ = Addr} as r ->
          Misc.fatal_error ("bad GC root " ^ Reg.name r)
      | _ -> ()
    )
    live;
  record_frame_descr ~label:lbl ~frame_size:(frame_size env)
    ~live_offset:!live_offset dbg;
  lbl

let record_frame env live dbg =
  let lbl = record_frame_label env live dbg in
  `{emit_label lbl}:\n`

let emit_call_gc gc =
  `{emit_label gc.gc_lbl}:\n`;
  `	{emit_call "caml_call_gc"}\n`;
  `{emit_label gc.gc_frame_lbl}:\n`;
  `	j	{emit_label gc.gc_return_lbl}\n`

let bound_error_label env dbg =
  if !Clflags.debug || env.bound_error_sites = [] then begin
    let lbl_bound_error = new_label() in
    let lbl_frame = record_frame_label env Reg.Set.empty (Dbg_other dbg) in
    env.bound_error_sites <-
      { bd_lbl = lbl_bound_error;
        bd_frame = lbl_frame; } :: env.bound_error_sites;
    lbl_bound_error
  end else
    let bd = List.hd env.bound_error_sites in
    bd.bd_lbl

let emit_call_bound_error bd =
  `{emit_label bd.bd_lbl}:\n`;
  `	{emit_call "caml_ml_array_bound_error"}\n`;
  `{emit_label bd.bd_frame}:\n`

(* Names for various instructions *)

let name_for_intop = function
  | Iadd  -> "add"
  | Isub  -> "sub"
  | Imul  -> "mul"
  | Imulh -> "mulh"
  | Idiv  -> "div"
  | Iand  -> "and"
  | Ior   -> "or"
  | Ixor  -> "xor"
  | Ilsl  -> "sll"
  | Ilsr  -> "srl"
  | Iasr  -> "sra"
  | Imod  -> "rem"
  | _ -> Misc.fatal_error "Emit.Intop"

let name_for_intop_imm = function
  | Iadd -> "addi"
  | Iand -> "andi"
  | Ior  -> "ori"
  | Ixor -> "xori"
  | Ilsl -> "slli"
  | Ilsr -> "srli"
  | Iasr -> "srai"
  | _ -> Misc.fatal_error "Emit.Intop_imm"

let name_for_floatop1 = function
  | Inegf -> "fneg.d"
  | Iabsf -> "fabs.d"
  | _ -> Misc.fatal_error "Emit.Iopf1"

let name_for_floatop2 = function
  | Iaddf -> "fadd.d"
  | Isubf -> "fsub.d"
  | Imulf -> "fmul.d"
  | Idivf -> "fdiv.d"
  | _ -> Misc.fatal_error "Emit.Iopf2"

let name_for_specific = function
  | Imultaddf false -> "fmadd.d"
  | Imultaddf true  -> "fnmadd.d"
  | Imultsubf false -> "fmsub.d"
  | Imultsubf true  -> "fnmsub.d"

(* Output the assembly code for an instruction *)

let emit_instr env i =
  emit_debug_info i.dbg;
  match i.desc with
    Lend -> ()
  | Lprologue ->
      assert (env.f.fun_prologue_required);
      let n = frame_size env in
      emit_stack_adjustment (-n);
      if n > 0 then cfi_adjust_cfa_offset n;
      if env.f.fun_contains_calls then begin
        store_ra n;
        cfi_offset ~reg:1 (* ra *) ~offset:(-size_addr)
      end;
  | 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 _; typ = (Val | Int | Addr)}, {loc = Reg _} ->
            `	mv      {emit_reg dst}, {emit_reg src}\n`
        | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
            `	fmv.d   {emit_reg dst}, {emit_reg src}\n`
        | {loc = Reg _; typ = Float}, {loc = Reg _; typ = (Val | Int | Addr)} ->
            `	fmv.x.d {emit_reg dst}, {emit_reg src}\n`
        | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} ->
            let (base, ofs) = slot_offset env s (register_class dst) in
            emit_store ~base src ofs
        | {loc = Reg _; typ = Float}, {loc = Stack s} ->
            let (base, ofs) = slot_offset env s (register_class dst) in
            emit_float_store ~base src ofs
        | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} ->
            let (base, ofs) = slot_offset env s (register_class src) in
            emit_load ~base dst ofs
        | {loc = Stack s; typ = Float}, {loc = Reg _} ->
            let (base, ofs) = slot_offset env s (register_class src) in
            emit_float_load ~base dst ofs
        | {loc = Stack _}, {loc = Stack _}
        | {loc = Unknown}, _ | _, {loc = Unknown} ->
            Misc.fatal_error "Emit: Imove"
      end
  | Lop(Iconst_int n) ->
      `	li	{emit_reg i.res.(0)}, {emit_nativeint n}\n`
  | Lop(Iconst_float f) ->
      let lbl = new_label() in
      env.float_literals <- {fl=f; lbl} :: env.float_literals;
      `	fld	{emit_reg i.res.(0)}, {emit_label lbl}, {emit_reg reg_tmp}\n`
  | Lop(Iconst_symbol s) ->
      `	la	{emit_reg i.res.(0)}, {emit_symbol s}\n`
  | Lop(Icall_ind) ->
      `	jalr	{emit_reg i.arg.(0)}\n`;
      record_frame env i.live (Dbg_other i.dbg)
  | Lop(Icall_imm {func}) ->
      `	{emit_call func}\n`;
      record_frame env i.live (Dbg_other i.dbg)
  | Lop(Itailcall_ind) ->
      let n = frame_size env in
      if env.f.fun_contains_calls then reload_ra n;
      emit_stack_adjustment n;
      `	jr	{emit_reg i.arg.(0)}\n`
  | Lop(Itailcall_imm {func}) ->
      if func = env.f.fun_name then begin
        `	j	{emit_label env.f.fun_tailrec_entry_point_label}\n`
      end else begin
        let n = frame_size env in
        if env.f.fun_contains_calls then reload_ra n;
        emit_stack_adjustment n;
        `	{emit_tail func}\n`
      end
  | Lop(Iextcall{func; alloc = true}) ->
      `	la	{emit_reg reg_t2}, {emit_symbol func}\n`;
      `	{emit_call "caml_c_call"}\n`;
      record_frame env i.live (Dbg_other i.dbg)
  | Lop(Iextcall{func; alloc = false}) ->
      `	{emit_call func}\n`
  | Lop(Istackoffset n) ->
      assert (n mod 16 = 0);
      emit_stack_adjustment (-n);
      adjust_stack_offset env n
  | Lop(Iload(Single, Iindexed ofs, _mut)) ->
      `	flw	{emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`;
      `	fcvt.d.s	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
  | Lop(Iload(chunk, Iindexed ofs, _mut)) ->
      let instr =
        match chunk with
        | Byte_unsigned -> "lbu"
        | Byte_signed -> "lb"
        | Sixteen_unsigned -> "lhu"
        | Sixteen_signed -> "lh"
        | Thirtytwo_unsigned -> "lwu"
        | Thirtytwo_signed -> "lw"
        | Word_int | Word_val -> "ld"
        | Single -> assert false
        | Double -> "fld"
      in
      `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`
  | Lop(Istore(Single, Iindexed ofs, _)) ->
      (* ft0 is marked as destroyed for this operation *)
      `	fcvt.s.d	ft0, {emit_reg i.arg.(0)}\n`;
      `	fsw	ft0, {emit_int ofs}({emit_reg i.arg.(1)})\n`
  | Lop(Istore(chunk, Iindexed ofs, _)) ->
      let instr =
        match chunk with
        | Byte_unsigned | Byte_signed -> "sb"
        | Sixteen_unsigned | Sixteen_signed -> "sh"
        | Thirtytwo_unsigned | Thirtytwo_signed -> "sw"
        | Word_int | Word_val -> "sd"
        | Single -> assert false
        | Double -> "fsd"
      in
      `	{emit_string instr}	{emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`
  | Lop(Ialloc {bytes; dbginfo}) ->
      let lbl_frame_lbl = record_frame_label env i.live (Dbg_alloc dbginfo) in
      let lbl_after_alloc = new_label () in
      let lbl_call_gc = new_label () in
      let n = -bytes in
      let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
      if is_immediate n then
        `	addi	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_int n}\n`
      else begin
        `	li	{emit_reg reg_tmp}, {emit_int n}\n`;
        `	add	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}\n`
      end;
      `	ld	{emit_reg reg_tmp}, {emit_int offset}({emit_reg reg_domain_state_ptr})\n`;
      `	bltu	{emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl_call_gc}\n`;
      `{emit_label lbl_after_alloc}:\n`;
      `	addi	{emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`;
      env.call_gc_sites <-
        { gc_lbl = lbl_call_gc;
          gc_return_lbl = lbl_after_alloc;
          gc_frame_lbl = lbl_frame_lbl } :: env.call_gc_sites
  | Lop(Ipoll { return_label }) ->
      let lbl_frame_lbl = record_frame_label env i.live (Dbg_alloc []) in
      let lbl_after_poll = match return_label with
                  | None -> new_label()
                  | Some(lbl) -> lbl in
      let lbl_call_gc = new_label () in
      let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in
      `	ld	{emit_reg reg_tmp}, {emit_int offset}({emit_reg reg_domain_state_ptr})\n`;
      begin match return_label with
      | None -> `	bltu	{emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl_call_gc}\n`;
                `{emit_label lbl_after_poll}:\n`;
      | Some lbl -> ` bgeu  {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl}\n`;
                    ` j {emit_label lbl_call_gc}\n`
      end;
      env.call_gc_sites <-
        { gc_lbl = lbl_call_gc;
          gc_return_lbl = lbl_after_poll;
          gc_frame_lbl = lbl_frame_lbl } :: env.call_gc_sites
  | Lop(Iintop(Icomp cmp)) ->
      begin match cmp with
      | Isigned Clt ->
          `	slt	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
      | Isigned Cge ->
          `	slt	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
          `	xori	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
      | Isigned Cgt ->
          `	slt	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
      | Isigned Cle ->
          `	slt	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
          `	xori	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
      | Isigned Ceq | Iunsigned Ceq ->
          `	sub	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
          `	seqz	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
      | Isigned Cne | Iunsigned Cne ->
          `	sub	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
          `	snez	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
      | Iunsigned Clt ->
          `	sltu	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
      | Iunsigned Cge ->
          `	sltu	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
          `	xori	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
      | Iunsigned Cgt ->
          `	sltu	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
      | Iunsigned Cle ->
          `	sltu	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
          `	xori	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
      end
  | Lop(Iintop (Icheckbound)) ->
      let lbl = bound_error_label env i.dbg in
      `	bleu	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
  | Lop(Iintop op) ->
      let instr = name_for_intop op in
      `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
  | Lop(Iintop_imm(Isub, n)) ->
      `	addi	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n`
  | Lop(Iintop_imm(op, n)) ->
      let instr = name_for_intop_imm 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_floatop1 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_floatop2 op in
      `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
  | Lop(Ifloatofint) ->
      `	fcvt.d.l	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
  | Lop(Iintoffloat) ->
      `	fcvt.l.d	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, rtz\n`
  | Lop(Iopaque) ->
      assert (i.arg.(0).loc = i.res.(0).loc)
  | Lop(Ispecific sop) ->
      let instr = name_for_specific sop in
      `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`
  | Lreloadretaddr ->
      let n = frame_size env in
      reload_ra n
  | Lreturn ->
      let n = frame_size env in
      emit_stack_adjustment n;
      `	ret\n`
  | Llabel lbl ->
      `{emit_label lbl}:\n`
  | Lbranch lbl ->
      `	j	{emit_label lbl}\n`
  | Lcondbranch(tst, lbl) ->
      begin match tst with
      | Itruetest ->
          `	bnez	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
      | Ifalsetest ->
          `	beqz	{emit_reg i.arg.(0)}, {emit_label lbl}\n`
      | Iinttest cmp ->
          let name = match cmp with
            | Iunsigned Ceq | Isigned Ceq -> "beq"
            | Iunsigned Cne | Isigned Cne -> "bne"
            | Iunsigned Cle -> "bleu" | Isigned Cle -> "ble"
            | Iunsigned Cge -> "bgeu" | Isigned Cge -> "bge"
            | Iunsigned Clt -> "bltu" | Isigned Clt -> "blt"
            | Iunsigned Cgt -> "bgtu" | Isigned Cgt -> "bgt"
          in
          `	{emit_string name}	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
      | Iinttest_imm _ ->
          Misc.fatal_error "Emit.emit_instr (Iinttest_imm _)"
      | Ifloattest cmp ->
          let branch =
            match cmp with
            | CFneq | CFnlt | CFngt | CFnle | CFnge -> "beqz"
            | CFeq | CFlt | CFgt | CFle | CFge -> "bnez"
          in
          begin match cmp with
          | CFeq | CFneq -> `	feq.d	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
          | CFlt | CFnlt -> `	flt.d	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
          | CFgt | CFngt -> `	flt.d	{emit_reg reg_tmp}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
          | CFle | CFnle -> `	fle.d	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
          | CFge | CFnge -> `	fle.d	{emit_reg reg_tmp}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
          end;
          `	{emit_string branch}	{emit_reg reg_tmp}, {emit_label lbl}\n`
      | Ioddtest ->
          `	andi	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, 1\n`;
          `	bnez	{emit_reg reg_tmp}, {emit_label lbl}\n`
      | Ieventest ->
          `	andi	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, 1\n`;
          `	beqz	{emit_reg reg_tmp}, {emit_label lbl}\n`
      end
  | Lcondbranch3(lbl0, lbl1, lbl2) ->
      `	addi	{emit_reg reg_tmp}, {emit_reg i.arg.(0)}, -1\n`;
      begin match lbl0 with
      | None -> ()
      | Some lbl -> `	bltz	{emit_reg reg_tmp}, {emit_label lbl}\n`
      end;
      begin match lbl1 with
      | None -> ()
      | Some lbl -> `	beqz	{emit_reg reg_tmp}, {emit_label lbl}\n`
      end;
      begin match lbl2 with
      | None -> ()
      | Some lbl -> `	bgtz	{emit_reg reg_tmp}, {emit_label lbl}\n`
      end
  | Lswitch jumptbl ->
      (* t0 is marked as destroyed for this operation *)
      let lbl = new_label() in
      `	la	{emit_reg reg_tmp}, {emit_label lbl}\n`;
      `	slli	t0, {emit_reg i.arg.(0)}, 2\n`;
      `	add	{emit_reg reg_tmp}, {emit_reg reg_tmp}, t0\n`;
      `	jr	{emit_reg reg_tmp}\n`;
      `{emit_label lbl}:\n`;
      for i = 0 to Array.length jumptbl - 1 do
        `	j	{emit_label jumptbl.(i)}\n`
      done
  | Lentertrap ->
      ()
  | Ladjust_trap_depth { delta_traps } ->
      (* each trap occupes 16 bytes on the stack *)
      let delta = 16 * delta_traps in
      adjust_stack_offset env delta
  | Lpushtrap {lbl_handler} ->
      `	la	{emit_reg reg_tmp}, {emit_label lbl_handler}\n`;
      `	addi	sp, sp, -16\n`;
      adjust_stack_offset env 16;
      emit_store reg_tmp size_addr;
      emit_store reg_trap 0;
      `	mv	{emit_reg reg_trap}, sp\n`
  | Lpoptrap ->
      emit_load reg_trap 0;
      `	addi	sp, sp, 16\n`;
      adjust_stack_offset env (-16)
  | Lraise k ->
      begin match k with
      | Lambda.Raise_regular ->
          let offset = Domainstate.(idx_of_field Domain_backtrace_pos) * 8 in
          `	sd zero, {emit_int offset}({emit_reg reg_domain_state_ptr})\n`;
          `	{emit_call "caml_raise_exn"}\n`;
          record_frame env Reg.Set.empty (Dbg_raise i.dbg)
      | Lambda.Raise_reraise ->
          `	{emit_call "caml_raise_exn"}\n`;
          record_frame env Reg.Set.empty (Dbg_raise i.dbg)
      | Lambda.Raise_notrace ->
          `	mv	sp, {emit_reg reg_trap}\n`;
	  emit_load reg_tmp size_addr;
	  emit_load reg_trap 0;
          `	addi	sp, sp, 16\n`;
          `	jr	{emit_reg reg_tmp}\n`
      end

(* Emit a sequence of instructions *)

let rec emit_all env = function
  | {desc = Lend} -> () | i -> emit_instr env i; emit_all env i.next

(* Emission of a function declaration *)

let fundecl fundecl =
  let env = mk_env fundecl in
  `	.globl	{emit_symbol fundecl.fun_name}\n`;
  `	.type	{emit_symbol fundecl.fun_name}, @function\n`;
  `	{emit_string code_space}\n`;
  `	.align	2\n`;
  `{emit_symbol fundecl.fun_name}:\n`;
  emit_debug_info fundecl.fun_dbg;
  cfi_startproc();
  emit_all env fundecl.fun_body;
  List.iter emit_call_gc env.call_gc_sites;
  List.iter emit_call_bound_error env.bound_error_sites;
  cfi_endproc();
  `	.size	{emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
  (* Emit the float literals *)
  if env.float_literals <> [] then begin
    `	{emit_string rodata_space}\n`;
    `	.align	3\n`;
    List.iter
      (fun {fl; lbl} ->
        `{emit_label lbl}:\n`;
        emit_float64_directive ".quad" fl)
      env.float_literals;
  end

(* Emission of data *)

let declare_global_data s =
  `	.globl	{emit_symbol s}\n`;
  `	.type	{emit_symbol s}, @object\n`

let emit_item = function
  | Cglobal_symbol s ->
      declare_global_data s
  | Cdefine_symbol s ->
      `{emit_symbol s}:\n`;
  | Cint8 n ->
      `	.byte	{emit_int n}\n`
  | Cint16 n ->
      `	.short	{emit_int n}\n`
  | Cint32 n ->
      `	.long	{emit_nativeint n}\n`
  | Cint n ->
      `	.quad	{emit_nativeint n}\n`
  | Csingle f ->
      emit_float32_directive ".long" (Int32.bits_of_float f)
  | Cdouble f ->
      emit_float64_directive ".quad" (Int64.bits_of_float f)
  | Csymbol_address s ->
      `	.quad	{emit_symbol s}\n`
  | Cstring s ->
      emit_bytes_directive "	.byte	" s
  | Cskip n ->
      if n > 0 then `	.space	{emit_int n}\n`
  | Calign n ->
      `	.align	{emit_int (Misc.log2 n)}\n`

let data l =
  `	{emit_string data_space}\n`;
  List.iter emit_item l

(* Beginning / end of an assembly file *)

let begin_assembly() =
  if !Clflags.dlcode || !Clflags.pic_code then `	.option pic\n`;
  `	.file \"\"\n`; (* PR#7073 *)
  reset_debug_info ();
  (* Emit the beginning of the segments *)
  let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
  `	{emit_string data_space}\n`;
  declare_global_data lbl_begin;
  `{emit_symbol lbl_begin}:\n`;
  let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
  `	{emit_string code_space}\n`;
  declare_global_data lbl_begin;
  `{emit_symbol lbl_begin}:\n`

let end_assembly() =
  `	{emit_string code_space}\n`;
  let lbl_end = Compilenv.make_symbol (Some "code_end") in
  declare_global_data lbl_end;
  `{emit_symbol lbl_end}:\n`;
  `	.long	0\n`;
  `	{emit_string data_space}\n`;
  let lbl_end = Compilenv.make_symbol (Some "data_end") in
  declare_global_data lbl_end;
  `	.quad	0\n`; (* PR#6329 *)
  `{emit_symbol lbl_end}:\n`;
  `	.quad	0\n`;
  (* Emit the frame descriptors *)
  `	{emit_string data_space}\n`; (* not rodata because relocations inside *)
  let lbl = Compilenv.make_symbol (Some "frametable") in
  declare_global_data lbl;
  `{emit_symbol lbl}:\n`;
  emit_frames
    { efa_code_label = (fun l -> `	.quad	{emit_label l}\n`);
      efa_data_label = (fun l -> `	.quad	{emit_label l}\n`);
      efa_8 = (fun n -> `	.byte	{emit_int n}\n`);
      efa_16 = (fun n -> `	.short	{emit_int n}\n`);
      efa_32 = (fun n -> `	.long	{emit_int32 n}\n`);
      efa_word = (fun n -> `	.quad	{emit_int n}\n`);
      efa_align = (fun n -> `	.align	{emit_int (Misc.log2 n)}\n`);
      efa_label_rel = (fun lbl ofs ->
                           `	.long	({emit_label lbl} - .) + {emit_int32 ofs}\n`);
      efa_def_label = (fun l -> `{emit_label l}:\n`);
      efa_string = (fun s -> emit_bytes_directive "	.byte	" (s ^ "\000"))
     }