From 9f75e98d1cad55d1f6e0131e656acc716177e8d5 Mon Sep 17 00:00:00 2001

From: Xavier Leroy <xavier.leroy@inria.fr>

Date: Thu, 18 Jul 2013 16:09:20 +0000

Subject: [PATCH 08/19] Port to the ARM 64-bits (AArch64) architecture

 (experimental). Merge of branch branches/arm64.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@13909 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

(cherry picked from commit 055d5c0379e42b4f561cb1fc5159659d8e9a7b6f)

---

 asmcomp/arm64/arch.ml            | 146 ++++++++

 asmcomp/arm64/emit.mlp           | 742 +++++++++++++++++++++++++++++++++++++++

 asmcomp/arm64/proc.ml            | 212 +++++++++++

 asmcomp/arm64/reload.ml          |  16 +

 asmcomp/arm64/scheduling.ml      |  18 +

 asmcomp/arm64/selection.ml       | 265 ++++++++++++++

 asmcomp/compilenv.ml             |   9 +

 asmcomp/compilenv.mli            |   4 +

 asmrun/arm64.S                   | 535 ++++++++++++++++++++++++++++

 asmrun/signals_osdep.h           |  19 +

 asmrun/stack.h                   |   5 +

 byterun/interp.c                 |   6 +

 configure                        |   5 +-

 otherlibs/num/bng.c              |   6 +-

 otherlibs/num/bng_arm64.c        |  20 ++

 testsuite/tests/asmcomp/Makefile |   2 +-

 testsuite/tests/asmcomp/arm64.S  |  52 +++

 testsuite/tests/asmcomp/main.ml  |   1 +

 18 files changed, 2057 insertions(+), 6 deletions(-)

 create mode 100644 asmcomp/arm64/arch.ml

 create mode 100644 asmcomp/arm64/emit.mlp

 create mode 100644 asmcomp/arm64/proc.ml

 create mode 100644 asmcomp/arm64/reload.ml

 create mode 100644 asmcomp/arm64/scheduling.ml

 create mode 100644 asmcomp/arm64/selection.ml

 create mode 100644 asmrun/arm64.S

 create mode 100644 otherlibs/num/bng_arm64.c

 create mode 100644 testsuite/tests/asmcomp/arm64.S

diff --git a/asmcomp/arm64/arch.ml b/asmcomp/arm64/arch.ml

new file mode 100644

index 0000000..a53251f

--- /dev/null

+++ b/asmcomp/arm64/arch.ml

@@ -0,0 +1,146 @@

+(***********************************************************************)

+(*                                                                     *)

+(*                                OCaml                                *)

+(*                                                                     *)

+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)

+(*                  Benedikt Meurer, University of Siegen              *)

+(*                                                                     *)

+(*    Copyright 2013 Institut National de Recherche en Informatique    *)

+(*    et en Automatique. Copyright 2012 Benedikt Meurer. All rights    *)

+(*    reserved.  This file is distributed  under the terms of the Q    *)

+(*    Public License version 1.0.                                      *)

+(*                                                                     *)

+(***********************************************************************)

+

+let command_line_options = []

+

+(* Specific operations for the ARM processor, 64-bit mode *)

+

+open Format

+

+let command_line_options = []

+

+(* Addressing modes *)

+

+type addressing_mode =

+  | Iindexed of int                     (* reg + displ *)

+  | Ibased of string * int              (* global var + displ *)

+

+(* We do not support the reg + shifted reg addressing mode, because

+   what we really need is reg + shifted reg + displ,

+   and this is decomposed in two instructions (reg + shifted reg -> tmp,

+   then addressing tmp + displ). *)

+

+(* Specific operations *)

+

+type specific_operation =

+  | Ishiftarith of arith_operation * int

+  | Ishiftcheckbound of int

+  | Imuladd       (* multiply and add *)

+  | Imulsub       (* multiply and subtract *)

+  | Inegmulf      (* floating-point negate and multiply *)

+  | Imuladdf      (* floating-point multiply and add *)

+  | Inegmuladdf   (* floating-point negate, multiply and add *)

+  | Imulsubf      (* floating-point multiply and subtract *)

