(**************************************************************************)
(*                                                                        *)
(*                                 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 C stack must be 16-aligned, but 8-alignment
   is enough for the OCaml stack. *)

let frame_size env =
  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_frame_required then size_addr else 0) (* Return address *)

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_jump op s =
  if !Clflags.dlcode
  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 rodata_space =
  ".section .rodata"

let emit_named_text_section func_name =
  Emitaux.emit_named_text_section func_name '@'

(* Names for special regs *)

let reg_tmp = phys_reg 23 (* t1 *)
let reg_tmp2 = phys_reg 22 (* t0 *)
let reg_t2 = phys_reg 16 (* t2 *)
let reg_domain_state_ptr = phys_reg 26 (* s11 *)
let reg_trap_ptr = phys_reg 24 (* s1 *)
let reg_alloc_ptr = phys_reg 25 (* s10 *)
let reg_stack_arg_begin = phys_reg 9 (* s3 *)
let reg_stack_arg_end = phys_reg 10 (* s4 *)

(* 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, clobbers reg_tmp *)

let emit_stack_adjustment n =
  if n <> 0 then begin
    if is_immediate n then
      `	addi	sp, sp, {emit_int n}\n`
    else begin
      `	li	{emit_reg reg_tmp}, {emit_int n}\n`;
      `	add	sp, sp, {emit_reg reg_tmp}\n`
    end;
    cfi_adjust_cfa_offset (-n)
  end

(* Output add-immediate instruction, clobbers reg_tmp2 *)

let emit_addimm rd rs n =
  if is_immediate n then
    `	addi	{emit_reg rd}, {emit_reg rs}, {emit_int n}\n`
  else begin
    `	li	{emit_reg reg_tmp2}, {emit_int n}\n`;
    `	add	{emit_reg rd}, {emit_reg rs}, {emit_reg reg_tmp2}\n`
  end

(* Output memory operation with a possibly non-immediate offset,
   clobbers reg_tmp *)

let emit_mem_op op reg ofs addr =
  if is_immediate ofs then
    `	{emit_string op}	{emit_string reg}, {emit_int ofs}({emit_string addr})\n`
  else begin
    `	li	{emit_reg reg_tmp}, {emit_int ofs}\n`;
    `	add	{emit_reg reg_tmp}, {emit_string addr}, {emit_reg reg_tmp}\n`;
    `	{emit_string op}	{emit_string reg}, 0({emit_reg reg_tmp})\n`
  end

let reload_ra n =
  emit_mem_op "ld" "ra" (n - 8) "sp"

let store_ra n =
  emit_mem_op "sd" "ra" (n - 8) "sp"

let emit_store rs ofs rd =
  emit_mem_op "sd" (reg_name rs) ofs rd

let emit_load rd ofs rs =
  emit_mem_op "ld" (reg_name rd) ofs rs

let emit_float_load rd ofs rs =
  emit_mem_op "fld" (reg_name rd) ofs rs

let emit_float_store rs ofs rd =
  emit_mem_op "fsd" (reg_name rs) ofs rd

let emit_float_test cmp ~arg ~res =
  let negated =
    match cmp with
    | CFneq | CFnlt | CFngt | CFnle | CFnge -> true
    | CFeq | CFlt | CFgt | CFle | CFge -> false
  in
  begin match cmp with
  | CFeq | CFneq -> `	feq.d	{emit_reg res}, {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`
  | CFlt | CFnlt -> `	flt.d	{emit_reg res}, {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`
  | CFgt | CFngt -> `	flt.d	{emit_reg res}, {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`
  | CFle | CFnle -> `	fle.d	{emit_reg res}, {emit_reg arg.(0)}, {emit_reg arg.(1)}\n`
  | CFge | CFnge -> `	fle.d	{emit_reg res}, {emit_reg arg.(1)}, {emit_reg arg.(0)}\n`
  end;
  negated

