|
 |
770ba2 |
From 38ac4778744fb7137e04708998d4e856ada1c8b8 Mon Sep 17 00:00:00 2001
|
|
|
770ba2 |
From: Nicolas Ojeda Bar <n.oje.bar@gmail.com>
|
|
|
770ba2 |
Date: Fri, 27 Oct 2017 17:05:25 +0200
|
|
|
770ba2 |
Subject: [PATCH 4/8] Add RISC-V backend
|
|
|
770ba2 |
|
|
|
770ba2 |
---
|
|
|
770ba2 |
README.adoc | 1 +
|
|
|
770ba2 |
asmcomp/riscv/CSE.ml | 36 ++
|
|
|
770ba2 |
asmcomp/riscv/arch.ml | 87 +++++
|
|
|
770ba2 |
asmcomp/riscv/emit.mlp | 653 ++++++++++++++++++++++++++++++++++++
|
|
|
770ba2 |
asmcomp/riscv/proc.ml | 301 +++++++++++++++++
|
|
|
770ba2 |
asmcomp/riscv/reload.ml | 16 +
|
|
|
770ba2 |
asmcomp/riscv/scheduling.ml | 19 ++
|
|
|
770ba2 |
asmcomp/riscv/selection.ml | 72 ++++
|
|
|
770ba2 |
asmrun/riscv.S | 424 +++++++++++++++++++++++
|
|
|
770ba2 |
byterun/caml/stack.h | 5 +
|
|
|
770ba2 |
config/gnu/config.guess | 5 +-
|
|
|
770ba2 |
configure | 5 +-
|
|
|
770ba2 |
12 files changed, 1622 insertions(+), 2 deletions(-)
|
|
|
770ba2 |
create mode 100644 asmcomp/riscv/CSE.ml
|
|
|
770ba2 |
create mode 100644 asmcomp/riscv/arch.ml
|
|
|
770ba2 |
create mode 100644 asmcomp/riscv/emit.mlp
|
|
|
770ba2 |
create mode 100644 asmcomp/riscv/proc.ml
|
|
|
770ba2 |
create mode 100644 asmcomp/riscv/reload.ml
|
|
|
770ba2 |
create mode 100644 asmcomp/riscv/scheduling.ml
|
|
|
770ba2 |
create mode 100644 asmcomp/riscv/selection.ml
|
|
|
770ba2 |
create mode 100644 asmrun/riscv.S
|
|
|
770ba2 |
|
|
|
770ba2 |
diff --git a/README.adoc b/README.adoc
|
|
|
770ba2 |
index 74d1ec258..ac6c6eac3 100644
|
|
|
770ba2 |
--- a/README.adoc
|
|
|
770ba2 |
+++ b/README.adoc
|
|
|
770ba2 |
@@ -47,6 +47,7 @@ AMD64:: FreeBSD, OpenBSD, NetBSD
|
|
|
770ba2 |
IA32 (Pentium):: NetBSD, OpenBSD, Solaris 9
|
|
|
770ba2 |
PowerPC:: NetBSD
|
|
|
770ba2 |
ARM:: NetBSD
|
|
|
770ba2 |
+RISC-V:: Linux
|
|
|
770ba2 |
|
|
|
770ba2 |
Other operating systems for the processors above have not been tested, but
|
|
|
770ba2 |
the compiler may work under other operating systems with little work.
|
|
|
770ba2 |
diff --git a/asmcomp/riscv/CSE.ml b/asmcomp/riscv/CSE.ml
|
|
|
770ba2 |
new file mode 100644
|
|
|
770ba2 |
index 000000000..302811a99
|
|
|
770ba2 |
--- /dev/null
|
|
|
770ba2 |
+++ b/asmcomp/riscv/CSE.ml
|
|
|
770ba2 |
@@ -0,0 +1,36 @@
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* OCaml *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Nicolas Ojeda Bar <n.oje.bar@gmail.com> *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Copyright 2106 Institut National de Recherche en Informatique et *)
|
|
|
770ba2 |
+(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
770ba2 |
+(* under the terms of the Q Public License version 1.0. *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* CSE for the RISC-V *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+open Arch
|
|
|
770ba2 |
+open Mach
|
|
|
770ba2 |
+open CSEgen
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+class cse = object (_self)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+inherit cse_generic as super
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+method! class_of_operation op =
|
|
|
770ba2 |
+ match op with
|
|
|
770ba2 |
+ | Ispecific(Imultaddf _ | Imultsubf _) -> Op_pure
|
|
|
770ba2 |
+ | _ -> super#class_of_operation op
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+method! is_cheap_operation op =
|
|
|
770ba2 |
+ match op with
|
|
|
770ba2 |
+ | Iconst_int n -> n <= 0x7FFn && n >= -0x800n
|
|
|
770ba2 |
+ | _ -> false
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+end
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let fundecl f =
|
|
|
770ba2 |
+ (new cse)#fundecl f
|
|
|
770ba2 |
diff --git a/asmcomp/riscv/arch.ml b/asmcomp/riscv/arch.ml
|
|
|
770ba2 |
new file mode 100644
|
|
|
770ba2 |
index 000000000..22c807c49
|
|
|
770ba2 |
--- /dev/null
|
|
|
770ba2 |
+++ b/asmcomp/riscv/arch.ml
|
|
|
770ba2 |
@@ -0,0 +1,87 @@
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* OCaml *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Nicolas Ojeda Bar <n.oje.bar@gmail.com> *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Copyright 2016 Institut National de Recherche en Informatique et *)
|
|
|
770ba2 |
+(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
770ba2 |
+(* under the terms of the Q Public License version 1.0. *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Specific operations for the RISC-V processor *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+open Format
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Machine-specific command-line options *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let command_line_options = []
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Specific operations *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+type specific_operation =
|
|
|
770ba2 |
+ | Imultaddf of bool (* multiply, optionally negate, and add *)
|
|
|
770ba2 |
+ | Imultsubf of bool (* multiply, optionally negate, and subtract *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let spacetime_node_hole_pointer_is_live_before = function
|
|
|
770ba2 |
+ | Imultaddf _ | Imultsubf _ -> false
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Addressing modes *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+type addressing_mode =
|
|
|
770ba2 |
+ | Iindexed of int (* reg + displ *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let is_immediate n =
|
|
|
770ba2 |
+ (n <= 2047) && (n >= -2048)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Sizes, endianness *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let big_endian = false
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let rv64 =
|
|
|
770ba2 |
+ match Config.model with "riscv64" -> true | "riscv32" -> false | _ -> assert false
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let size_addr = if rv64 then 8 else 4
|
|
|
770ba2 |
+let size_int = size_addr
|
|
|
770ba2 |
+let size_float = 8
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let allow_unaligned_access = false
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Behavior of division *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let division_crashes_on_overflow = false
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Operations on addressing modes *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let identity_addressing = Iindexed 0
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let offset_addressing addr delta =
|
|
|
770ba2 |
+ match addr with
|
|
|
770ba2 |
+ | Iindexed n -> Iindexed(n + delta)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let num_args_addressing = function
|
|
|
770ba2 |
+ | Iindexed _ -> 1
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Printing operations and addressing modes *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let print_addressing printreg addr ppf arg =
|
|
|
770ba2 |
+ match addr with
|
|
|
770ba2 |
+ | Iindexed n ->
|
|
|
770ba2 |
+ let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
|
|
|
770ba2 |
+ fprintf ppf "%a%s" printreg arg.(0) idx
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let print_specific_operation printreg op ppf arg =
|
|
|
770ba2 |
+ match op with
|
|
|
770ba2 |
+ | Imultaddf false ->
|
|
|
770ba2 |
+ fprintf ppf "%a *f %a +f %a"
|
|
|
770ba2 |
+ printreg arg.(0) printreg arg.(1) printreg arg.(2)
|
|
|
770ba2 |
+ | Imultaddf true ->
|
|
|
770ba2 |
+ fprintf ppf "-f (%a *f %a +f %a)"
|
|
|
770ba2 |
+ printreg arg.(0) printreg arg.(1) printreg arg.(2)
|
|
|
770ba2 |
+ | Imultsubf false ->
|
|
|
770ba2 |
+ fprintf ppf "%a *f %a -f %a"
|
|
|
770ba2 |
+ printreg arg.(0) printreg arg.(1) printreg arg.(2)
|
|
|
770ba2 |
+ | Imultsubf true ->
|
|
|
770ba2 |
+ fprintf ppf "-f (%a *f %a -f %a)"
|
|
|
770ba2 |
+ printreg arg.(0) printreg arg.(1) printreg arg.(2)
|
|
|
770ba2 |
diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp
|
|
|
770ba2 |
new file mode 100644
|
|
|
770ba2 |
index 000000000..51165d0f1
|
|
|
770ba2 |
--- /dev/null
|
|
|
770ba2 |
+++ b/asmcomp/riscv/emit.mlp
|
|
|
770ba2 |
@@ -0,0 +1,653 @@
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* OCaml *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Nicolas Ojeda Bar <n.oje.bar@gmail.com> *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Copyright 2016 Institut National de Recherche en Informatique et *)
|
|
|
770ba2 |
+(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
770ba2 |
+(* under the terms of the Q Public License version 1.0. *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Emission of RISC-V assembly code *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+open Misc
|
|
|
770ba2 |
+open Cmm
|
|
|
770ba2 |
+open Arch
|
|
|
770ba2 |
+open Proc
|
|
|
770ba2 |
+open Reg
|
|
|
770ba2 |
+open Mach
|
|
|
770ba2 |
+open Linearize
|
|
|
770ba2 |
+open Emitaux
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Layout of the stack. The stack is kept 16-aligned. *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let stack_offset = ref 0
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let frame_size () =
|
|
|
770ba2 |
+ let size =
|
|
|
770ba2 |
+ !stack_offset + (* Trap frame, outgoing parameters *)
|
|
|
770ba2 |
+ size_int * num_stack_slots.(0) + (* Local int variables *)
|
|
|
770ba2 |
+ size_float * num_stack_slots.(1) + (* Local float variables *)
|
|
|
770ba2 |
+ (if !contains_calls then size_addr else 0) in (* The return address *)
|
|
|
770ba2 |
+ Misc.align size 16
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let slot_offset loc cls =
|
|
|
770ba2 |
+ match loc with
|
|
|
770ba2 |
+ | Local n ->
|
|
|
770ba2 |
+ if cls = 0
|
|
|
770ba2 |
+ then !stack_offset + num_stack_slots.(1) * size_float + n * size_int
|
|
|
770ba2 |
+ else !stack_offset + n * size_float
|
|
|
770ba2 |
+ | Incoming n -> frame_size() + n
|
|
|
770ba2 |
+ | Outgoing n -> n
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Output a symbol *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let emit_symbol s =
|
|
|
770ba2 |
+ Emitaux.emit_symbol '.' s
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Output a label *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let label_prefix = "L"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let emit_label lbl =
|
|
|
770ba2 |
+ emit_string label_prefix; emit_int lbl
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Section switching *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let data_space =
|
|
|
770ba2 |
+ ".section .data"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let code_space =
|
|
|
770ba2 |
+ ".section .text"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let rodata_space =
|
|
|
770ba2 |
+ ".section .rodata"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let reg_tmp1 = phys_reg 21 (* used by the assembler *)
|
|
|
770ba2 |
+let reg_tmp2 = phys_reg 22
|
|
|
770ba2 |
+let reg_t2 = phys_reg 16
|
|
|
770ba2 |
+(* let reg_fp = phys_reg 23 *)
|
|
|
770ba2 |
+let reg_trap = phys_reg 24
|
|
|
770ba2 |
+let reg_alloc_ptr = phys_reg 25
|
|
|
770ba2 |
+let reg_alloc_lim = phys_reg 26
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Names of instructions that differ in 32 and 64-bit modes *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let lg = if rv64 then "ld" else "lw"
|
|
|
770ba2 |
+let stg = if rv64 then "sd" else "sw"
|
|
|
770ba2 |
+let datag = if rv64 then ".quad" else ".long"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Output a pseudo-register *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let emit_reg = function
|
|
|
770ba2 |
+ | {loc = Reg r} -> emit_string (register_name r)
|
|
|
770ba2 |
+ | _ -> fatal_error "Emit.emit_reg"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Adjust sp by the given byte amount *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let emit_stack_adjustment = function
|
|
|
770ba2 |
+ | 0 -> ()
|
|
|
770ba2 |
+ | n when is_immediate n ->
|
|
|
770ba2 |
+ ` addi sp, sp, {emit_int n}\n`
|
|
|
770ba2 |
+ | n ->
|
|
|
770ba2 |
+ ` li {emit_reg reg_tmp1}, {emit_int n}\n`;
|
|
|
770ba2 |
+ ` add sp, sp, {emit_reg reg_tmp1}\n`
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let reload_ra n =
|
|
|
770ba2 |
+ let ofs = n - size_addr in
|
|
|
770ba2 |
+ if is_immediate ofs then
|
|
|
770ba2 |
+ ` {emit_string lg} ra, {emit_int ofs}(sp)\n`
|
|
|
770ba2 |
+ else begin
|
|
|
770ba2 |
+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
|
|
|
770ba2 |
+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
|
|
|
770ba2 |
+ ` {emit_string lg} ra, 0({emit_reg reg_tmp1})\n`
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let store_ra n =
|
|
|
770ba2 |
+ let ofs = n - size_addr in
|
|
|
770ba2 |
+ if is_immediate ofs then
|
|
|
770ba2 |
+ ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n`
|
|
|
770ba2 |
+ else begin
|
|
|
770ba2 |
+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
|
|
|
770ba2 |
+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
|
|
|
770ba2 |
+ ` {emit_string stg} ra, 0({emit_reg reg_tmp1})\n`
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let emit_store stg src ofs =
|
|
|
770ba2 |
+ if is_immediate ofs then
|
|
|
770ba2 |
+ ` {emit_string stg} {emit_reg src}, {emit_int ofs}(sp)\n`
|
|
|
770ba2 |
+ else begin
|
|
|
770ba2 |
+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
|
|
|
770ba2 |
+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
|
|
|
770ba2 |
+ ` {emit_string stg} {emit_reg src}, 0({emit_reg reg_tmp1})\n`
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let emit_load lg dst ofs =
|
|
|
770ba2 |
+ if is_immediate ofs then
|
|
|
770ba2 |
+ ` {emit_string lg} {emit_reg dst}, {emit_int ofs}(sp)\n`
|
|
|
770ba2 |
+ else begin
|
|
|
770ba2 |
+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`;
|
|
|
770ba2 |
+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`;
|
|
|
770ba2 |
+ ` {emit_string lg} {emit_reg dst}, 0({emit_reg reg_tmp1})\n`
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Record live pointers at call points *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let record_frame_label ?label live raise_ dbg =
|
|
|
770ba2 |
+ let lbl =
|
|
|
770ba2 |
+ match label with
|
|
|
770ba2 |
+ | None -> new_label()
|
|
|
770ba2 |
+ | Some label -> label
|
|
|
770ba2 |
+ in
|
|
|
770ba2 |
+ let live_offset = ref [] in
|
|
|
770ba2 |
+ Reg.Set.iter
|
|
|
770ba2 |
+ (function
|
|
|
770ba2 |
+ {typ = Val; loc = Reg r} ->
|
|
|
770ba2 |
+ live_offset := (r lsl 1) + 1 :: !live_offset
|
|
|
770ba2 |
+ | {typ = Val; loc = Stack s} as reg ->
|
|
|
770ba2 |
+ live_offset := slot_offset s (register_class reg) :: !live_offset
|
|
|
770ba2 |
+ | {typ = Addr} as r ->
|
|
|
770ba2 |
+ Misc.fatal_error ("bad GC root " ^ Reg.name r)
|
|
|
770ba2 |
+ | _ -> ()
|
|
|
770ba2 |
+ )
|
|
|
770ba2 |
+ live;
|
|
|
770ba2 |
+ record_frame_descr ~label:lbl ~frame_size:(frame_size())
|
|
|
770ba2 |
+ ~live_offset:!live_offset ~raise_frame:raise_ dbg;
|
|
|
770ba2 |
+ lbl
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let record_frame ?label live raise_ dbg =
|
|
|
770ba2 |
+ let lbl = record_frame_label ?label live raise_ dbg in
|
|
|
770ba2 |
+ `{emit_label lbl}:\n`
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Record calls to the GC -- we've moved them out of the way *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+type gc_call =
|
|
|
770ba2 |
+ { gc_lbl: label; (* Entry label *)
|
|
|
770ba2 |
+ gc_return_lbl: label; (* Where to branch after GC *)
|
|
|
770ba2 |
+ gc_frame_lbl: label } (* Label of frame descriptor *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let call_gc_sites = ref ([] : gc_call list)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let emit_call_gc gc =
|
|
|
770ba2 |
+ `{emit_label gc.gc_lbl}:\n`;
|
|
|
770ba2 |
+ ` call {emit_symbol "caml_call_gc"}\n`;
|
|
|
770ba2 |
+ `{emit_label gc.gc_frame_lbl}:\n`;
|
|
|
770ba2 |
+ ` j {emit_label gc.gc_return_lbl}\n`
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Record calls to caml_ml_array_bound_error.
|
|
|
770ba2 |
+ In debug mode, we maintain one call to caml_ml_array_bound_error
|
|
|
770ba2 |
+ per bound check site. Otherwise, we can share a single call. *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+type bound_error_call =
|
|
|
770ba2 |
+ { bd_lbl: label; (* Entry label *)
|
|
|
770ba2 |
+ bd_frame_lbl: label } (* Label of frame descriptor *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let bound_error_sites = ref ([] : bound_error_call list)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let bound_error_label ?label dbg =
|
|
|
770ba2 |
+ if !Clflags.debug || !bound_error_sites = [] then begin
|
|
|
770ba2 |
+ let lbl_bound_error = new_label() in
|
|
|
770ba2 |
+ let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in
|
|
|
770ba2 |
+ bound_error_sites :=
|
|
|
770ba2 |
+ { bd_lbl = lbl_bound_error;
|
|
|
770ba2 |
+ bd_frame_lbl = lbl_frame } :: !bound_error_sites;
|
|
|
770ba2 |
+ lbl_bound_error
|
|
|
770ba2 |
+ end else
|
|
|
770ba2 |
+ let bd = List.hd !bound_error_sites in
|
|
|
770ba2 |
+ bd.bd_lbl
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let emit_call_bound_error bd =
|
|
|
770ba2 |
+ `{emit_label bd.bd_lbl}:\n`;
|
|
|
770ba2 |
+ ` call {emit_symbol "caml_ml_array_bound_error"}\n`;
|
|
|
770ba2 |
+ `{emit_label bd.bd_frame_lbl}:\n`
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Record floating-point literals *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let float_literals = ref ([] : (int64 * int) list)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Names for various instructions *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let name_for_intop = function
|
|
|
770ba2 |
+ | Iadd -> "add"
|
|
|
770ba2 |
+ | Isub -> "sub"
|
|
|
770ba2 |
+ | Imul -> "mul"
|
|
|
770ba2 |
+ | Imulh -> "mulh"
|
|
|
770ba2 |
+ | Idiv -> "div"
|
|
|
770ba2 |
+ | Iand -> "and"
|
|
|
770ba2 |
+ | Ior -> "or"
|
|
|
770ba2 |
+ | Ixor -> "xor"
|
|
|
770ba2 |
+ | Ilsl -> "sll"
|
|
|
770ba2 |
+ | Ilsr -> "srl"
|
|
|
770ba2 |
+ | Iasr -> "sra"
|
|
|
770ba2 |
+ | Imod -> "rem"
|
|
|
770ba2 |
+ | _ -> fatal_error "Emit.Intop"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let name_for_intop_imm = function
|
|
|
770ba2 |
+ | Iadd -> "addi"
|
|
|
770ba2 |
+ | Iand -> "andi"
|
|
|
770ba2 |
+ | Ior -> "ori"
|
|
|
770ba2 |
+ | Ixor -> "xori"
|
|
|
770ba2 |
+ | Ilsl -> "slli"
|
|
|
770ba2 |
+ | Ilsr -> "srli"
|
|
|
770ba2 |
+ | Iasr -> "srai"
|
|
|
770ba2 |
+ | _ -> fatal_error "Emit.Intop_imm"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let name_for_floatop1 = function
|
|
|
770ba2 |
+ | Inegf -> "fneg.d"
|
|
|
770ba2 |
+ | Iabsf -> "fabs.d"
|
|
|
770ba2 |
+ | _ -> fatal_error "Emit.Iopf1"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let name_for_floatop2 = function
|
|
|
770ba2 |
+ | Iaddf -> "fadd.d"
|
|
|
770ba2 |
+ | Isubf -> "fsub.d"
|
|
|
770ba2 |
+ | Imulf -> "fmul.d"
|
|
|
770ba2 |
+ | Idivf -> "fdiv.d"
|
|
|
770ba2 |
+ | _ -> fatal_error "Emit.Iopf2"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let name_for_specific = function
|
|
|
770ba2 |
+ | Imultaddf false -> "fmadd.d"
|
|
|
770ba2 |
+ | Imultaddf true -> "fnmadd.d"
|
|
|
770ba2 |
+ | Imultsubf false -> "fmsub.d"
|
|
|
770ba2 |
+ | Imultsubf true -> "fnmsub.d"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Name of current function *)
|
|
|
770ba2 |
+let function_name = ref ""
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Entry point for tail recursive calls *)
|
|
|
770ba2 |
+let tailrec_entry_point = ref 0
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Output the assembly code for an instruction *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let emit_instr i =
|
|
|
770ba2 |
+ match i.desc with
|
|
|
770ba2 |
+ Lend -> ()
|
|
|
770ba2 |
+ | Lop(Imove | Ispill | Ireload) ->
|
|
|
770ba2 |
+ let src = i.arg.(0) and dst = i.res.(0) in
|
|
|
770ba2 |
+ if src.loc <> dst.loc then begin
|
|
|
770ba2 |
+ match (src, dst) with
|
|
|
770ba2 |
+ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Reg _} ->
|
|
|
770ba2 |
+ ` mv {emit_reg dst}, {emit_reg src}\n`
|
|
|
770ba2 |
+ | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
|
|
|
770ba2 |
+ ` fmv.d {emit_reg dst}, {emit_reg src}\n`
|
|
|
770ba2 |
+ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} ->
|
|
|
770ba2 |
+ let ofs = slot_offset s (register_class dst) in
|
|
|
770ba2 |
+ emit_store stg src ofs
|
|
|
770ba2 |
+ | {loc = Reg _; typ = Float}, {loc = Stack s} ->
|
|
|
770ba2 |
+ let ofs = slot_offset s (register_class dst) in
|
|
|
770ba2 |
+ emit_store "fsd" src ofs
|
|
|
770ba2 |
+ | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} ->
|
|
|
770ba2 |
+ let ofs = slot_offset s (register_class src) in
|
|
|
770ba2 |
+ emit_load lg dst ofs
|
|
|
770ba2 |
+ | {loc = Stack s; typ = Float}, {loc = Reg _} ->
|
|
|
770ba2 |
+ let ofs = slot_offset s (register_class src) in
|
|
|
770ba2 |
+ emit_load "fld" dst ofs
|
|
|
770ba2 |
+ | _ ->
|
|
|
770ba2 |
+ fatal_error "Emit: Imove"
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ | Lop(Iconst_int n) ->
|
|
|
770ba2 |
+ ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n`
|
|
|
770ba2 |
+ | Lop(Iconst_float f) ->
|
|
|
770ba2 |
+ let lbl = new_label() in
|
|
|
770ba2 |
+ float_literals := (f, lbl) :: !float_literals;
|
|
|
770ba2 |
+ ` fld {emit_reg i.res.(0)}, {emit_label lbl}, {emit_reg reg_tmp1}\n`
|
|
|
770ba2 |
+ | Lop(Iconst_symbol s) ->
|
|
|
770ba2 |
+ ` la {emit_reg i.res.(0)}, {emit_symbol s}\n`
|
|
|
770ba2 |
+ | Lop(Icall_ind {label_after = label}) ->
|
|
|
770ba2 |
+ ` jalr {emit_reg i.arg.(0)}\n`;
|
|
|
770ba2 |
+ record_frame ~label i.live false i.dbg
|
|
|
770ba2 |
+ | Lop(Icall_imm {func; label_after = label}) ->
|
|
|
770ba2 |
+ ` call {emit_symbol func}\n`;
|
|
|
770ba2 |
+ record_frame ~label i.live false i.dbg
|
|
|
770ba2 |
+ | Lop(Itailcall_ind {label_after = _}) ->
|
|
|
770ba2 |
+ let n = frame_size() in
|
|
|
770ba2 |
+ if !contains_calls then reload_ra n;
|
|
|
770ba2 |
+ emit_stack_adjustment n;
|
|
|
770ba2 |
+ ` jr {emit_reg i.arg.(0)}\n`
|
|
|
770ba2 |
+ | Lop(Itailcall_imm {func; label_after = _}) ->
|
|
|
770ba2 |
+ if func = !function_name then begin
|
|
|
770ba2 |
+ ` j {emit_label !tailrec_entry_point}\n`
|
|
|
770ba2 |
+ end else begin
|
|
|
770ba2 |
+ let n = frame_size() in
|
|
|
770ba2 |
+ if !contains_calls then reload_ra n;
|
|
|
770ba2 |
+ emit_stack_adjustment n;
|
|
|
770ba2 |
+ ` tail {emit_symbol func}\n`
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ | Lop(Iextcall{func; alloc = true; label_after = label}) ->
|
|
|
770ba2 |
+ ` la {emit_reg reg_t2}, {emit_symbol func}\n`;
|
|
|
770ba2 |
+ ` call {emit_symbol "caml_c_call"}\n`;
|
|
|
770ba2 |
+ record_frame ~label i.live false i.dbg
|
|
|
770ba2 |
+ | Lop(Iextcall{func; alloc = false; label_after = _}) ->
|
|
|
770ba2 |
+ ` call {emit_symbol func}\n`
|
|
|
770ba2 |
+ | Lop(Istackoffset n) ->
|
|
|
770ba2 |
+ assert (n mod 16 = 0);
|
|
|
770ba2 |
+ emit_stack_adjustment (-n);
|
|
|
770ba2 |
+ stack_offset := !stack_offset + n
|
|
|
770ba2 |
+ | Lop(Iload(Single, Iindexed ofs)) ->
|
|
|
770ba2 |
+ ` flw {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`;
|
|
|
770ba2 |
+ ` fcvt.d.s {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
|
|
|
770ba2 |
+ | Lop(Iload(chunk, Iindexed ofs)) ->
|
|
|
770ba2 |
+ let instr =
|
|
|
770ba2 |
+ match chunk with
|
|
|
770ba2 |
+ | Byte_unsigned -> "lbu"
|
|
|
770ba2 |
+ | Byte_signed -> "lb"
|
|
|
770ba2 |
+ | Sixteen_unsigned -> "lhu"
|
|
|
770ba2 |
+ | Sixteen_signed -> "lh"
|
|
|
770ba2 |
+ | Thirtytwo_unsigned -> if rv64 then "lwu" else "lw"
|
|
|
770ba2 |
+ | Thirtytwo_signed -> "lw"
|
|
|
770ba2 |
+ | Word_int | Word_val -> lg
|
|
|
770ba2 |
+ | Single -> assert false
|
|
|
770ba2 |
+ | Double | Double_u -> "fld"
|
|
|
770ba2 |
+ in
|
|
|
770ba2 |
+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`
|
|
|
770ba2 |
+ | Lop(Istore(Single, Iindexed ofs, _)) ->
|
|
|
770ba2 |
+ ` fmv.x.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}\n`;
|
|
|
770ba2 |
+ ` fcvt.s.d {emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}\n`;
|
|
|
770ba2 |
+ ` fsw {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`;
|
|
|
770ba2 |
+ ` fmv.d.x {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}\n`
|
|
|
770ba2 |
+ | Lop(Istore(chunk, Iindexed ofs, _)) ->
|
|
|
770ba2 |
+ let instr =
|
|
|
770ba2 |
+ match chunk with
|
|
|
770ba2 |
+ | Byte_unsigned | Byte_signed -> "sb"
|
|
|
770ba2 |
+ | Sixteen_unsigned | Sixteen_signed -> "sh"
|
|
|
770ba2 |
+ | Thirtytwo_unsigned | Thirtytwo_signed -> "sw"
|
|
|
770ba2 |
+ | Word_int | Word_val -> stg
|
|
|
770ba2 |
+ | Single -> assert false
|
|
|
770ba2 |
+ | Double | Double_u -> "fsd"
|
|
|
770ba2 |
+ in
|
|
|
770ba2 |
+ ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`
|
|
|
770ba2 |
+ | Lop(Ialloc {words = n; label_after_call_gc = label; _}) ->
|
|
|
770ba2 |
+ let lbl_frame_lbl = record_frame_label ?label i.live false i.dbg in
|
|
|
770ba2 |
+ let lbl_redo = new_label () in
|
|
|
770ba2 |
+ let lbl_call_gc = new_label () in
|
|
|
770ba2 |
+ `{emit_label lbl_redo}:\n`;
|
|
|
770ba2 |
+ ` addi {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, -{emit_int n}\n`;
|
|
|
770ba2 |
+ ` addi {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`;
|
|
|
770ba2 |
+ ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_lim}, {emit_label lbl_call_gc}\n`;
|
|
|
770ba2 |
+ call_gc_sites :=
|
|
|
770ba2 |
+ { gc_lbl = lbl_call_gc;
|
|
|
770ba2 |
+ gc_return_lbl = lbl_redo;
|
|
|
770ba2 |
+ gc_frame_lbl = lbl_frame_lbl } :: !call_gc_sites
|
|
|
770ba2 |
+ | Lop(Iintop(Icomp cmp)) ->
|
|
|
770ba2 |
+ begin match cmp with
|
|
|
770ba2 |
+ | Isigned Clt ->
|
|
|
770ba2 |
+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
|
|
|
770ba2 |
+ | Isigned Cge ->
|
|
|
770ba2 |
+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
|
|
|
770ba2 |
+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
|
|
|
770ba2 |
+ | Isigned Cgt ->
|
|
|
770ba2 |
+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
|
|
|
770ba2 |
+ | Isigned Cle ->
|
|
|
770ba2 |
+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
|
|
|
770ba2 |
+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
|
|
|
770ba2 |
+ | Isigned Ceq | Iunsigned Ceq ->
|
|
|
770ba2 |
+ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
|
|
|
770ba2 |
+ ` seqz {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
|
|
|
770ba2 |
+ | Isigned Cne | Iunsigned Cne ->
|
|
|
770ba2 |
+ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
|
|
|
770ba2 |
+ ` snez {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
|
|
|
770ba2 |
+ | Iunsigned Clt ->
|
|
|
770ba2 |
+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
|
|
|
770ba2 |
+ | Iunsigned Cge ->
|
|
|
770ba2 |
+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
|
|
|
770ba2 |
+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
|
|
|
770ba2 |
+ | Iunsigned Cgt ->
|
|
|
770ba2 |
+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
|
|
|
770ba2 |
+ | Iunsigned Cle ->
|
|
|
770ba2 |
+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`;
|
|
|
770ba2 |
+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`;
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ | Lop(Iintop (Icheckbound {label_after_error = label; _})) ->
|
|
|
770ba2 |
+ let lbl = bound_error_label ?label i.dbg in
|
|
|
770ba2 |
+ ` bleu {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ | Lop(Iintop op) ->
|
|
|
770ba2 |
+ let instr = name_for_intop op in
|
|
|
770ba2 |
+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
|
|
|
770ba2 |
+ | Lop(Iintop_imm(Isub, n)) ->
|
|
|
770ba2 |
+ ` addi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n`
|
|
|
770ba2 |
+ | Lop(Iintop_imm(Icomp _, _)) ->
|
|
|
770ba2 |
+ fatal_error "Emit.emit_instr (Iintop_imm (Icomp _, _))"
|
|
|
770ba2 |
+ | Lop(Iintop_imm(Icheckbound {label_after_error = label; _}, n)) ->
|
|
|
770ba2 |
+ let lbl = bound_error_label ?label i.dbg in
|
|
|
770ba2 |
+ ` li {emit_reg reg_tmp1}, {emit_int n}\n`;
|
|
|
770ba2 |
+ ` bleu {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ | Lop(Iintop_imm(op, n)) ->
|
|
|
770ba2 |
+ let instr = name_for_intop_imm op in
|
|
|
770ba2 |
+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n`
|
|
|
770ba2 |
+ | Lop(Inegf | Iabsf as op) ->
|
|
|
770ba2 |
+ let instr = name_for_floatop1 op in
|
|
|
770ba2 |
+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
|
|
|
770ba2 |
+ | Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
|
|
|
770ba2 |
+ let instr = name_for_floatop2 op in
|
|
|
770ba2 |
+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
|
|
|
770ba2 |
+ | Lop(Ifloatofint) ->
|
|
|
770ba2 |
+ let name = if rv64 then "fcvt.d.l" else "fcvt.d.w" in
|
|
|
770ba2 |
+ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
|
|
|
770ba2 |
+ | Lop(Iintoffloat) ->
|
|
|
770ba2 |
+ let name = if rv64 then "fcvt.l.d" else "fcvt.w.d" in
|
|
|
770ba2 |
+ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
|
|
|
770ba2 |
+ | Lop(Ispecific sop) ->
|
|
|
770ba2 |
+ let instr = name_for_specific sop in
|
|
|
770ba2 |
+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n`
|
|
|
770ba2 |
+ | Lop (Iname_for_debugger _) ->
|
|
|
770ba2 |
+ ()
|
|
|
770ba2 |
+ | Lreloadretaddr ->
|
|
|
770ba2 |
+ let n = frame_size () in
|
|
|
770ba2 |
+ reload_ra n
|
|
|
770ba2 |
+ | Lreturn ->
|
|
|
770ba2 |
+ let n = frame_size() in
|
|
|
770ba2 |
+ emit_stack_adjustment n;
|
|
|
770ba2 |
+ ` ret\n`
|
|
|
770ba2 |
+ | Llabel lbl ->
|
|
|
770ba2 |
+ `{emit_label lbl}:\n`
|
|
|
770ba2 |
+ | Lbranch lbl ->
|
|
|
770ba2 |
+ ` j {emit_label lbl}\n`
|
|
|
770ba2 |
+ | Lcondbranch(tst, lbl) ->
|
|
|
770ba2 |
+ begin match tst with
|
|
|
770ba2 |
+ | Itruetest ->
|
|
|
770ba2 |
+ ` bnez {emit_reg i.arg.(0)}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ | Ifalsetest ->
|
|
|
770ba2 |
+ ` beqz {emit_reg i.arg.(0)}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ | Iinttest cmp ->
|
|
|
770ba2 |
+ let name = match cmp with
|
|
|
770ba2 |
+ | Iunsigned Ceq | Isigned Ceq -> "beq"
|
|
|
770ba2 |
+ | Iunsigned Cne | Isigned Cne -> "bne"
|
|
|
770ba2 |
+ | Iunsigned Cle -> "bleu" | Isigned Cle -> "ble"
|
|
|
770ba2 |
+ | Iunsigned Cge -> "bgeu" | Isigned Cge -> "bge"
|
|
|
770ba2 |
+ | Iunsigned Clt -> "bltu" | Isigned Clt -> "blt"
|
|
|
770ba2 |
+ | Iunsigned Cgt -> "bgtu" | Isigned Cgt -> "bgt"
|
|
|
770ba2 |
+ in
|
|
|
770ba2 |
+ ` {emit_string name} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ | Iinttest_imm _ ->
|
|
|
770ba2 |
+ fatal_error "Emit.emit_instr (Iinttest_imm _)"
|
|
|
770ba2 |
+ | Ifloattest(cmp, neg) ->
|
|
|
770ba2 |
+ let neg = match cmp with
|
|
|
770ba2 |
+ | Ceq -> ` feq.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; neg
|
|
|
770ba2 |
+ | Cne -> ` feq.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; not neg
|
|
|
770ba2 |
+ | Clt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; neg
|
|
|
770ba2 |
+ | Cgt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`; neg
|
|
|
770ba2 |
+ | Cle -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; neg
|
|
|
770ba2 |
+ | Cge -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`; neg
|
|
|
770ba2 |
+ in
|
|
|
770ba2 |
+ if neg then
|
|
|
770ba2 |
+ ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ else
|
|
|
770ba2 |
+ ` bnez {emit_reg reg_tmp1}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ | Ioddtest ->
|
|
|
770ba2 |
+ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`;
|
|
|
770ba2 |
+ ` bnez {emit_reg reg_tmp1}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ | Ieventest ->
|
|
|
770ba2 |
+ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`;
|
|
|
770ba2 |
+ ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ | Lcondbranch3(lbl0, lbl1, lbl2) ->
|
|
|
770ba2 |
+ ` addi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, -1\n`;
|
|
|
770ba2 |
+ begin match lbl0 with
|
|
|
770ba2 |
+ | None -> ()
|
|
|
770ba2 |
+ | Some lbl -> ` bltz {emit_reg reg_tmp1}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ end;
|
|
|
770ba2 |
+ begin match lbl1 with
|
|
|
770ba2 |
+ | None -> ()
|
|
|
770ba2 |
+ | Some lbl -> ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ end;
|
|
|
770ba2 |
+ begin match lbl2 with
|
|
|
770ba2 |
+ | None -> ()
|
|
|
770ba2 |
+ | Some lbl -> ` bgtz {emit_reg reg_tmp1}, {emit_label lbl}\n`
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ | Lswitch jumptbl -> (* FIXME FIXME ? *)
|
|
|
770ba2 |
+ let lbl = new_label() in
|
|
|
770ba2 |
+ ` la {emit_reg reg_tmp1}, {emit_label lbl}\n`;
|
|
|
770ba2 |
+ ` slli {emit_reg reg_tmp2}, {emit_reg i.arg.(0)}, 2\n`;
|
|
|
770ba2 |
+ ` add {emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_reg reg_tmp2}\n`;
|
|
|
770ba2 |
+ ` jr {emit_reg reg_tmp1}\n`;
|
|
|
770ba2 |
+ `{emit_label lbl}:\n`;
|
|
|
770ba2 |
+ for i = 0 to Array.length jumptbl - 1 do
|
|
|
770ba2 |
+ ` j {emit_label jumptbl.(i)}\n`
|
|
|
770ba2 |
+ done
|
|
|
770ba2 |
+ | Lsetuptrap lbl ->
|
|
|
770ba2 |
+ ` addi sp, sp, -16\n`;
|
|
|
770ba2 |
+ ` jal {emit_label lbl}\n`
|
|
|
770ba2 |
+ | Lpushtrap ->
|
|
|
770ba2 |
+ stack_offset := !stack_offset + 16;
|
|
|
770ba2 |
+ ` {emit_string stg} ra, {emit_int size_addr}(sp)\n`;
|
|
|
770ba2 |
+ ` {emit_string stg} {emit_reg reg_trap}, 0(sp)\n`;
|
|
|
770ba2 |
+ ` mv {emit_reg reg_trap}, sp\n`
|
|
|
770ba2 |
+ | Lpoptrap ->
|
|
|
770ba2 |
+ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`;
|
|
|
770ba2 |
+ ` addi sp, sp, 16\n`;
|
|
|
770ba2 |
+ stack_offset := !stack_offset - 16
|
|
|
770ba2 |
+ | Lraise k ->
|
|
|
770ba2 |
+ begin match !Clflags.debug, k with
|
|
|
770ba2 |
+ | true, Cmm.Raise_withtrace ->
|
|
|
770ba2 |
+ ` call {emit_symbol "caml_raise_exn"}\n`;
|
|
|
770ba2 |
+ record_frame Reg.Set.empty true i.dbg
|
|
|
770ba2 |
+ | false, _
|
|
|
770ba2 |
+ | true, Cmm.Raise_notrace ->
|
|
|
770ba2 |
+ ` mv sp, {emit_reg reg_trap}\n`;
|
|
|
770ba2 |
+ ` {emit_string lg} {emit_reg reg_tmp1}, {emit_int size_addr}(sp)\n`;
|
|
|
770ba2 |
+ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`;
|
|
|
770ba2 |
+ ` addi sp, sp, 16\n`;
|
|
|
770ba2 |
+ ` jalr {emit_reg reg_tmp1}\n`
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Emit a sequence of instructions *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let rec emit_all = function
|
|
|
770ba2 |
+ | {desc = Lend} -> () | i -> emit_instr i; emit_all i.next
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Emission of a function declaration *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let fundecl fundecl =
|
|
|
770ba2 |
+ function_name := fundecl.fun_name;
|
|
|
770ba2 |
+ tailrec_entry_point := new_label();
|
|
|
770ba2 |
+ stack_offset := 0;
|
|
|
770ba2 |
+ call_gc_sites := [];
|
|
|
770ba2 |
+ bound_error_sites := [];
|
|
|
770ba2 |
+ float_literals := [];
|
|
|
770ba2 |
+ ` .globl {emit_symbol fundecl.fun_name}\n`;
|
|
|
770ba2 |
+ ` .type {emit_symbol fundecl.fun_name}, @function\n`;
|
|
|
770ba2 |
+ ` {emit_string code_space}\n`;
|
|
|
770ba2 |
+ ` .align 2\n`;
|
|
|
770ba2 |
+ `{emit_symbol fundecl.fun_name}:\n`;
|
|
|
770ba2 |
+ let n = frame_size() in
|
|
|
770ba2 |
+ emit_stack_adjustment (-n);
|
|
|
770ba2 |
+ if !contains_calls then store_ra n;
|
|
|
770ba2 |
+ `{emit_label !tailrec_entry_point}:\n`;
|
|
|
770ba2 |
+ emit_all fundecl.fun_body;
|
|
|
770ba2 |
+ List.iter emit_call_gc !call_gc_sites;
|
|
|
770ba2 |
+ List.iter emit_call_bound_error !bound_error_sites;
|
|
|
770ba2 |
+ ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`;
|
|
|
770ba2 |
+ (* Emit the float literals *)
|
|
|
770ba2 |
+ if !float_literals <> [] then begin
|
|
|
770ba2 |
+ ` {emit_string rodata_space}\n`;
|
|
|
770ba2 |
+ ` .align 3\n`;
|
|
|
770ba2 |
+ List.iter
|
|
|
770ba2 |
+ (fun (f, lbl) ->
|
|
|
770ba2 |
+ `{emit_label lbl}:\n`;
|
|
|
770ba2 |
+ if rv64
|
|
|
770ba2 |
+ then emit_float64_directive ".quad" f
|
|
|
770ba2 |
+ else emit_float64_split_directive ".long" f)
|
|
|
770ba2 |
+ !float_literals;
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Emission of data *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let declare_global_data s =
|
|
|
770ba2 |
+ ` .globl {emit_symbol s}\n`;
|
|
|
770ba2 |
+ ` .type {emit_symbol s}, @object\n`
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let emit_item = function
|
|
|
770ba2 |
+ | Cglobal_symbol s ->
|
|
|
770ba2 |
+ declare_global_data s
|
|
|
770ba2 |
+ | Cdefine_symbol s ->
|
|
|
770ba2 |
+ `{emit_symbol s}:\n`;
|
|
|
770ba2 |
+ | Cint8 n ->
|
|
|
770ba2 |
+ ` .byte {emit_int n}\n`
|
|
|
770ba2 |
+ | Cint16 n ->
|
|
|
770ba2 |
+ ` .short {emit_int n}\n`
|
|
|
770ba2 |
+ | Cint32 n ->
|
|
|
770ba2 |
+ ` .long {emit_nativeint n}\n`
|
|
|
770ba2 |
+ | Cint n ->
|
|
|
770ba2 |
+ ` {emit_string datag} {emit_nativeint n}\n`
|
|
|
770ba2 |
+ | Csingle f ->
|
|
|
770ba2 |
+ emit_float32_directive ".long" (Int32.bits_of_float f)
|
|
|
770ba2 |
+ | Cdouble f ->
|
|
|
770ba2 |
+ if rv64
|
|
|
770ba2 |
+ then emit_float64_directive ".quad" (Int64.bits_of_float f)
|
|
|
770ba2 |
+ else emit_float64_split_directive ".long" (Int64.bits_of_float f)
|
|
|
770ba2 |
+ | Csymbol_address s ->
|
|
|
770ba2 |
+ ` {emit_string datag} {emit_symbol s}\n`
|
|
|
770ba2 |
+ | Cstring s ->
|
|
|
770ba2 |
+ emit_bytes_directive " .byte " s
|
|
|
770ba2 |
+ | Cskip n ->
|
|
|
770ba2 |
+ if n > 0 then ` .space {emit_int n}\n`
|
|
|
770ba2 |
+ | Calign n ->
|
|
|
770ba2 |
+ ` .align {emit_int (Misc.log2 n)}\n`
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let data l =
|
|
|
770ba2 |
+ ` {emit_string data_space}\n`;
|
|
|
770ba2 |
+ List.iter emit_item l
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Beginning / end of an assembly file *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let begin_assembly() =
|
|
|
770ba2 |
+ ` .file \"\"\n`; (* PR#7073 *)
|
|
|
770ba2 |
+ (* Emit the beginning of the segments *)
|
|
|
770ba2 |
+ let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
|
|
|
770ba2 |
+ ` {emit_string data_space}\n`;
|
|
|
770ba2 |
+ declare_global_data lbl_begin;
|
|
|
770ba2 |
+ `{emit_symbol lbl_begin}:\n`;
|
|
|
770ba2 |
+ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
|
|
|
770ba2 |
+ ` {emit_string code_space}\n`;
|
|
|
770ba2 |
+ declare_global_data lbl_begin;
|
|
|
770ba2 |
+ `{emit_symbol lbl_begin}:\n`
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let end_assembly() =
|
|
|
770ba2 |
+ ` {emit_string code_space}\n`;
|
|
|
770ba2 |
+ let lbl_end = Compilenv.make_symbol (Some "code_end") in
|
|
|
770ba2 |
+ declare_global_data lbl_end;
|
|
|
770ba2 |
+ `{emit_symbol lbl_end}:\n`;
|
|
|
770ba2 |
+ ` .long 0\n`;
|
|
|
770ba2 |
+ ` {emit_string data_space}\n`;
|
|
|
770ba2 |
+ let lbl_end = Compilenv.make_symbol (Some "data_end") in
|
|
|
770ba2 |
+ declare_global_data lbl_end;
|
|
|
770ba2 |
+ `{emit_symbol lbl_end}:\n`;
|
|
|
770ba2 |
+ ` {emit_string datag} 0\n`;
|
|
|
770ba2 |
+ (* Emit the frame descriptors *)
|
|
|
770ba2 |
+ ` {emit_string rodata_space}\n`;
|
|
|
770ba2 |
+ let lbl = Compilenv.make_symbol (Some "frametable") in
|
|
|
770ba2 |
+ declare_global_data lbl;
|
|
|
770ba2 |
+ `{emit_symbol lbl}:\n`;
|
|
|
770ba2 |
+ emit_frames
|
|
|
770ba2 |
+ { efa_code_label = (fun l -> ` {emit_string datag} {emit_label l}\n`);
|
|
|
770ba2 |
+ efa_data_label = (fun l -> ` {emit_string datag} {emit_label l}\n`);
|
|
|
770ba2 |
+ efa_16 = (fun n -> ` .short {emit_int n}\n`);
|
|
|
770ba2 |
+ efa_32 = (fun n -> ` .long {emit_int32 n}\n`);
|
|
|
770ba2 |
+ efa_word = (fun n -> ` {emit_string datag} {emit_int n}\n`);
|
|
|
770ba2 |
+ efa_align = (fun n -> ` .align {emit_int (Misc.log2 n)}\n`);
|
|
|
770ba2 |
+ efa_label_rel = (fun lbl ofs ->
|
|
|
770ba2 |
+ ` .long ({emit_label lbl} - .) + {emit_int32 ofs}\n`);
|
|
|
770ba2 |
+ efa_def_label = (fun l -> `{emit_label l}:\n`);
|
|
|
770ba2 |
+ efa_string = (fun s -> emit_bytes_directive " .byte " (s ^ "\000"))
|
|
|
770ba2 |
+ }
|
|
|
770ba2 |
diff --git a/asmcomp/riscv/proc.ml b/asmcomp/riscv/proc.ml
|
|
|
770ba2 |
new file mode 100644
|
|
|
770ba2 |
index 000000000..c0b0dcdb8
|
|
|
770ba2 |
--- /dev/null
|
|
|
770ba2 |
+++ b/asmcomp/riscv/proc.ml
|
|
|
770ba2 |
@@ -0,0 +1,301 @@
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* OCaml *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Nicolas Ojeda Bar <n.oje.bar@gmail.com> *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Copyright 2016 Institut National de Recherche en Informatique et *)
|
|
|
770ba2 |
+(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
770ba2 |
+(* under the terms of the Q Public License version 1.0. *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Description of the RISC-V *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+open Misc
|
|
|
770ba2 |
+open Cmm
|
|
|
770ba2 |
+open Reg
|
|
|
770ba2 |
+open Arch
|
|
|
770ba2 |
+open Mach
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Instruction selection *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let word_addressed = false
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Registers available for register allocation *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Integer register map:
|
|
|
770ba2 |
+ zero always zero
|
|
|
770ba2 |
+ ra return address
|
|
|
770ba2 |
+ sp, gp, tp stack pointer, global pointer, thread pointer (preserved by C)
|
|
|
770ba2 |
+ a0 - a7 0 - 7 arguments/results
|
|
|
770ba2 |
+ s2 - s9 8 - 15 arguments/results (preserved by C)
|
|
|
770ba2 |
+ t2 - t6 16 - 20 temporary
|
|
|
770ba2 |
+ t0 21 temporary (used by assembler)
|
|
|
770ba2 |
+ t1 22 temporary (reserved for code gen)
|
|
|
770ba2 |
+ s0 23 frame pointer (preserved by C)
|
|
|
770ba2 |
+ s1 24 trap pointer (preserved by C)
|
|
|
770ba2 |
+ s10 25 allocation pointer (preserved by C)
|
|
|
770ba2 |
+ s11 26 allocation limit (preserved by C)
|
|
|
770ba2 |
+ Floating-point register map:
|
|
|
770ba2 |
+ ft0 - ft7 100 - 107 temporary
|
|
|
770ba2 |
+ fs0 - fs1 108 - 109 general purpose (preserved by C)
|
|
|
770ba2 |
+ fa0 - fa7 110 - 117 arguments/results
|
|
|
770ba2 |
+ fs2 - fs9 118 - 125 arguments/results (preserved by C)
|
|
|
770ba2 |
+ fs10 - fs11 126 - 127 general purpose (preserved by C)
|
|
|
770ba2 |
+ ft8 - ft11 128 - 131 temporary
|
|
|
770ba2 |
+*)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let int_reg_name =
|
|
|
770ba2 |
+ [| "a0"; "a1"; "a2"; "a3"; "a4"; "a5"; "a6"; "a7";
|
|
|
770ba2 |
+ "s2"; "s3"; "s4"; "s5"; "s6"; "s7"; "s8"; "s9";
|
|
|
770ba2 |
+ "t2"; "t3"; "t4"; "t5"; "t6";
|
|
|
770ba2 |
+ "t0"; "t1";
|
|
|
770ba2 |
+ "s0"; "s1"; "s10"; "s11" |]
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let float_reg_name =
|
|
|
770ba2 |
+ [| "ft0"; "ft1"; "ft2"; "ft3"; "ft4"; "ft5"; "ft6"; "ft7";
|
|
|
770ba2 |
+ "fs0"; "fs1";
|
|
|
770ba2 |
+ "fa0"; "fa1"; "fa2"; "fa3"; "fa4"; "fa5"; "fa6"; "fa7";
|
|
|
770ba2 |
+ "fs2"; "fs3"; "fs4"; "fs5"; "fs6"; "fs7"; "fs8"; "fs9"; "fs10"; "fs11";
|
|
|
770ba2 |
+ "ft8"; "ft9"; "ft10"; "ft11" |]
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let num_register_classes = 2
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let register_class r =
|
|
|
770ba2 |
+ match r.typ with
|
|
|
770ba2 |
+ | Val | Int | Addr -> 0
|
|
|
770ba2 |
+ | Float -> 1
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let num_available_registers = [| 21; 32 |]
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let first_available_register = [| 0; 100 |]
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let register_name r =
|
|
|
770ba2 |
+ if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let rotate_registers = true
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Representation of hard registers by pseudo-registers *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let hard_int_reg =
|
|
|
770ba2 |
+ let v = Array.make 27 Reg.dummy in
|
|
|
770ba2 |
+ for i = 0 to 26 do
|
|
|
770ba2 |
+ v.(i) <- Reg.at_location Int (Reg i)
|
|
|
770ba2 |
+ done;
|
|
|
770ba2 |
+ v
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let hard_float_reg =
|
|
|
770ba2 |
+ let v = Array.make 32 Reg.dummy in
|
|
|
770ba2 |
+ for i = 0 to 31 do
|
|
|
770ba2 |
+ v.(i) <- Reg.at_location Float (Reg(100 + i))
|
|
|
770ba2 |
+ done;
|
|
|
770ba2 |
+ v
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let all_phys_regs =
|
|
|
770ba2 |
+ Array.append hard_int_reg hard_float_reg
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let phys_reg n =
|
|
|
770ba2 |
+ if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let stack_slot slot ty =
|
|
|
770ba2 |
+ Reg.at_location ty (Stack slot)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Calling conventions *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let calling_conventions
|
|
|
770ba2 |
+ first_int last_int first_float last_float make_stack arg =
|
|
|
770ba2 |
+ let loc = Array.make (Array.length arg) Reg.dummy in
|
|
|
770ba2 |
+ let int = ref first_int in
|
|
|
770ba2 |
+ let float = ref first_float in
|
|
|
770ba2 |
+ let ofs = ref 0 in
|
|
|
770ba2 |
+ for i = 0 to Array.length arg - 1 do
|
|
|
770ba2 |
+ match arg.(i).typ with
|
|
|
770ba2 |
+ | Val | Int | Addr as ty ->
|
|
|
770ba2 |
+ if !int <= last_int then begin
|
|
|
770ba2 |
+ loc.(i) <- phys_reg !int;
|
|
|
770ba2 |
+ incr int
|
|
|
770ba2 |
+ end else begin
|
|
|
770ba2 |
+ loc.(i) <- stack_slot (make_stack !ofs) ty;
|
|
|
770ba2 |
+ ofs := !ofs + size_int
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ | Float ->
|
|
|
770ba2 |
+ if !float <= last_float then begin
|
|
|
770ba2 |
+ loc.(i) <- phys_reg !float;
|
|
|
770ba2 |
+ incr float
|
|
|
770ba2 |
+ end else begin
|
|
|
770ba2 |
+ loc.(i) <- stack_slot (make_stack !ofs) Float;
|
|
|
770ba2 |
+ ofs := !ofs + size_float
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ done;
|
|
|
770ba2 |
+ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let incoming ofs = Incoming ofs
|
|
|
770ba2 |
+let outgoing ofs = Outgoing ofs
|
|
|
770ba2 |
+let not_supported _ = fatal_error "Proc.loc_results: cannot call"
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let max_arguments_for_tailcalls = 16
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* OCaml calling convention:
|
|
|
770ba2 |
+ first integer args in a0 .. a7, s2 .. s9
|
|
|
770ba2 |
+ first float args in fa0 .. fa7, fs2 .. fs9
|
|
|
770ba2 |
+ remaining args on stack.
|
|
|
770ba2 |
+ Return values in a0 .. a7, s2 .. s9 or fa0 .. fa7, fs2 .. fs9. *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let single_regs arg = Array.map (fun arg -> [| arg |]) arg
|
|
|
770ba2 |
+let ensure_single_regs res =
|
|
|
770ba2 |
+ Array.map (function
|
|
|
770ba2 |
+ | [| res |] -> res
|
|
|
770ba2 |
+ | _ -> failwith "proc.ensure_single_regs"
|
|
|
770ba2 |
+ ) res
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let loc_arguments arg =
|
|
|
770ba2 |
+ calling_conventions 0 15 110 125 outgoing arg
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let loc_parameters arg =
|
|
|
770ba2 |
+ let (loc, _ofs) =
|
|
|
770ba2 |
+ calling_conventions 0 15 110 125 incoming arg
|
|
|
770ba2 |
+ in
|
|
|
770ba2 |
+ loc
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let loc_results res =
|
|
|
770ba2 |
+ let (loc, _ofs) =
|
|
|
770ba2 |
+ calling_conventions 0 15 110 125 not_supported res
|
|
|
770ba2 |
+ in
|
|
|
770ba2 |
+ loc
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* C calling convention:
|
|
|
770ba2 |
+ first integer args in a0 .. a7
|
|
|
770ba2 |
+ first float args in fa0 .. fa7
|
|
|
770ba2 |
+ remaining args on stack.
|
|
|
770ba2 |
+ Return values in a0 .. a1 or fa0 .. fa1. *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let external_calling_conventions
|
|
|
770ba2 |
+ first_int last_int first_float last_float make_stack arg =
|
|
|
770ba2 |
+ let loc = Array.make (Array.length arg) [| Reg.dummy |] in
|
|
|
770ba2 |
+ let int = ref first_int in
|
|
|
770ba2 |
+ let float = ref first_float in
|
|
|
770ba2 |
+ let ofs = ref 0 in
|
|
|
770ba2 |
+ for i = 0 to Array.length arg - 1 do
|
|
|
770ba2 |
+ match arg.(i) with
|
|
|
770ba2 |
+ | [| arg |] ->
|
|
|
770ba2 |
+ begin match arg.typ with
|
|
|
770ba2 |
+ | Val | Int | Addr as ty ->
|
|
|
770ba2 |
+ if !int <= last_int then begin
|
|
|
770ba2 |
+ loc.(i) <- [| phys_reg !int |];
|
|
|
770ba2 |
+ incr int;
|
|
|
770ba2 |
+ incr float;
|
|
|
770ba2 |
+ end else begin
|
|
|
770ba2 |
+ loc.(i) <- [| stack_slot (make_stack !ofs) ty |];
|
|
|
770ba2 |
+ ofs := !ofs + size_int
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ | Float ->
|
|
|
770ba2 |
+ if !float <= last_float then begin
|
|
|
770ba2 |
+ loc.(i) <- [| phys_reg !float |];
|
|
|
770ba2 |
+ incr float;
|
|
|
770ba2 |
+ incr int;
|
|
|
770ba2 |
+ end else begin
|
|
|
770ba2 |
+ loc.(i) <- [| stack_slot (make_stack !ofs) Float |];
|
|
|
770ba2 |
+ ofs := !ofs + size_float
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ | [| arg1; arg2 |] ->
|
|
|
770ba2 |
+ (* Passing of 64-bit quantities to external functions on 32-bit
|
|
|
770ba2 |
+ platform. *)
|
|
|
770ba2 |
+ assert (size_int = 4);
|
|
|
770ba2 |
+ begin match arg1.typ, arg2.typ with
|
|
|
770ba2 |
+ | Int, Int ->
|
|
|
770ba2 |
+ int := Misc.align !int 2;
|
|
|
770ba2 |
+ if !int <= last_int - 1 then begin
|
|
|
770ba2 |
+ let reg_lower = phys_reg !int in
|
|
|
770ba2 |
+ let reg_upper = phys_reg (!int + 1) in
|
|
|
770ba2 |
+ loc.(i) <- [| reg_lower; reg_upper |];
|
|
|
770ba2 |
+ int := !int + 2
|
|
|
770ba2 |
+ end else begin
|
|
|
770ba2 |
+ let size_int64 = 8 in
|
|
|
770ba2 |
+ ofs := Misc.align !ofs size_int64;
|
|
|
770ba2 |
+ let ofs_lower = !ofs in
|
|
|
770ba2 |
+ let ofs_upper = !ofs + size_int in
|
|
|
770ba2 |
+ let stack_lower = stack_slot (make_stack ofs_lower) Int in
|
|
|
770ba2 |
+ let stack_upper = stack_slot (make_stack ofs_upper) Int in
|
|
|
770ba2 |
+ loc.(i) <- [| stack_lower; stack_upper |];
|
|
|
770ba2 |
+ ofs := !ofs + size_int64
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ | _ ->
|
|
|
770ba2 |
+ let f = function Int -> "I" | Addr -> "A" | Val -> "V" | Float -> "F" in
|
|
|
770ba2 |
+ fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \
|
|
|
770ba2 |
+ type(s) for multi-register argument: %s, %s"
|
|
|
770ba2 |
+ (f arg1.typ) (f arg2.typ))
|
|
|
770ba2 |
+ end
|
|
|
770ba2 |
+ | _ ->
|
|
|
770ba2 |
+ fatal_error "Proc.calling_conventions: bad number of register for \
|
|
|
770ba2 |
+ multi-register argument"
|
|
|
770ba2 |
+ done;
|
|
|
770ba2 |
+ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let loc_external_arguments arg =
|
|
|
770ba2 |
+ external_calling_conventions 0 7 110 117 outgoing arg
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let loc_external_results res =
|
|
|
770ba2 |
+ let (loc, _ofs) =
|
|
|
770ba2 |
+ external_calling_conventions 0 1 110 111 not_supported (single_regs res)
|
|
|
770ba2 |
+ in
|
|
|
770ba2 |
+ ensure_single_regs loc
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Exceptions are in GPR 3 *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let loc_exn_bucket = phys_reg 0
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Volatile registers: none *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let regs_are_volatile _ = false
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Registers destroyed by operations *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let destroyed_at_c_call =
|
|
|
770ba2 |
+ Array.of_list(List.map phys_reg
|
|
|
770ba2 |
+ [0; 1; 2; 3; 4; 5; 6; 7; 16; 17; 18; 19; 20; (* 21; 22; *)
|
|
|
770ba2 |
+ 100; 101; 102; 103; 104; 105; 106; 107; 110; 111; 112; 113; 114; 115; 116;
|
|
|
770ba2 |
+ 117; 128; 129; 130; 131])
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let destroyed_at_oper = function
|
|
|
770ba2 |
+ | Iop(Icall_ind _ | Icall_imm _ | Iextcall{alloc = true; _}) -> all_phys_regs
|
|
|
770ba2 |
+ | Iop(Iextcall{alloc = false; _}) -> destroyed_at_c_call
|
|
|
770ba2 |
+ | _ -> [||]
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let destroyed_at_raise = all_phys_regs
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Maximal register pressure *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let safe_register_pressure = function
|
|
|
770ba2 |
+ | Iextcall _ -> 15
|
|
|
770ba2 |
+ | _ -> 21
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let max_register_pressure = function
|
|
|
770ba2 |
+ | Iextcall _ -> [| 15; 18 |]
|
|
|
770ba2 |
+ | _ -> [| 21; 30 |]
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Pure operations (without any side effect besides updating their result
|
|
|
770ba2 |
+ registers). *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let op_is_pure = function
|
|
|
770ba2 |
+ | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _
|
|
|
770ba2 |
+ | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _
|
|
|
770ba2 |
+ | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false
|
|
|
770ba2 |
+ | Ispecific(Imultaddf _ | Imultsubf _) -> true
|
|
|
770ba2 |
+ | _ -> true
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Layout of the stack *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let num_stack_slots = [| 0; 0 |]
|
|
|
770ba2 |
+let contains_calls = ref false
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Calling the assembler *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let assemble_file infile outfile =
|
|
|
770ba2 |
+ Ccomp.command
|
|
|
770ba2 |
+ (Config.asm ^ " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let init () = ()
|
|
|
770ba2 |
diff --git a/asmcomp/riscv/reload.ml b/asmcomp/riscv/reload.ml
|
|
|
770ba2 |
new file mode 100644
|
|
|
770ba2 |
index 000000000..85b970342
|
|
|
770ba2 |
--- /dev/null
|
|
|
770ba2 |
+++ b/asmcomp/riscv/reload.ml
|
|
|
770ba2 |
@@ -0,0 +1,16 @@
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* OCaml *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Nicolas Ojeda Bar <n.oje.bar@gmail.com> *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Copyright 2016 Institut National de Recherche en Informatique et *)
|
|
|
770ba2 |
+(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
770ba2 |
+(* under the terms of the Q Public License version 1.0. *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Reloading for the RISC-V *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let fundecl f =
|
|
|
770ba2 |
+ (new Reloadgen.reload_generic)#fundecl f
|
|
|
770ba2 |
diff --git a/asmcomp/riscv/scheduling.ml b/asmcomp/riscv/scheduling.ml
|
|
|
770ba2 |
new file mode 100644
|
|
|
770ba2 |
index 000000000..e436be1cc
|
|
|
770ba2 |
--- /dev/null
|
|
|
770ba2 |
+++ b/asmcomp/riscv/scheduling.ml
|
|
|
770ba2 |
@@ -0,0 +1,19 @@
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* OCaml *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Nicolas Ojeda Bar <n.oje.bar@gmail.com> *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Copyright 2016 Institut National de Recherche en Informatique et *)
|
|
|
770ba2 |
+(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
770ba2 |
+(* under the terms of the Q Public License version 1.0. *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Instruction scheduling for the RISC-V *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let _ = let module M = Schedgen in () (* to create a dependency *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Scheduling is turned off. *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let fundecl f = f
|
|
|
770ba2 |
diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml
|
|
|
770ba2 |
new file mode 100644
|
|
|
770ba2 |
index 000000000..092ca88aa
|
|
|
770ba2 |
--- /dev/null
|
|
|
770ba2 |
+++ b/asmcomp/riscv/selection.ml
|
|
|
770ba2 |
@@ -0,0 +1,72 @@
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* OCaml *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Nicolas Ojeda Bar <n.oje.bar@gmail.com> *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(* Copyright 2016 Institut National de Recherche en Informatique et *)
|
|
|
770ba2 |
+(* en Automatique. All rights reserved. This file is distributed *)
|
|
|
770ba2 |
+(* under the terms of the Q Public License version 1.0. *)
|
|
|
770ba2 |
+(* *)
|
|
|
770ba2 |
+(***********************************************************************)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Instruction selection for the RISC-V processor *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+open Cmm
|
|
|
770ba2 |
+open Arch
|
|
|
770ba2 |
+open Mach
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Instruction selection *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+class selector = object (self)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+inherit Selectgen.selector_generic as super
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+method is_immediate n = is_immediate n
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+method select_addressing _ = function
|
|
|
770ba2 |
+ | Cop(Cadda, [arg; Cconst_int n], _) when self#is_immediate n ->
|
|
|
770ba2 |
+ (Iindexed n, arg)
|
|
|
770ba2 |
+ | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n], _)], dbg) when self#is_immediate n ->
|
|
|
770ba2 |
+ (Iindexed n, Cop(Caddi, [arg1; arg2], dbg))
|
|
|
770ba2 |
+ | arg ->
|
|
|
770ba2 |
+ (Iindexed 0, arg)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+method! select_operation op args dbg =
|
|
|
770ba2 |
+ match (op, args) with
|
|
|
770ba2 |
+ (* RISC-V does not support immediate operands for multiply high *)
|
|
|
770ba2 |
+ | (Cmulhi, _) -> (Iintop Imulh, args)
|
|
|
770ba2 |
+ (* Recognize (neg-)mult-add and (neg-)mult-sub instructions *)
|
|
|
770ba2 |
+ | (Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3])
|
|
|
770ba2 |
+ | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2], _)]) ->
|
|
|
770ba2 |
+ (Ispecific (Imultaddf false), [arg1; arg2; arg3])
|
|
|
770ba2 |
+ | (Csubf, [Cop(Cmulf, [arg1; arg2], _); arg3]) ->
|
|
|
770ba2 |
+ (Ispecific (Imultsubf false), [arg1; arg2; arg3])
|
|
|
770ba2 |
+ | (Cnegf, [Cop(Csubf, [Cop(Cmulf, [arg1; arg2], _); arg3], _)]) ->
|
|
|
770ba2 |
+ (Ispecific (Imultsubf true), [arg1; arg2; arg3])
|
|
|
770ba2 |
+ | (Cnegf, [Cop(Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3], _)]) ->
|
|
|
770ba2 |
+ (Ispecific (Imultaddf true), [arg1; arg2; arg3])
|
|
|
770ba2 |
+ (* RISC-V does not support immediate operands for comparison operators *)
|
|
|
770ba2 |
+ | (Ccmpi comp, args) -> (Iintop(Icomp (Isigned comp)), args)
|
|
|
770ba2 |
+ | (Ccmpa comp, args) -> (Iintop(Icomp (Iunsigned comp)), args)
|
|
|
770ba2 |
+ | (Cmuli, _) -> (Iintop Imul, args)
|
|
|
770ba2 |
+ | _ ->
|
|
|
770ba2 |
+ super#select_operation op args dbg
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+(* Instruction selection for conditionals *)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+method! select_condition = function
|
|
|
770ba2 |
+ | Cop(Ccmpi cmp, args, _) ->
|
|
|
770ba2 |
+ (Iinttest(Isigned cmp), Ctuple args)
|
|
|
770ba2 |
+ | Cop(Ccmpa cmp, args, _) ->
|
|
|
770ba2 |
+ (Iinttest(Iunsigned cmp), Ctuple args)
|
|
|
770ba2 |
+ | Cop(Ccmpf cmp, args, _) ->
|
|
|
770ba2 |
+ (Ifloattest(cmp, false), Ctuple args)
|
|
|
770ba2 |
+ | Cop(Cand, [arg; Cconst_int 1], _) ->
|
|
|
770ba2 |
+ (Ioddtest, arg)
|
|
|
770ba2 |
+ | arg ->
|
|
|
770ba2 |
+ (Itruetest, arg)
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+end
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+let fundecl f = (new selector)#emit_fundecl f
|
|
|
770ba2 |
diff --git a/asmrun/riscv.S b/asmrun/riscv.S
|
|
|
770ba2 |
new file mode 100644
|
|
|
770ba2 |
index 000000000..a82048efc
|
|
|
770ba2 |
--- /dev/null
|
|
|
770ba2 |
+++ b/asmrun/riscv.S
|
|
|
770ba2 |
@@ -0,0 +1,424 @@
|
|
|
770ba2 |
+/***********************************************************************/
|
|
|
770ba2 |
+/* */
|
|
|
770ba2 |
+/* OCaml */
|
|
|
770ba2 |
+/* */
|
|
|
770ba2 |
+/* Nicolas Ojeda Bar <n.oje.bar@gmail.com> */
|
|
|
770ba2 |
+/* */
|
|
|
770ba2 |
+/* Copyright 1996 Institut National de Recherche en Informatique et */
|
|
|
770ba2 |
+/* en Automatique. All rights reserved. This file is distributed */
|
|
|
770ba2 |
+/* under the terms of the GNU Library General Public License, with */
|
|
|
770ba2 |
+/* the special exception on linking described in file ../LICENSE. */
|
|
|
770ba2 |
+/* */
|
|
|
770ba2 |
+/***********************************************************************/
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+/* Asm part of the runtime system, RISC-V processor, 64-bit mode */
|
|
|
770ba2 |
+/* Must be preprocessed by cpp */
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+#define TRAP_PTR s1
|
|
|
770ba2 |
+#define ALLOC_PTR s10
|
|
|
770ba2 |
+#define ALLOC_LIMIT s11
|
|
|
770ba2 |
+#define TMP0 t0
|
|
|
770ba2 |
+#define TMP1 t1
|
|
|
770ba2 |
+#define ARG t2
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+#if defined(MODEL_riscv64)
|
|
|
770ba2 |
+#define store sd
|
|
|
770ba2 |
+#define load ld
|
|
|
770ba2 |
+#define WSZ 8
|
|
|
770ba2 |
+#else
|
|
|
770ba2 |
+#define store sw
|
|
|
770ba2 |
+#define load lw
|
|
|
770ba2 |
+#define WSZ 4
|
|
|
770ba2 |
+#endif
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+#if defined(__PIC__)
|
|
|
770ba2 |
+ .option pic
|
|
|
770ba2 |
+#else
|
|
|
770ba2 |
+ .option nopic
|
|
|
770ba2 |
+#endif
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .section .text
|
|
|
770ba2 |
+/* Invoke the garbage collector. */
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .globl caml_system__code_begin
|
|
|
770ba2 |
+caml_system__code_begin:
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .align 2
|
|
|
770ba2 |
+ .globl caml_call_gc
|
|
|
770ba2 |
+ .type caml_call_gc, @function
|
|
|
770ba2 |
+caml_call_gc:
|
|
|
770ba2 |
+ /* Record return address */
|
|
|
770ba2 |
+ store ra, caml_last_return_address, TMP0
|
|
|
770ba2 |
+ /* Record lowest stack address */
|
|
|
770ba2 |
+ mv TMP1, sp
|
|
|
770ba2 |
+ store sp, caml_bottom_of_stack, TMP0
|
|
|
770ba2 |
+.Lcaml_call_gc:
|
|
|
770ba2 |
+ /* Set up stack space, saving return address */
|
|
|
770ba2 |
+ /* (1 reg for RA, 1 reg for FP, 21 allocatable int regs, 20 caller-save float regs) * 8 */
|
|
|
770ba2 |
+ /* + 1 for alignment */
|
|
|
770ba2 |
+ addi sp, sp, -0x160
|
|
|
770ba2 |
+ mv s0, sp
|
|
|
770ba2 |
+ store ra, 0x8(sp)
|
|
|
770ba2 |
+ store s0, 0x0(sp)
|
|
|
770ba2 |
+ /* Save allocatable integer registers on the stack,
|
|
|
770ba2 |
+ in the order given in proc.ml */
|
|
|
770ba2 |
+ store a0, 0x10(sp)
|
|
|
770ba2 |
+ store a1, 0x18(sp)
|
|
|
770ba2 |
+ store a2, 0x20(sp)
|
|
|
770ba2 |
+ store a3, 0x28(sp)
|
|
|
770ba2 |
+ store a4, 0x30(sp)
|
|
|
770ba2 |
+ store a5, 0x38(sp)
|
|
|
770ba2 |
+ store a6, 0x40(sp)
|
|
|
770ba2 |
+ store a7, 0x48(sp)
|
|
|
770ba2 |
+ store s2, 0x50(sp)
|
|
|
770ba2 |
+ store s3, 0x58(sp)
|
|
|
770ba2 |
+ store s4, 0x60(sp)
|
|
|
770ba2 |
+ store s5, 0x68(sp)
|
|
|
770ba2 |
+ store s6, 0x70(sp)
|
|
|
770ba2 |
+ store s7, 0x78(sp)
|
|
|
770ba2 |
+ store s8, 0x80(sp)
|
|
|
770ba2 |
+ store s9, 0x88(sp)
|
|
|
770ba2 |
+ store t2, 0x90(sp)
|
|
|
770ba2 |
+ store t3, 0x98(sp)
|
|
|
770ba2 |
+ store t4, 0xa0(sp)
|
|
|
770ba2 |
+ store t5, 0xa8(sp)
|
|
|
770ba2 |
+ store t6, 0xb0(sp)
|
|
|
770ba2 |
+ /* Save caller-save floating-point registers on the stack
|
|
|
770ba2 |
+ (callee-saves are preserved by caml_garbage_collection) */
|
|
|
770ba2 |
+ fsd ft0, 0xb8(sp)
|
|
|
770ba2 |
+ fsd ft1, 0xc0(sp)
|
|
|
770ba2 |
+ fsd ft2, 0xc8(sp)
|
|
|
770ba2 |
+ fsd ft3, 0xd0(sp)
|
|
|
770ba2 |
+ fsd ft4, 0xd8(sp)
|
|
|
770ba2 |
+ fsd ft5, 0xe0(sp)
|
|
|
770ba2 |
+ fsd ft6, 0xe8(sp)
|
|
|
770ba2 |
+ fsd ft7, 0xf0(sp)
|
|
|
770ba2 |
+ fsd fa0, 0xf8(sp)
|
|
|
770ba2 |
+ fsd fa1, 0x100(sp)
|
|
|
770ba2 |
+ fsd fa2, 0x108(sp)
|
|
|
770ba2 |
+ fsd fa3, 0x110(sp)
|
|
|
770ba2 |
+ fsd fa4, 0x118(sp)
|
|
|
770ba2 |
+ fsd fa5, 0x120(sp)
|
|
|
770ba2 |
+ fsd fa6, 0x128(sp)
|
|
|
770ba2 |
+ fsd fa7, 0x130(sp)
|
|
|
770ba2 |
+ fsd ft8, 0x138(sp)
|
|
|
770ba2 |
+ fsd ft9, 0x140(sp)
|
|
|
770ba2 |
+ fsd ft9, 0x148(sp)
|
|
|
770ba2 |
+ fsd ft10, 0x150(sp)
|
|
|
770ba2 |
+ fsd ft11, 0x158(sp)
|
|
|
770ba2 |
+ /* Store pointer to saved integer registers in caml_gc_regs */
|
|
|
770ba2 |
+ addi TMP1, sp, 16
|
|
|
770ba2 |
+ store TMP1, caml_gc_regs, TMP0
|
|
|
770ba2 |
+ /* Save current allocation pointer for debugging purposes */
|
|
|
770ba2 |
+ store ALLOC_PTR, caml_young_ptr, TMP0
|
|
|
770ba2 |
+ /* Save trap pointer in case an exception is raised during GC */
|
|
|
770ba2 |
+ store TRAP_PTR, caml_exception_pointer, TMP0
|
|
|
770ba2 |
+ /* Call the garbage collector */
|
|
|
770ba2 |
+ call caml_garbage_collection
|
|
|
770ba2 |
+ /* Restore registers */
|
|
|
770ba2 |
+ load a0, 0x10(sp)
|
|
|
770ba2 |
+ load a1, 0x18(sp)
|
|
|
770ba2 |
+ load a2, 0x20(sp)
|
|
|
770ba2 |
+ load a3, 0x28(sp)
|
|
|
770ba2 |
+ load a4, 0x30(sp)
|
|
|
770ba2 |
+ load a5, 0x38(sp)
|
|
|
770ba2 |
+ load a6, 0x40(sp)
|
|
|
770ba2 |
+ load a7, 0x48(sp)
|
|
|
770ba2 |
+ load s2, 0x50(sp)
|
|
|
770ba2 |
+ load s3, 0x58(sp)
|
|
|
770ba2 |
+ load s4, 0x60(sp)
|
|
|
770ba2 |
+ load s5, 0x68(sp)
|
|
|
770ba2 |
+ load s6, 0x70(sp)
|
|
|
770ba2 |
+ load s7, 0x78(sp)
|
|
|
770ba2 |
+ load s8, 0x80(sp)
|
|
|
770ba2 |
+ load s9, 0x88(sp)
|
|
|
770ba2 |
+ load t2, 0x90(sp)
|
|
|
770ba2 |
+ load t3, 0x98(sp)
|
|
|
770ba2 |
+ load t4, 0xa0(sp)
|
|
|
770ba2 |
+ load t5, 0xa8(sp)
|
|
|
770ba2 |
+ load t6, 0xb0(sp)
|
|
|
770ba2 |
+ fld ft0, 0xb8(sp)
|
|
|
770ba2 |
+ fld ft1, 0xc0(sp)
|
|
|
770ba2 |
+ fld ft2, 0xc8(sp)
|
|
|
770ba2 |
+ fld ft3, 0xd0(sp)
|
|
|
770ba2 |
+ fld ft4, 0xd8(sp)
|
|
|
770ba2 |
+ fld ft5, 0xe0(sp)
|
|
|
770ba2 |
+ fld ft6, 0xe8(sp)
|
|
|
770ba2 |
+ fld ft7, 0xf0(sp)
|
|
|
770ba2 |
+ fld fa0, 0xf8(sp)
|
|
|
770ba2 |
+ fld fa1, 0x100(sp)
|
|
|
770ba2 |
+ fld fa2, 0x108(sp)
|
|
|
770ba2 |
+ fld fa3, 0x110(sp)
|
|
|
770ba2 |
+ fld fa4, 0x118(sp)
|
|
|
770ba2 |
+ fld fa5, 0x120(sp)
|
|
|
770ba2 |
+ fld fa6, 0x128(sp)
|
|
|
770ba2 |
+ fld fa7, 0x130(sp)
|
|
|
770ba2 |
+ fld ft8, 0x138(sp)
|
|
|
770ba2 |
+ fld ft9, 0x140(sp)
|
|
|
770ba2 |
+ fld ft9, 0x148(sp)
|
|
|
770ba2 |
+ fld ft10, 0x150(sp)
|
|
|
770ba2 |
+ fld ft11, 0x158(sp)
|
|
|
770ba2 |
+ /* Reload new allocation pointer and allocation limit */
|
|
|
770ba2 |
+ load ALLOC_PTR, caml_young_ptr
|
|
|
770ba2 |
+ load ALLOC_LIMIT, caml_young_limit
|
|
|
770ba2 |
+ /* Free stack space and return to caller */
|
|
|
770ba2 |
+ load ra, 0x8(sp)
|
|
|
770ba2 |
+ load s0, 0x0(sp)
|
|
|
770ba2 |
+ addi sp, sp, 0x160
|
|
|
770ba2 |
+ ret
|
|
|
770ba2 |
+ .size caml_call_gc, .-caml_call_gc
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+/* Call a C function from OCaml */
|
|
|
770ba2 |
+/* Function to call is in ARG */
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .align 2
|
|
|
770ba2 |
+ .globl caml_c_call
|
|
|
770ba2 |
+ .type caml_c_call, @function
|
|
|
770ba2 |
+caml_c_call:
|
|
|
770ba2 |
+ /* Preserve return address in callee-save register s2 */
|
|
|
770ba2 |
+ mv s2, ra
|
|
|
770ba2 |
+ /* Record lowest stack address and return address */
|
|
|
770ba2 |
+ store ra, caml_last_return_address, TMP0
|
|
|
770ba2 |
+ store sp, caml_bottom_of_stack, TMP0
|
|
|
770ba2 |
+ /* Make the exception handler alloc ptr available to the C code */
|
|
|
770ba2 |
+ store ALLOC_PTR, caml_young_ptr, TMP0
|
|
|
770ba2 |
+ store TRAP_PTR, caml_exception_pointer, TMP0
|
|
|
770ba2 |
+ /* Call the function */
|
|
|
770ba2 |
+ jalr ARG
|
|
|
770ba2 |
+ /* Reload alloc ptr and alloc limit */
|
|
|
770ba2 |
+ load ALLOC_PTR, caml_young_ptr
|
|
|
770ba2 |
+ load TRAP_PTR, caml_exception_pointer
|
|
|
770ba2 |
+ /* Return */
|
|
|
770ba2 |
+ jr s2
|
|
|
770ba2 |
+ .size caml_c_call, .-caml_c_call
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+/* Raise an exception from OCaml */
|
|
|
770ba2 |
+ .align 2
|
|
|
770ba2 |
+ .globl caml_raise_exn
|
|
|
770ba2 |
+ .type caml_raise_exn, @function
|
|
|
770ba2 |
+caml_raise_exn:
|
|
|
770ba2 |
+ /* Test if backtrace is active */
|
|
|
770ba2 |
+ load TMP1, caml_backtrace_active
|
|
|
770ba2 |
+ bnez TMP1, 2f
|
|
|
770ba2 |
+1: /* Cut stack at current trap handler */
|
|
|
770ba2 |
+ mv sp, TRAP_PTR
|
|
|
770ba2 |
+ /* Pop previous handler and jump to it */
|
|
|
770ba2 |
+ load TMP1, 8(sp)
|
|
|
770ba2 |
+ load TRAP_PTR, 0(sp)
|
|
|
770ba2 |
+ addi sp, sp, 16
|
|
|
770ba2 |
+ jr TMP1
|
|
|
770ba2 |
+2: /* Preserve exception bucket in callee-save register s2 */
|
|
|
770ba2 |
+ mv s2, a0
|
|
|
770ba2 |
+ /* Stash the backtrace */
|
|
|
770ba2 |
+ mv a1, ra
|
|
|
770ba2 |
+ mv a2, sp
|
|
|
770ba2 |
+ mv a3, TRAP_PTR
|
|
|
770ba2 |
+ call caml_stash_backtrace
|
|
|
770ba2 |
+ /* Restore exception bucket and raise */
|
|
|
770ba2 |
+ mv a0, s2
|
|
|
770ba2 |
+ j 1b
|
|
|
770ba2 |
+ .size caml_raise_exn, .-caml_raise_exn
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .globl caml_reraise_exn
|
|
|
770ba2 |
+ .type caml_reraise_exn, @function
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+/* Raise an exception from C */
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .align 2
|
|
|
770ba2 |
+ .globl caml_raise_exception
|
|
|
770ba2 |
+ .type caml_raise_exception, @function
|
|
|
770ba2 |
+caml_raise_exception:
|
|
|
770ba2 |
+ load TRAP_PTR, caml_exception_pointer
|
|
|
770ba2 |
+ load ALLOC_PTR, caml_young_ptr
|
|
|
770ba2 |
+ load ALLOC_LIMIT, caml_young_limit
|
|
|
770ba2 |
+ load TMP1, caml_backtrace_active
|
|
|
770ba2 |
+ bnez TMP1, 2f
|
|
|
770ba2 |
+1: /* Cut stack at current trap handler */
|
|
|
770ba2 |
+ mv sp, TRAP_PTR
|
|
|
770ba2 |
+ load TMP1, 8(sp)
|
|
|
770ba2 |
+ load TRAP_PTR, 0(sp)
|
|
|
770ba2 |
+ addi sp, sp, 16
|
|
|
770ba2 |
+ jr TMP1
|
|
|
770ba2 |
+2: /* Preserve exception bucket in callee-save register s2 */
|
|
|
770ba2 |
+ mv s2, a0
|
|
|
770ba2 |
+ load a1, caml_last_return_address
|
|
|
770ba2 |
+ load a2, caml_bottom_of_stack
|
|
|
770ba2 |
+ mv a3, TRAP_PTR
|
|
|
770ba2 |
+ call caml_stash_backtrace
|
|
|
770ba2 |
+ mv a0, s2
|
|
|
770ba2 |
+ j 1b
|
|
|
770ba2 |
+ .size caml_raise_exception, .-caml_raise_exception
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+/* Start the OCaml program */
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .align 2
|
|
|
770ba2 |
+ .globl caml_start_program
|
|
|
770ba2 |
+ .type caml_start_program, @function
|
|
|
770ba2 |
+caml_start_program:
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ la ARG, caml_program
|
|
|
770ba2 |
+ /* Code shared with caml_callback* */
|
|
|
770ba2 |
+ /* Address of OCaml code to call is in ARG */
|
|
|
770ba2 |
+ /* Arguments to the OCaml code are in a0 ... a7 */
|
|
|
770ba2 |
+.Ljump_to_caml:
|
|
|
770ba2 |
+ /* Set up stack frame and save callee-save registers */
|
|
|
770ba2 |
+ addi sp, sp, -0xd0
|
|
|
770ba2 |
+ store ra, 0xc0(sp)
|
|
|
770ba2 |
+ store s0, 0x0(sp)
|
|
|
770ba2 |
+ store s1, 0x8(sp)
|
|
|
770ba2 |
+ store s2, 0x10(sp)
|
|
|
770ba2 |
+ store s3, 0x18(sp)
|
|
|
770ba2 |
+ store s4, 0x20(sp)
|
|
|
770ba2 |
+ store s5, 0x28(sp)
|
|
|
770ba2 |
+ store s6, 0x30(sp)
|
|
|
770ba2 |
+ store s7, 0x38(sp)
|
|
|
770ba2 |
+ store s8, 0x40(sp)
|
|
|
770ba2 |
+ store s9, 0x48(sp)
|
|
|
770ba2 |
+ store s10, 0x50(sp)
|
|
|
770ba2 |
+ store s11, 0x58(sp)
|
|
|
770ba2 |
+ fsd fs0, 0x60(sp)
|
|
|
770ba2 |
+ fsd fs1, 0x68(sp)
|
|
|
770ba2 |
+ fsd fs2, 0x70(sp)
|
|
|
770ba2 |
+ fsd fs3, 0x78(sp)
|
|
|
770ba2 |
+ fsd fs4, 0x80(sp)
|
|
|
770ba2 |
+ fsd fs5, 0x88(sp)
|
|
|
770ba2 |
+ fsd fs6, 0x90(sp)
|
|
|
770ba2 |
+ fsd fs7, 0x98(sp)
|
|
|
770ba2 |
+ fsd fs8, 0xa0(sp)
|
|
|
770ba2 |
+ fsd fs9, 0xa8(sp)
|
|
|
770ba2 |
+ fsd fs10, 0xb0(sp)
|
|
|
770ba2 |
+ fsd fs11, 0xb8(sp)
|
|
|
770ba2 |
+ addi sp, sp, -32
|
|
|
770ba2 |
+ /* Setup a callback link on the stack */
|
|
|
770ba2 |
+ load TMP1, caml_bottom_of_stack
|
|
|
770ba2 |
+ store TMP1, 0(sp)
|
|
|
770ba2 |
+ load TMP1, caml_last_return_address
|
|
|
770ba2 |
+ store TMP1, 8(sp)
|
|
|
770ba2 |
+ load TMP1, caml_gc_regs
|
|
|
770ba2 |
+ store TMP1, 16(sp)
|
|
|
770ba2 |
+ /* set up a trap frame */
|
|
|
770ba2 |
+ addi sp, sp, -16
|
|
|
770ba2 |
+ load TMP1, caml_exception_pointer
|
|
|
770ba2 |
+ store TMP1, 0(sp)
|
|
|
770ba2 |
+ lla TMP0, .Ltrap_handler
|
|
|
770ba2 |
+ store TMP0, 8(sp)
|
|
|
770ba2 |
+ mv TRAP_PTR, sp
|
|
|
770ba2 |
+ load ALLOC_PTR, caml_young_ptr
|
|
|
770ba2 |
+ load ALLOC_LIMIT, caml_young_limit
|
|
|
770ba2 |
+ store x0, caml_last_return_address, TMP0
|
|
|
770ba2 |
+ jalr ARG
|
|
|
770ba2 |
+.Lcaml_retaddr: /* pop trap frame, restoring caml_exception_pointer */
|
|
|
770ba2 |
+ load TMP1, 0(sp)
|
|
|
770ba2 |
+ store TMP1, caml_exception_pointer, TMP0
|
|
|
770ba2 |
+ addi sp, sp, 16
|
|
|
770ba2 |
+.Lreturn_result: /* pop callback link, restoring global variables */
|
|
|
770ba2 |
+ load TMP1, 0(sp)
|
|
|
770ba2 |
+ store TMP1, caml_bottom_of_stack, TMP0
|
|
|
770ba2 |
+ load TMP1, 8(sp)
|
|
|
770ba2 |
+ store TMP1, caml_last_return_address, TMP0
|
|
|
770ba2 |
+ load TMP1, 16(sp)
|
|
|
770ba2 |
+ store TMP1, caml_gc_regs, TMP0
|
|
|
770ba2 |
+ addi sp, sp, 32
|
|
|
770ba2 |
+ /* Update allocation pointer */
|
|
|
770ba2 |
+ store ALLOC_PTR, caml_young_ptr, TMP0
|
|
|
770ba2 |
+ /* reload callee-save registers and return */
|
|
|
770ba2 |
+ load ra, 0xc0(sp)
|
|
|
770ba2 |
+ load s0, 0x0(sp)
|
|
|
770ba2 |
+ load s1, 0x8(sp)
|
|
|
770ba2 |
+ load s2, 0x10(sp)
|
|
|
770ba2 |
+ load s3, 0x18(sp)
|
|
|
770ba2 |
+ load s4, 0x20(sp)
|
|
|
770ba2 |
+ load s5, 0x28(sp)
|
|
|
770ba2 |
+ load s6, 0x30(sp)
|
|
|
770ba2 |
+ load s7, 0x38(sp)
|
|
|
770ba2 |
+ load s8, 0x40(sp)
|
|
|
770ba2 |
+ load s9, 0x48(sp)
|
|
|
770ba2 |
+ load s10, 0x50(sp)
|
|
|
770ba2 |
+ load s11, 0x58(sp)
|
|
|
770ba2 |
+ fld fs0, 0x60(sp)
|
|
|
770ba2 |
+ fld fs1, 0x68(sp)
|
|
|
770ba2 |
+ fld fs2, 0x70(sp)
|
|
|
770ba2 |
+ fld fs3, 0x78(sp)
|
|
|
770ba2 |
+ fld fs4, 0x80(sp)
|
|
|
770ba2 |
+ fld fs5, 0x88(sp)
|
|
|
770ba2 |
+ fld fs6, 0x90(sp)
|
|
|
770ba2 |
+ fld fs7, 0x98(sp)
|
|
|
770ba2 |
+ fld fs8, 0xa0(sp)
|
|
|
770ba2 |
+ fld fs9, 0xa8(sp)
|
|
|
770ba2 |
+ fld fs10, 0xb0(sp)
|
|
|
770ba2 |
+ fld fs11, 0xb8(sp)
|
|
|
770ba2 |
+ addi sp, sp, 0xd0
|
|
|
770ba2 |
+ ret
|
|
|
770ba2 |
+.Ltrap_handler:
|
|
|
770ba2 |
+ store TRAP_PTR, caml_exception_pointer, TMP0
|
|
|
770ba2 |
+ ori a0, a0, 2
|
|
|
770ba2 |
+ j .Lreturn_result
|
|
|
770ba2 |
+ .size caml_start_program, .-caml_start_program
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+/* Callback from C to OCaml */
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .align 2
|
|
|
770ba2 |
+ .globl caml_callback_exn
|
|
|
770ba2 |
+ .type caml_callback_exn, @function
|
|
|
770ba2 |
+caml_callback_exn:
|
|
|
770ba2 |
+ /* Initial shuffling of arguments (a0 = closure, a1 = first arg) */
|
|
|
770ba2 |
+ mv TMP1, a0
|
|
|
770ba2 |
+ mv a0, a1 /* a0 = first arg */
|
|
|
770ba2 |
+ mv a1, TMP1 /* a1 = closure environment */
|
|
|
770ba2 |
+ load ARG, 0(TMP1) /* code pointer */
|
|
|
770ba2 |
+ j .Ljump_to_caml
|
|
|
770ba2 |
+ .size caml_callback_exn, .-caml_callback_exn
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .align 2
|
|
|
770ba2 |
+ .globl caml_callback2_exn
|
|
|
770ba2 |
+ .type caml_callback2_exn, @function
|
|
|
770ba2 |
+caml_callback2_exn:
|
|
|
770ba2 |
+ /* Initial shuffling of arguments (a0 = closure, a1 = arg1, a2 = arg2) */
|
|
|
770ba2 |
+ mv TMP1, a0
|
|
|
770ba2 |
+ mv a0, a1
|
|
|
770ba2 |
+ mv a1, a2
|
|
|
770ba2 |
+ mv a2, TMP1
|
|
|
770ba2 |
+ la ARG, caml_apply2
|
|
|
770ba2 |
+ j .Ljump_to_caml
|
|
|
770ba2 |
+ .size caml_callback2_exn, .-caml_callback2_exn
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .align 2
|
|
|
770ba2 |
+ .globl caml_callback3_exn
|
|
|
770ba2 |
+ .type caml_callback3_exn, @function
|
|
|
770ba2 |
+caml_callback3_exn:
|
|
|
770ba2 |
+ /* Initial shuffling of argumnets */
|
|
|
770ba2 |
+ /* (a0 = closure, a1 = arg1, a2 = arg2, a3 = arg3) */
|
|
|
770ba2 |
+ mv TMP1, a0
|
|
|
770ba2 |
+ mv a0, a1
|
|
|
770ba2 |
+ mv a1, a2
|
|
|
770ba2 |
+ mv a2, a3
|
|
|
770ba2 |
+ mv a3, TMP1
|
|
|
770ba2 |
+ la ARG, caml_apply3
|
|
|
770ba2 |
+ j .Ljump_to_caml
|
|
|
770ba2 |
+ .size caml_callback3_exn, .-caml_callback3_exn
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .align 2
|
|
|
770ba2 |
+ .globl caml_ml_array_bound_error
|
|
|
770ba2 |
+ .type caml_ml_array_bound_error, @function
|
|
|
770ba2 |
+caml_ml_array_bound_error:
|
|
|
770ba2 |
+ /* Load address of [caml_array_bound_error] in ARG */
|
|
|
770ba2 |
+ la ARG, caml_array_bound_error
|
|
|
770ba2 |
+ /* Call that function */
|
|
|
770ba2 |
+ j caml_c_call
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .globl caml_system__code_end
|
|
|
770ba2 |
+caml_system__code_end:
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+/* GC roots for callback */
|
|
|
770ba2 |
+
|
|
|
770ba2 |
+ .section .data
|
|
|
770ba2 |
+ .align 3
|
|
|
770ba2 |
+ .globl caml_system__frametable
|
|
|
770ba2 |
+ .type caml_system__frametable, @object
|
|
|
770ba2 |
+caml_system__frametable:
|
|
|
770ba2 |
+ .quad 1 /* one descriptor */
|
|
|
770ba2 |
+ .quad .Lcaml_retaddr /* return address into callback */
|
|
|
770ba2 |
+ .short -1 /* negative frame size => use callback link */
|
|
|
770ba2 |
+ .short 0 /* no roots */
|
|
|
770ba2 |
+ .align 3
|
|
|
770ba2 |
+ .size caml_system__frametable, .-caml_system__frametable
|
|
|
770ba2 |
diff --git a/byterun/caml/stack.h b/byterun/caml/stack.h
|
|
|
770ba2 |
index 266863986..e198be0a6 100644
|
|
|
770ba2 |
--- a/byterun/caml/stack.h
|
|
|
770ba2 |
+++ b/byterun/caml/stack.h
|
|
|
770ba2 |
@@ -70,6 +70,11 @@
|
|
|
770ba2 |
#define Callback_link(sp) ((struct caml_context *)((sp) + 16))
|
|
|
770ba2 |
#endif
|
|
|
770ba2 |
|
|
|
770ba2 |
+#ifdef TARGET_riscv /* FIXME FIXME */
|
|
|
770ba2 |
+#define Saved_return_address(sp) *((intnat *)((sp) - 8))
|
|
|
770ba2 |
+#define Callback_link(sp) ((struct caml_context *)((sp) + 16))
|
|
|
770ba2 |
+#endif
|
|
|
770ba2 |
+
|
|
|
770ba2 |
/* Structure of OCaml callback contexts */
|
|
|
770ba2 |
|
|
|
770ba2 |
struct caml_context {
|
|
|
770ba2 |
diff --git a/config/gnu/config.guess b/config/gnu/config.guess
|
|
|
770ba2 |
index b79252d6b..8335398b2 100755
|
|
|
770ba2 |
--- a/config/gnu/config.guess
|
|
|
770ba2 |
+++ b/config/gnu/config.guess
|
|
|
770ba2 |
@@ -2,7 +2,7 @@
|
|
|
770ba2 |
# Attempt to guess a canonical system name.
|
|
|
770ba2 |
# Copyright 1992-2013 Free Software Foundation, Inc.
|
|
|
770ba2 |
|
|
|
770ba2 |
-timestamp='2013-06-10'
|
|
|
770ba2 |
+timestamp='2016-10-23'
|
|
|
770ba2 |
|
|
|
770ba2 |
# This file is free software; you can redistribute it and/or modify it
|
|
|
770ba2 |
# under the terms of the GNU General Public License as published by
|
|
|
770ba2 |
@@ -1001,6 +1001,9 @@ EOF
|
|
|
770ba2 |
ppcle:Linux:*:*)
|
|
|
770ba2 |
echo powerpcle-unknown-linux-${LIBC}
|
|
|
770ba2 |
exit ;;
|
|
|
770ba2 |
+ riscv*:Linux:*:*)
|
|
|
770ba2 |
+ echo ${UNAME_MACHINE}-unknown-linux
|
|
|
770ba2 |
+ exit ;;
|
|
|
770ba2 |
s390:Linux:*:* | s390x:Linux:*:*)
|
|
|
770ba2 |
echo ${UNAME_MACHINE}-ibm-linux-${LIBC}
|
|
|
770ba2 |
exit ;;
|
|
|
770ba2 |
diff --git a/configure b/configure
|
|
|
770ba2 |
index 53f45f85b..cf5a4a02a 100755
|
|
|
770ba2 |
--- a/configure
|
|
|
770ba2 |
+++ b/configure
|
|
|
770ba2 |
@@ -928,6 +928,7 @@ if $with_sharedlibs; then
|
|
|
770ba2 |
arm*-*-freebsd*) natdynlink=true;;
|
|
|
770ba2 |
earm*-*-netbsd*) natdynlink=true;;
|
|
|
770ba2 |
aarch64-*-linux*) natdynlink=true;;
|
|
|
770ba2 |
+ riscv*-*-linux*) natdynlink=true;;
|
|
|
770ba2 |
esac
|
|
|
770ba2 |
fi
|
|
|
770ba2 |
|
|
|
770ba2 |
@@ -1004,6 +1005,8 @@ case "$target" in
|
|
|
770ba2 |
x86_64-*-mingw*) arch=amd64; system=mingw;;
|
|
|
770ba2 |
aarch64-*-linux*) arch=arm64; system=linux;;
|
|
|
770ba2 |
x86_64-*-cygwin*) arch=amd64; system=cygwin;;
|
|
|
770ba2 |
+ riscv32-*-linux*) arch=riscv; model=riscv32; system=linux;;
|
|
|
770ba2 |
+ riscv64-*-linux*) arch=riscv; model=riscv64; system=linux;;
|
|
|
770ba2 |
esac
|
|
|
770ba2 |
|
|
|
770ba2 |
# Some platforms exist both in 32-bit and 64-bit variants, not distinguished
|
|
|
770ba2 |
@@ -1062,7 +1065,7 @@ case "$arch,$system" in
|
|
|
770ba2 |
aspp="${TOOLPREF}cc -c";;
|
|
|
770ba2 |
*,freebsd) as="${TOOLPREF}as"
|
|
|
770ba2 |
aspp="${TOOLPREF}cc -c";;
|
|
|
770ba2 |
- amd64,*|arm,*|arm64,*|i386,*|power,bsd*|power,netbsd)
|
|
|
770ba2 |
+ amd64,*|arm,*|arm64,*|i386,*|power,bsd*|power,netbsd|riscv,*)
|
|
|
770ba2 |
as="${TOOLPREF}as"
|
|
|
770ba2 |
case "$ccfamily" in
|
|
|
770ba2 |
clang-*)
|
|
|
770ba2 |
--
|
|
|
770ba2 |
2.17.1
|
|
|
770ba2 |
|