+  | Inegmulsubf   (* floating-point negate, multiply and subtract *)

+  | Isqrtf        (* floating-point square root *)

+  | Ibswap of int (* endianess conversion *)

+

+and arith_operation =

+    Ishiftadd

+  | Ishiftsub

+

+(* Sizes, endianness *)

+

+let big_endian = false

+

+let size_addr = 8

+let size_int = 8

+let size_float = 8

+

+let allow_unaligned_access = false

+

+(* Behavior of division *)

+

+let division_crashes_on_overflow = false

+

+(* Operations on addressing modes *)

+

+let identity_addressing = Iindexed 0

+

+let offset_addressing addr delta =

+  match addr with

+  | Iindexed n -> Iindexed(n + delta)

+  | Ibased(s, n) -> Ibased(s, n + delta)

+

+let num_args_addressing = function

+  | Iindexed n -> 1

+  | Ibased(s, n) -> 0

+

+(* Printing operations and addressing modes *)

+

+let print_addressing printreg addr ppf arg =

+  match addr with

+  | Iindexed n ->

+      printreg ppf arg.(0);

+      if n <> 0 then fprintf ppf " + %i" n

+  | Ibased(s, 0) ->

+      fprintf ppf "\"%s\"" s

+  | Ibased(s, n) ->

+      fprintf ppf "\"%s\" + %i" s n

+

+let print_specific_operation printreg op ppf arg =

+  match op with

+  | Ishiftarith(op, shift) ->

+      let op_name = function

+      | Ishiftadd -> "+"

+      | Ishiftsub -> "-" in

+      let shift_mark =

+       if shift >= 0

+       then sprintf "<< %i" shift

+       else sprintf ">> %i" (-shift) in

+      fprintf ppf "%a %s %a %s"

+       printreg arg.(0) (op_name op) printreg arg.(1) shift_mark

+  | Ishiftcheckbound n ->

+      fprintf ppf "check %a >> %i > %a" printreg arg.(0) n printreg arg.(1)

+  | Imuladd ->

+      fprintf ppf "(%a * %a) + %a"

+        printreg arg.(0)

+        printreg arg.(1)

+        printreg arg.(2)

+  | Imulsub ->

+      fprintf ppf "-(%a * %a) + %a"

+        printreg arg.(0)

+        printreg arg.(1)

+        printreg arg.(2)

+  | Inegmulf ->

+      fprintf ppf "-f (%a *f %a)"

+        printreg arg.(0)

+        printreg arg.(1)

+  | Imuladdf ->

+      fprintf ppf "%a +f (%a *f %a)"

+        printreg arg.(0)

+        printreg arg.(1)

+        printreg arg.(2)

+  | Inegmuladdf ->

+      fprintf ppf "(-f %a) -f (%a *f %a)"

+        printreg arg.(0)

+        printreg arg.(1)

+        printreg arg.(2)

+  | Imulsubf ->

+      fprintf ppf "%a -f (%a *f %a)"

+        printreg arg.(0)

+        printreg arg.(1)

+        printreg arg.(2)

+  | Inegmulsubf ->

+      fprintf ppf "(-f %a) +f (%a *f %a)"

+        printreg arg.(0)

+        printreg arg.(1)

+        printreg arg.(2)

+  | Isqrtf ->

+      fprintf ppf "sqrtf %a"

+        printreg arg.(0)

+  | Ibswap n ->

+      fprintf ppf "bswap%i %a" n

+        printreg arg.(0)

+

diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp

new file mode 100644

index 0000000..fc9649c

--- /dev/null

+++ b/asmcomp/arm64/emit.mlp

@@ -0,0 +1,742 @@

+(***********************************************************************)

+(*                                                                     *)

+(*                                OCaml                                *)

+(*                                                                     *)

+(*            Xavier Leroy, projet Gallium, INRIA Rocquencourt         *)

+(*                  Benedikt Meurer, University of Siegen              *)

+(*                                                                     *)

+(*    Copyright 2013 Institut National de Recherche en Informatique    *)

+(*    et en Automatique. Copyright 2012 Benedikt Meurer. All rights    *)

+(*    reserved.  This file is distributed  under the terms of the Q    *)