(* 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 ->
      let n = frame_size env in
      emit_stack_adjustment (-n);
      if env.f.fun_frame_required then begin
        store_ra n;
        cfi_offset ~reg:1 (* ra *) ~offset:(-8)
      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 src ofs base
        | {loc = Reg _; typ = Float}, {loc = Stack s} ->
            let (base, ofs) = slot_offset env s (register_class dst) in
            emit_float_store src ofs base
        | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} ->
            let (base, ofs) = slot_offset env s (register_class src) in
            emit_load dst ofs base
        | {loc = Stack s; typ = Float}, {loc = Reg _} ->
            let (base, ofs) = slot_offset env s (register_class src) in
            emit_float_load dst ofs base
        | {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_frame_required 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_frame_required then reload_ra n;
        emit_stack_adjustment n;
        `	{emit_tail func}\n`
      end
  | Lop(Iextcall{func; alloc; stack_ofs}) ->
      if stack_ofs > 0 then begin
        `	mv	{emit_reg reg_stack_arg_begin}, sp\n`;
        `	addi	{emit_reg reg_stack_arg_end}, sp, {emit_int (Misc.align stack_ofs 16)}\n`;
        `	la	{emit_reg reg_t2}, {emit_symbol func}\n`;
        `	{emit_call "caml_c_call_stack_args"}\n`;
        record_frame env i.live (Dbg_other i.dbg)
      end else if alloc then begin
        `	la	{emit_reg reg_t2}, {emit_symbol func}\n`;
        `	{emit_call "caml_c_call"}\n`;
        record_frame env i.live (Dbg_other i.dbg)
      end else begin
        (* store ocaml stack in s0, which is marked as being destroyed
           at noalloc calls *)
        `	mv	s0, sp\n`;
        cfi_remember_state ();
        cfi_def_cfa_register ~reg:8;
        let ofs = Domainstate.(idx_of_field Domain_c_stack) * 8 in
        `	ld	sp, {emit_int ofs}({emit_reg reg_domain_state_ptr})\n`;
        `	{emit_call func}\n`;
        `	mv	sp, s0\n`;
        cfi_restore_state ()
      end
  | Lop(Istackoffset n) ->
      assert (n mod 16 = 0);
      emit_stack_adjustment (-n);
      env.stack_offset <- env.stack_offset + n
  | Lop(Iload { memory_chunk = Single; addressing_mode = Iindexed ofs; is_atomic } ) ->
      assert (not is_atomic);
      `	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 { memory_chunk = Sixtyfour | Word_int | Word_val; addressing_mode = Iindexed ofs; is_atomic } ) ->
      if is_atomic then `	fence	rw, rw\n`;
      `	ld	{emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`;
      if is_atomic then `	fence	r, rw\n`
  | Lop(Iload { memory_chunk; addressing_mode = Iindexed ofs; is_atomic } ) ->
      assert (not is_atomic);
      let instr =
        match memory_chunk with
        | Byte_unsigned -> "lbu"
        | Byte_signed -> "lb"
        | Sixteen_unsigned -> "lhu"
        | Sixteen_signed -> "lh"
        | Thirtytwo_unsigned -> "lwu"
        | Thirtytwo_signed -> "lw"
        | Word_int | Word_val | Single | Sixtyfour -> 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((Word_int | Word_val), Iindexed ofs, assignment)) ->
      if assignment then begin
        `	fence	r, w\n`;
        `	sd	{emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`
      end else
        `	sd	{emit_reg i.arg.(0)}, {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 | Single -> assert false
        | Sixtyfour -> "sd"
        | 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
      if env.f.fun_fast then begin
        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
        emit_addimm reg_alloc_ptr reg_alloc_ptr n;
        `	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}, 8\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
      end else begin
        begin match bytes with
        | 16 -> `	{emit_call "caml_alloc1"}\n`
        | 24 -> `	{emit_call "caml_alloc2"}\n`
        | 32 -> `	{emit_call "caml_alloc3"}\n`
        | _  ->
            `	li	{emit_reg reg_t2}, {emit_int bytes}\n`;
            `	{emit_call "caml_allocN"}\n`
        end;
        `{emit_label lbl_frame_lbl}:\n`;
        `	addi	{emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, 8\n`
      end
  | 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(Icompf cmp) ->
      let negated = emit_float_test cmp ~res:i.res.(0) ~arg:i.arg in
      if negated then `	xori	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
  | 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`
  | Lop (Idls_get) ->
      let ofs = Domainstate.(idx_of_field Domain_dls_root) * 8 in
      `	ld	{emit_reg i.res.(0)}, {emit_int ofs}({emit_reg reg_domain_state_ptr})\n`
  | Lop (Ireturn_addr) ->
      let n = frame_size env in
      if env.f.fun_frame_required then
        `	ld	{emit_reg i.res.(0)}, {emit_int (n - 8)}(sp)\n`
      else
        `	mv	{emit_reg i.res.(0)}, ra\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 negated = emit_float_test cmp ~arg:i.arg ~res:reg_tmp in
          let branch =
            if negated
            then "beqz"
            else "bnez"
          in
          `	{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 ->
      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
      cfi_adjust_cfa_offset delta;
      env.stack_offset <- env.stack_offset + delta
  | Lpushtrap {lbl_handler} ->
      `	la	{emit_reg reg_tmp}, {emit_label lbl_handler}\n`;
      `	addi	sp, sp, -16\n`;
      env.stack_offset <- env.stack_offset + 16;
      `	sd	{emit_reg reg_trap_ptr}, 0(sp)\n`;
      `	sd	{emit_reg reg_tmp}, 8(sp)\n`;
      cfi_adjust_cfa_offset 16;
      `	mv	{emit_reg reg_trap_ptr}, sp\n`
  | Lpoptrap ->
      `	ld	{emit_reg reg_trap_ptr}, 0(sp)\n`;
      `	addi	sp, sp, 16\n`;
      cfi_adjust_cfa_offset (-16);
      env.stack_offset <- env.stack_offset - 16
  | Lraise k ->
      begin match k with
      | Lambda.Raise_regular ->
          `	{emit_call "caml_raise_exn"}\n`;
          record_frame env Reg.Set.empty (Dbg_raise i.dbg)
      | Lambda.Raise_reraise ->
          `	{emit_call "caml_reraise_exn"}\n`;
          record_frame env Reg.Set.empty (Dbg_raise i.dbg)
      | Lambda.Raise_notrace ->
          `	mv	sp, {emit_reg reg_trap_ptr}\n`;
          `	ld	{emit_reg reg_tmp}, 8(sp)\n`;
          `	ld	{emit_reg reg_trap_ptr}, 0(sp)\n`;
          `	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`;
  emit_type_directive fundecl.fun_name "@function";
  emit_named_text_section fundecl.fun_name;
  `	.align	2\n`;
  `{emit_symbol fundecl.fun_name}:\n`;
  emit_debug_info fundecl.fun_dbg;
  cfi_startproc();

  (* Dynamic stack checking *)
  let stack_threshold_size = Config.stack_threshold * 8 in (* bytes *)
  let max_frame_size = frame_size env + fundecl.fun_extra_stack_used in
  let handle_overflow =
    if fundecl.fun_contains_nontail_calls
    || max_frame_size >= stack_threshold_size then begin
      let overflow = new_label () and ret = new_label () in
      let threshold_offset = Domainstate.stack_ctx_words * 8 + stack_threshold_size in
      let f = max_frame_size + threshold_offset in
      let offset = Domainstate.(idx_of_field Domain_current_stack) * 8 in
      `	ld	{emit_reg reg_tmp}, {emit_int offset}({emit_reg reg_domain_state_ptr})\n`;
      emit_addimm reg_tmp reg_tmp f;
      `	bltu	sp, {emit_reg reg_tmp}, {emit_label overflow}\n`;
      `{emit_label ret}:\n`;
      Some (overflow, ret)
    end else None
  in

  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;

  begin match handle_overflow with
  | None -> ()
  | Some (overflow, ret) ->
      `{emit_label overflow}:\n`;
      (* Pass the desired frame size on the stack, since all of the
         argument-passing registers may be in use. *)
      let s = Config.stack_threshold + max_frame_size / 8 in
      `	li	{emit_reg reg_tmp}, {emit_int s}\n`;
      `	addi	sp, sp, -16\n`;
      `	sd	{emit_reg reg_tmp}, 0(sp)\n`;
      `	sd	ra, 8(sp)\n`;
      `	{emit_call "caml_call_realloc_stack"}\n`;
      `	ld	ra, 8(sp)\n`;
      `	addi	sp, sp, 16\n`;
      `	j	{emit_label ret}\n`
  end;

  cfi_endproc();
  emit_size_directive fundecl.fun_name;
  (* 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`;
  emit_type_directive s "@object"

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 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_named_text_section lbl_begin;
  declare_global_data lbl_begin;
  `{emit_symbol lbl_begin}:\n`

let end_assembly() =
  let lbl_end = Compilenv.make_symbol (Some "code_end") in
  emit_named_text_section lbl_end;
  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"))
     };
  emit_size_directive lbl;
  emit_nonexecstack_note ()