+(*    Public License version 1.0.                                      *)

+(*                                                                     *)

+(***********************************************************************)

+

+(* Emission of ARM assembly code, 64-bit mode *)

+

+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

+

+(* Names for special regs *)

+

+let reg_trap_ptr = phys_reg 23

+let reg_alloc_ptr = phys_reg 24

+let reg_alloc_limit = phys_reg 25

+let reg_tmp1 = phys_reg 26

+let reg_tmp2 = phys_reg 27

+let reg_x15 = phys_reg 15

+

+(* Output a label *)

+

+let emit_label lbl =

+  emit_string ".L"; emit_int lbl

+

+let emit_data_label lbl =

+  emit_string ".Ld"; emit_int lbl

+

+(* Symbols *)

+

+let emit_symbol s =

+  Emitaux.emit_symbol '$' s

+

+(* Output a pseudo-register *)

+

+let emit_reg = function

+    {loc = Reg r} -> emit_string (register_name r)

+  | _ -> fatal_error "Emit.emit_reg"

+

+(* Likewise, but with the 32-bit name of the register *)

+

+let int_reg_name_w =

+  [| "w0";  "w1";  "w2";  "w3";  "w4";  "w5";  "w6";  "w7";

+     "w8";  "w9";  "w10"; "w11"; "w12"; "w13"; "w14"; "w15";

+     "w19"; "w20"; "w21"; "w22"; "w23"; "w24"; "w25";

+     "w26"; "w27"; "w28"; "w16"; "w17" |]

+

+let emit_wreg = function

+    {loc = Reg r} -> emit_string int_reg_name_w.(r)

+  | _ -> fatal_error "Emit.emit_wreg"

+

+(* Layout of the stack frame *)

+

+let stack_offset = ref 0

+

+let frame_size () =

+  let sz =

+    !stack_offset +

+    8 * num_stack_slots.(0) +

+    8 * num_stack_slots.(1) +

+    (if !contains_calls then 8 else 0)

+  in Misc.align sz 16

+

+let slot_offset loc cl =

+  match loc with

+    Incoming n ->

+      assert (n >= 0);

+      frame_size() + n

+  | Local n ->

+      !stack_offset +

+      (if cl = 0

+       then n * 8

+       else num_stack_slots.(0) * 8 + n * 8)

+  | Outgoing n ->

+      assert (n >= 0);

+      n

+

+(* Output a stack reference *)

+

+let emit_stack r =

+  match r.loc with

+  | Stack s ->

+      let ofs = slot_offset s (register_class r) in `[sp, #{emit_int ofs}]`

+  | _ -> fatal_error "Emit.emit_stack"

+

+(* Output an addressing mode *)

+

+let emit_symbol_offset s ofs =

+  emit_symbol s; 

+  if ofs > 0 then `+{emit_int ofs}`

+  else if ofs < 0 then `-{emit_int (-ofs)}`

+  else ()

+

+let emit_addressing addr r =

+  match addr with

+  | Iindexed ofs ->

+      `[{emit_reg r}, #{emit_int ofs}]`

+  | Ibased(s, ofs) ->

+      `[{emit_reg r}, #:lo12:{emit_symbol_offset s ofs}]`

+

+(* Record live pointers at call points *)

+

+let record_frame_label live dbg =

+  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;

+      fd_debuginfo = dbg } :: !frame_descriptors;

+  lbl

+

+let record_frame live dbg =

+  let lbl = record_frame_label live dbg in `{emit_label lbl}:`

+

+(* 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_lbl: label }               (* Label of frame descriptor *)

+

+let call_gc_sites = ref ([] : gc_call list)

+

+let emit_call_gc gc =

+  `{emit_label gc.gc_lbl}:	bl	{emit_symbol "caml_call_gc"}\n`;

+  `{emit_label gc.gc_frame_lbl}:	b	{emit_label gc.gc_return_lbl}\n`

+

+(* Record calls to caml_ml_array_bound_error.

+   In debug mode, we maintain one call to caml_ml_array_bound_error

+   per bound check site. Otherwise, we can share a single call. *)

+

+type bound_error_call =

+  { bd_lbl: label;                    (* Entry label *)

+    bd_frame_lbl: label }             (* Label of frame descriptor *)

+

+let bound_error_sites = ref ([] : bound_error_call list)

+

+let bound_error_label dbg =

+  if !Clflags.debug || !bound_error_sites = [] then begin

+    let lbl_bound_error = new_label() in

+    let lbl_frame = record_frame_label Reg.Set.empty dbg in

+    bound_error_sites :=

+      { bd_lbl = lbl_bound_error;

+        bd_frame_lbl = lbl_frame } :: !bound_error_sites;

+    lbl_bound_error

+  end else begin

+    let bd = List.hd !bound_error_sites in bd.bd_lbl

+  end

+

+let emit_call_bound_error bd =

+  `{emit_label bd.bd_lbl}:	bl	{emit_symbol "caml_ml_array_bound_error"}\n`;

+  `{emit_label bd.bd_frame_lbl}:\n`

+

+(* 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 -> "ls"

+  | Iunsigned Cge -> "cs" | Iunsigned Clt -> "cc" | Iunsigned Cgt -> "hi"

+

+let name_for_int_operation = function

+  | Iadd -> "add"

+  | Isub -> "sub"

+  | Imul -> "mul"

+  | Idiv -> "sdiv"

+  | Iand -> "and"

+  | Ior  -> "orr"

+  | Ixor -> "eor"

+  | Ilsl -> "lsl"

+  | Ilsr -> "lsr"

+  | Iasr -> "asr"

+  | _ -> assert false

+

+(* Load an integer constant into a register *)

+

+let emit_intconst dst n =

+  let rec emit_pos first shift =

+    if shift < 0 then begin

+      if first then `	mov	{emit_reg dst}, xzr\n`

+    end else begin

+      let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in

+      if s = 0n then emit_pos first (shift - 16) else begin

+        if first then

+          `	movz	{emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`

+        else

+           `	movk	{emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`;

+        emit_pos false (shift - 16)

+      end

+    end

+  and emit_neg first shift =

+    if shift < 0 then begin

+      if first then `	movn	{emit_reg dst}, #0\n`

+    end else begin

+      let s = Nativeint.(logand (shift_right_logical n shift) 0xFFFFn) in

+      if s = 0xFFFFn then emit_neg first (shift - 16) else begin

+        if first then

+          `	movn	{emit_reg dst}, #{emit_nativeint (Nativeint.logxor s 0xFFFFn)}, lsl #{emit_int shift}\n`

+        else

+           `	movk	{emit_reg dst}, #{emit_nativeint s}, lsl #{emit_int shift}\n`;

+        emit_neg false (shift - 16)

+      end

+    end

+  in

+    if n < 0n then emit_neg true 48 else emit_pos true 48

+

+(* Recognize float constants appropriate for FMOV dst, #fpimm instruction:

+   "a normalized binary floating point encoding with 1 sign bit, 4

+    bits of fraction and a 3-bit exponent" *)

+

+let is_immediate_float bits =

+  let exp = (Int64.(to_int (shift_right_logical bits 52)) land 0x7FF) - 1023 in

+  let mant = Int64.logand bits 0xF_FFFF_FFFF_FFFFL in

+  exp >= -3 && exp <= 4 && Int64.logand mant 0xF_0000_0000_0000L = mant

+

+(* Adjust sp (up or down) by the given byte amount *)

+

+let emit_stack_adjustment n =

+  let instr = if n < 0 then "sub" else "add" in

+  let m = abs n in

+  assert (m < 0x1_000_000);

+  let ml = m land 0xFFF and mh = m land 0xFFF_000 in

+  if mh <> 0 then `	{emit_string instr}	sp, sp, #{emit_int mh}\n`;

+  if ml <> 0 then `	{emit_string instr}	sp, sp, #{emit_int ml}\n`;

+  if n <> 0 then cfi_adjust_cfa_offset (-n)

+

+(* Deallocate the stack frame and reload the return address

+   before a return or tail call *)

+

+let output_epilogue f =

+  let n = frame_size() in

+  if !contains_calls then

+    `	ldr	x30, [sp, #{emit_int (n-8)}]\n`;

+  if n > 0 then

+    emit_stack_adjustment n;

+  f();

+  (* reset CFA back because function body may continue *)

+  if n > 0 then cfi_adjust_cfa_offset n

+

+(* Name of current function *)

+let function_name = ref ""

+(* Entry point for tail recursive calls *)

+let tailrec_entry_point = ref 0

+(* Pending floating-point literals *)

+let float_literals = ref ([] : (int64 * label) list)

+

+(* Label a floating-point literal *)

+let float_literal f =

+  try

+    List.assoc f !float_literals

+  with Not_found ->

+    let lbl = new_label() in

+    float_literals := (f, lbl) :: !float_literals;

+    lbl

+

+(* Emit all pending literals *)

+let emit_literals() =

+  if !float_literals <> [] then begin

+    `	.align	3\n`;

+    List.iter

+      (fun (f, lbl) ->

+        `{emit_label lbl}:	.quad	`; emit_printf "0x%Lx\n" f)

+      !float_literals;

+    float_literals := []

+  end

+

+(* Emit code to load the address of a symbol *)

+

+let emit_load_symbol_addr dst s =

+  if (not !Clflags.dlcode) || Compilenv.symbol_in_current_unit s then begin

+    `	adrp	{emit_reg dst}, {emit_symbol s}\n`;

+    `	add	{emit_reg dst}, {emit_reg dst}, #:lo12:{emit_symbol s}\n`

+  end else begin

+    `	adrp	{emit_reg dst}, :got:{emit_symbol s}\n`;

+    `	ldr	{emit_reg dst}, [{emit_reg dst}, #:got_lo12:{emit_symbol s}]\n`

+  end

+

+(* Output the assembly code for an instruction *)

+

+let emit_instr i =

+    emit_debug_info i.dbg;

+    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 _; typ = Float}, {loc = Reg _} ->

+              `	fmov	{emit_reg dst}, {emit_reg src}\n`

+          | {loc = Reg _}, {loc = Reg _} ->

+              `	mov	{emit_reg dst}, {emit_reg src}\n`

+          | {loc = Reg _}, {loc = Stack _} ->

+              `	str	{emit_reg src}, {emit_stack dst}\n`

+          | {loc = Stack _}, {loc = Reg _} ->

+              `	ldr	{emit_reg dst}, {emit_stack src}\n`

+          | _ ->

+              assert false

+        end

+    | Lop(Iconst_int n) ->

+        emit_intconst i.res.(0) n

+    | Lop(Iconst_float f) ->

+        let b = Int64.bits_of_float(float_of_string f) in

+        if b = 0L then

+          `	fmov	{emit_reg i.res.(0)}, xzr	/* {emit_string f} */\n`

+        else if is_immediate_float b then

+          `	fmov	{emit_reg i.res.(0)}, #{emit_printf "0x%Lx" b}	/* {emit_string f} */\n`

+        else begin

+          let lbl = float_literal b in

+          `	adrp	{emit_reg reg_tmp1}, {emit_label lbl}\n`;

+          `	ldr	{emit_reg i.res.(0)}, [{emit_reg reg_tmp1}, #:lo12:{emit_label lbl}]	/* {emit_string f} */\n`

+        end

+    | Lop(Iconst_symbol s) ->

+        emit_load_symbol_addr i.res.(0) s

+    | Lop(Icall_ind) ->

+        `	blr	{emit_reg i.arg.(0)}\n`;

+        `{record_frame i.live i.dbg}\n`

+    | Lop(Icall_imm s) ->

+        `	bl	{emit_symbol s}\n`;

+        `{record_frame i.live i.dbg}\n`

+    | Lop(Itailcall_ind) ->

+        output_epilogue (fun () -> `	br	{emit_reg i.arg.(0)}\n`)

+    | Lop(Itailcall_imm s) ->

+        if s = !function_name then

+          `	b	{emit_label !tailrec_entry_point}\n`

+        else

+          output_epilogue (fun () -> `	b	{emit_symbol s}\n`)

+    | Lop(Iextcall(s, false)) ->

+        `	bl	{emit_symbol s}\n`

+    | Lop(Iextcall(s, true)) ->

+        emit_load_symbol_addr reg_x15 s;

+        `	bl	{emit_symbol "caml_c_call"}\n`;

+        `{record_frame i.live i.dbg}\n`

+    | Lop(Istackoffset n) ->

+        assert (n mod 16 = 0);

+        emit_stack_adjustment (-n);

+        stack_offset := !stack_offset + n

+    | Lop(Iload(size, addr)) ->

+        let dst = i.res.(0) in

+        let base =

+          match addr with

+          | Iindexed ofs -> i.arg.(0)

+          | Ibased(s, ofs) ->

+              `	adrp	{emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`;

+              reg_tmp1 in

+        begin match size with

+        | Byte_unsigned ->

+            `	ldrb	{emit_wreg dst}, {emit_addressing addr base}\n`

+        | Byte_signed ->

+            `	ldrsb	{emit_reg dst}, {emit_addressing addr base}\n`

+        | Sixteen_unsigned ->

+            `	ldrh	{emit_wreg dst}, {emit_addressing addr base}\n`

+        | Sixteen_signed ->

+            `	ldrsh	{emit_reg dst}, {emit_addressing addr base}\n`

+        | Thirtytwo_unsigned ->

+            `	ldr	{emit_wreg dst}, {emit_addressing addr base}\n`

+        | Thirtytwo_signed ->

+            `	ldrsw	{emit_reg dst}, {emit_addressing addr base}\n`

+        | Single ->

+            `	ldr	s7, {emit_addressing addr base}\n`;

+            `	fcvt	{emit_reg dst}, s7\n`

+        | Word | Double | Double_u ->

+            `	ldr	{emit_reg dst}, {emit_addressing addr base}\n`

+        end

+    | Lop(Istore(size, addr)) ->

+        let src = i.arg.(0) in

+        let base =

+          match addr with

+          | Iindexed ofs -> i.arg.(1)

+          | Ibased(s, ofs) ->

+              `	adrp	{emit_reg reg_tmp1}, {emit_symbol_offset s ofs}\n`;

+              reg_tmp1 in

+        begin match size with

+        | Byte_unsigned | Byte_signed ->

+            `	strb	{emit_wreg src}, {emit_addressing addr base}\n`

+        | Sixteen_unsigned | Sixteen_signed ->

+            `	strh	{emit_wreg src}, {emit_addressing addr base}\n`

+        | Thirtytwo_unsigned | Thirtytwo_signed ->

+            `	str	{emit_wreg src}, {emit_addressing addr base}\n`

+        | Single ->

+            `	fcvt	s7, {emit_reg src}\n`;

+            `	str	s7, {emit_addressing addr base}\n`;

+        | Word | Double | Double_u ->

+            `	str	{emit_reg src}, {emit_addressing addr base}\n`

+        end

+    | Lop(Ialloc n) ->

+        let lbl_frame = record_frame_label i.live i.dbg in

+        if !fastcode_flag then begin

+          let lbl_redo = new_label() in

+          let lbl_call_gc = new_label() in

+          `{emit_label lbl_redo}:`;

+          `	sub	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int n}\n`;

+          `	cmp	{emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_limit}\n`;

+          `	add	{emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`;

+          `	b.lo	{emit_label lbl_call_gc}\n`;

+          call_gc_sites :=

+            { gc_lbl = lbl_call_gc;

+              gc_return_lbl = lbl_redo;

+              gc_frame_lbl = lbl_frame } :: !call_gc_sites

+        end else begin

+          begin match n with

+          | 16 -> `	bl	{emit_symbol "caml_alloc1"}\n`

+          | 24 -> `	bl	{emit_symbol "caml_alloc2"}\n`

+          | 32 -> `	bl	{emit_symbol "caml_alloc3"}\n`

+          | _  -> emit_intconst reg_x15 (Nativeint.of_int n);

+                  `	bl	{emit_symbol "caml_allocN"}\n`

+          end;

+          `{emit_label lbl_frame}:	add	{emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, #8\n`

+        end

+    | Lop(Iintop(Icomp cmp)) ->

+        `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;

+        `	cset	{emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`

+    | Lop(Iintop_imm(Icomp cmp, n)) ->

+        `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;

+        `	cset	{emit_reg i.res.(0)}, {emit_string (name_for_comparison cmp)}\n`

+    | Lop(Iintop Icheckbound) ->

+        let lbl = bound_error_label i.dbg in

+        `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;

+        `	b.ls	{emit_label lbl}\n`

+    | Lop(Iintop_imm(Icheckbound, n)) ->

+        let lbl = bound_error_label i.dbg in

+        `	cmp	{emit_reg i.arg.(0)}, #{emit_int n}\n`;

+        `	b.ls	{emit_label lbl}\n`

+    | Lop(Ispecific(Ishiftcheckbound shift)) ->

+        let lbl = bound_error_label i.dbg in

+        `	cmp	{emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}, lsr #{emit_int shift}\n`;

+        `	b.cs	{emit_label lbl}\n`

+    | Lop(Iintop Imod) ->

+        `	sdiv	{emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;

+        `	msub	{emit_reg i.res.(0)}, {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`

+    | Lop(Iintop_imm(Idiv, n)) -> (* n is a power of 2 *)

+        let l = Misc.log2 n in

+        `	asr	{emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, #63\n`;

+        `	add	{emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, lsr {emit_int (64-l)}\n`;

+        `	asr	{emit_reg i.res.(0)}, {emit_reg reg_tmp1}, {emit_int l}\n`

+    | Lop(Iintop_imm(Imod, n)) -> (* n is a power of 2 *)

+        let l = Misc.log2 n in

+        `	asr	{emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, #63\n`;

+        `	add	{emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, lsr {emit_int (64-l)}\n`;

+        `	asr	{emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_int l}\n`;

+        `	sub	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, lsl {emit_int l}\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(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(Ifloatofint | Iintoffloat | Iabsf | Inegf | Ispecific Isqrtf as op) ->

+        let instr = (match op with

+                     | Ifloatofint      -> "scvtf"

+                     | Iintoffloat      -> "fcvtzs"

+                     | Iabsf            -> "fabs"

+                     | Inegf            -> "fneg"

+                     | Ispecific Isqrtf -> "fsqrt"

+                     | _                -> assert false) in

+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`

+    | Lop(Iaddf | Isubf | Imulf | Idivf | Ispecific Inegmulf as op) ->

+        let instr = (match op with

+                     | Iaddf              -> "fadd"

+                     | Isubf              -> "fsub"

+                     | Imulf              -> "fmul"

+                     | Idivf              -> "fdiv"

+                     | Ispecific Inegmulf -> "fnmul"

+                     | _                  -> assert false) in

+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`

+    | Lop(Ispecific(Imuladdf | Inegmuladdf | Imulsubf | Inegmulsubf as op)) ->

+        let instr = (match op with

+                     | Imuladdf    -> "fmadd"

+                     | Inegmuladdf -> "fnmadd"

+                     | Imulsubf    -> "fmsub"

+                     | Inegmulsubf -> "fnmsub"

+                     | _ -> assert false) in

+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}, {emit_reg i.arg.(0)}\n`

+    | Lop(Ispecific(Ishiftarith(op, shift))) ->

+        let instr = (match op with

+                       Ishiftadd    -> "add"

+                     | Ishiftsub    -> "sub") in

+        `	{emit_string instr}	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}`;

+        if shift >= 0

+        then `, lsl #{emit_int shift}\n`

+        else `, asr #{emit_int (-shift)}\n`

+    | Lop(Ispecific(Imuladd | Imulsub as op)) ->

+        let instr = (match op with

+                       Imuladd -> "madd"

+                     | Imulsub -> "msub"

+                     | _ -> assert false) 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(Ispecific(Ibswap size)) ->

+        begin match size with

+        | 16 ->

+            `	rev16	{emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n`;

+            `	ubfm	{emit_reg i.res.(0)}, {emit_reg i.res.(0)}, #0, #16\n`

+        | 32 ->

+            `	rev	{emit_wreg i.res.(0)}, {emit_wreg i.arg.(0)}\n`

+        | 64 ->

+            `	rev	{emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`

+        | _ ->