diff --git a/0001-increment-version-number-after-tagging-4.09.0.patch b/0001-increment-version-number-after-tagging-4.09.0.patch new file mode 100644 index 0000000..646daeb --- /dev/null +++ b/0001-increment-version-number-after-tagging-4.09.0.patch @@ -0,0 +1,52 @@ +From 6207460e793f8c5538bfd8164fa3078f7300b57a Mon Sep 17 00:00:00 2001 +From: Florian Angeletti +Date: Tue, 17 Sep 2019 14:35:00 +0200 +Subject: [PATCH 01/12] increment version number after tagging 4.09.0 + +--- + VERSION | 2 +- + configure | Bin 542920 -> 542985 bytes + ocaml-variants.opam | 4 ++-- + 3 files changed, 3 insertions(+), 3 deletions(-) + +diff --git a/VERSION b/VERSION +index 7128cac1f..ff541f87c 100644 +--- a/VERSION ++++ b/VERSION +@@ -1,4 +1,4 @@ +-4.09.0 ++4.09.1+dev0 + + # The version string is the first line of this file. + # It must be in the format described in stdlib/sys.mli +diff --git a/configure b/configure +index 85fb6842dffc1ba52a07895aefa7d49f7f383d17..c364be4e3a365e01c667023ea23238037446a3c3 100755 +GIT binary patch +delta 189 +zcmX>xQL%H9;)HruL+zB*vW@kPP7u~4XE_LCvz&8XD3m#8#&>QgbMlgF5>RI5-Yp&w +z=5|>&Ml~Hauu%rn8#gjaOph^Ql!r=I8!_gwL)h&vEg6BB35c12m}UD*OIB{E&Fx>R +iS%H{s`pItkZr(8CJNM=_ORh;U8cg?LW0c>#eD4&G?G9{= +zYC1rXkJ^k9(_4%f<+raeV$5T2m$qUAVkRJF24a@&(pIe8PVL$?tU%1RUAu;T8Pjy2 +TUf=D?_3WDL+XLI!cN_u$b;&5C + +diff --git a/ocaml-variants.opam b/ocaml-variants.opam +index 30d48eb24..5410d1f4c 100644 +--- a/ocaml-variants.opam ++++ b/ocaml-variants.opam +@@ -1,8 +1,8 @@ + opam-version: "2.0" +-version: "4.09.0" ++version: "4.09.1+trunk" + synopsis: "OCaml development version" + depends: [ +- "ocaml" {= "4.09.0" & post} ++ "ocaml" {= "4.09.1" & post} + "base-unix" {post} + "base-bigarray" {post} + "base-threads" {post} +-- +2.23.0 + diff --git a/0002-mark-the-release-in-the-Changes.patch b/0002-mark-the-release-in-the-Changes.patch new file mode 100644 index 0000000..78a91d2 --- /dev/null +++ b/0002-mark-the-release-in-the-Changes.patch @@ -0,0 +1,27 @@ +From c1db490f8d92e7b5f1a4685cd9a095f24429bb3e Mon Sep 17 00:00:00 2001 +From: Gabriel Scherer +Date: Thu, 19 Sep 2019 15:40:49 +0200 +Subject: [PATCH 02/12] mark the release in the Changes + +--- + Changes | 7 +++++-- + 1 file changed, 5 insertions(+), 2 deletions(-) + +diff --git a/Changes b/Changes +index d4b8a994d..e95ae5e49 100644 +--- a/Changes ++++ b/Changes +@@ -1,5 +1,8 @@ +-OCaml 4.09.0 +------------- ++OCaml 4.09 maintenance branch: ++------------------------------ ++ ++OCaml 4.09.0 (19 September 2019): ++--------------------------------- + + (Changes that can break existing programs are marked with a "*") + +-- +2.23.0 + diff --git a/0003-Merge-pull-request-8954-from-Armael-fix-toplevel-sub.patch b/0003-Merge-pull-request-8954-from-Armael-fix-toplevel-sub.patch new file mode 100644 index 0000000..2cb9cc4 --- /dev/null +++ b/0003-Merge-pull-request-8954-from-Armael-fix-toplevel-sub.patch @@ -0,0 +1,46 @@ +From 1204abd71a4ef585dbb70ba68a5879856d24c1a9 Mon Sep 17 00:00:00 2001 +From: Gabriel Scherer +Date: Fri, 20 Sep 2019 10:58:09 +0200 +Subject: [PATCH 03/12] Merge pull request #8954 from + Armael/fix-toplevel-submsg-locs + +Fix error submessages in the toplevel: do not display dummy locations + +(cherry picked from commit 8f7708a0fbc3e1199ccf04a6b9e1ba8e0f0d5254) +--- + Changes | 4 ++++ + parsing/location.ml | 3 ++- + 2 files changed, 6 insertions(+), 1 deletion(-) + +diff --git a/Changes b/Changes +index e95ae5e49..355cb1a94 100644 +--- a/Changes ++++ b/Changes +@@ -1,6 +1,10 @@ + OCaml 4.09 maintenance branch: + ------------------------------ + ++- #8953, #8954: Fix error submessages in the toplevel: do not display ++ dummy locations ++ (Armaël Guéneau, review by Gabriel Scherer) ++ + OCaml 4.09.0 (19 September 2019): + --------------------------------- + +diff --git a/parsing/location.ml b/parsing/location.ml +index 25cba42c7..ab823d36f 100644 +--- a/parsing/location.ml ++++ b/parsing/location.ml +@@ -752,7 +752,8 @@ let terminfo_toplevel_printer (lb: lexbuf): report_printer = + in + let pp_main_loc _ _ _ _ = () in + let pp_submsg_loc _ _ ppf loc = +- Format.fprintf ppf "%a:@ " print_loc loc in ++ if not loc.loc_ghost then ++ Format.fprintf ppf "%a:@ " print_loc loc in + { batch_mode_printer with pp; pp_main_loc; pp_submsg_loc } + + let best_toplevel_printer () = +-- +2.23.0 + diff --git a/0004-Add-RISC-V-backend.patch b/0004-Add-RISC-V-backend.patch deleted file mode 100644 index 63ceeb6..0000000 --- a/0004-Add-RISC-V-backend.patch +++ /dev/null @@ -1,6598 +0,0 @@ -From acc93802cac96da98ad5468756da2025625ca416 Mon Sep 17 00:00:00 2001 -From: Nicolas Ojeda Bar -Date: Fri, 27 Oct 2017 17:05:25 +0200 -Subject: [PATCH 4/5] Add RISC-V backend -MIME-Version: 1.0 -Content-Type: text/plain; charset=UTF-8 -Content-Transfer-Encoding: 8bit - -This is the RISC-V backend by Nicolás Ojeda Bär, cherry-picked for -Fedora from https://github.com/nojb/riscv-ocaml/commits/trunk - -The following additional commits are included: - -- Copyright, untabify - -- fix caml_c_call: reload caml_young_limit - -- Adapt to changes in trunk - -- Adapt to changes in trunk - -- Adapt configure.ac - -- Update config.{guess,sub} - -- Regenerate configure - -- Add Proc.dwarf_register_numbers - -- Add Proc.stack_ptr_dwarf_register_number - -- Add Proc.destroyed_at_reloadretaddr - -- Typo - -- Rename - -- riscv.S: align to 16 - -- Test CI ---- - .travis.yml | 32 +- - README.adoc | 1 + - asmcomp/riscv/CSE.ml | 36 + - asmcomp/riscv/arch.ml | 87 ++ - asmcomp/riscv/emit.mlp | 655 +++++++++ - asmcomp/riscv/proc.ml | 330 +++++ - asmcomp/riscv/reload.ml | 16 + - asmcomp/riscv/scheduling.ml | 19 + - asmcomp/riscv/selection.ml | 71 + - config/gnu/config.guess | 925 ++++++------- - config/gnu/config.sub | 2505 ++++++++++++++++++----------------- - configure | 10 +- - configure.ac | 11 +- - runtime/caml/stack.h | 5 + - runtime/riscv.S | 424 ++++++ - 15 files changed, 3352 insertions(+), 1775 deletions(-) - create mode 100644 asmcomp/riscv/CSE.ml - create mode 100644 asmcomp/riscv/arch.ml - create mode 100644 asmcomp/riscv/emit.mlp - create mode 100644 asmcomp/riscv/proc.ml - create mode 100644 asmcomp/riscv/reload.ml - create mode 100644 asmcomp/riscv/scheduling.ml - create mode 100644 asmcomp/riscv/selection.ml - create mode 100644 runtime/riscv.S - -diff --git a/.travis.yml b/.travis.yml -index 60b2d7abb..410ed8b51 100644 ---- a/.travis.yml -+++ b/.travis.yml -@@ -13,36 +13,16 @@ - #* * - #************************************************************************** - --sudo: false - language: c -+services: -+ - docker - git: - submodules: false --script: bash -e tools/ci/travis/travis-ci.sh --matrix: -- include: -- - env: CI_KIND=build XARCH=i386 -- addons: -- apt: -- packages: -- - gcc:i386 -- - cpp:i386 -- - binutils:i386 -- - binutils-dev:i386 -- - libx11-dev:i386 -- - libc6-dev:i386 -- - env: CI_KIND=build XARCH=x64 -- - env: CI_KIND=build XARCH=x64 CONFIG_ARG=--enable-flambda OCAMLRUNPARAM=b,v=0 -- - env: CI_KIND=changes -- - env: CI_KIND=manual -- - env: CI_KIND=check-typo -- - env: CI_KIND=tests -- allow_failures: -- - env: CI_KIND=tests -+before_install: -+ - docker pull nojb/riscv-ocaml-ci -+ - echo ':riscv64:M::\x7f\x45\x4c\x46\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xf3\x00:\xff\xff\xff\xff\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\xff\xff:/usr/bin/qemu-riscv64:' | sudo tee /proc/sys/fs/binfmt_misc/register >/dev/null -+ - docker run -v $TRAVIS_BUILD_DIR:/home/root/ocaml nojb/riscv-ocaml-ci /bin/sh -c "cd ocaml && ./configure && make world.opt" - addons: - apt: - packages: - - binutils-dev -- --notifications: -- email: -- - ocaml-ci-notifications@inria.fr -diff --git a/README.adoc b/README.adoc -index 53cd4512e..60fe53f62 100644 ---- a/README.adoc -+++ b/README.adoc -@@ -55,6 +55,7 @@ AMD64:: FreeBSD, OpenBSD, NetBSD - IA32 (Pentium):: NetBSD, OpenBSD, Solaris 9 - PowerPC:: NetBSD - ARM:: NetBSD -+RISC-V:: Linux - - Other operating systems for the processors above have not been tested, but - the compiler may work under other operating systems with little work. -diff --git a/asmcomp/riscv/CSE.ml b/asmcomp/riscv/CSE.ml -new file mode 100644 -index 000000000..302811a99 ---- /dev/null -+++ b/asmcomp/riscv/CSE.ml -@@ -0,0 +1,36 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* Copyright 2106 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* CSE for the RISC-V *) -+ -+open Arch -+open Mach -+open CSEgen -+ -+class cse = object (_self) -+ -+inherit cse_generic as super -+ -+method! class_of_operation op = -+ match op with -+ | Ispecific(Imultaddf _ | Imultsubf _) -> Op_pure -+ | _ -> super#class_of_operation op -+ -+method! is_cheap_operation op = -+ match op with -+ | Iconst_int n -> n <= 0x7FFn && n >= -0x800n -+ | _ -> false -+ -+end -+ -+let fundecl f = -+ (new cse)#fundecl f -diff --git a/asmcomp/riscv/arch.ml b/asmcomp/riscv/arch.ml -new file mode 100644 -index 000000000..22c807c49 ---- /dev/null -+++ b/asmcomp/riscv/arch.ml -@@ -0,0 +1,87 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* Copyright 2016 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* Specific operations for the RISC-V processor *) -+ -+open Format -+ -+(* Machine-specific command-line options *) -+ -+let command_line_options = [] -+ -+(* Specific operations *) -+ -+type specific_operation = -+ | Imultaddf of bool (* multiply, optionally negate, and add *) -+ | Imultsubf of bool (* multiply, optionally negate, and subtract *) -+ -+let spacetime_node_hole_pointer_is_live_before = function -+ | Imultaddf _ | Imultsubf _ -> false -+ -+(* Addressing modes *) -+ -+type addressing_mode = -+ | Iindexed of int (* reg + displ *) -+ -+let is_immediate n = -+ (n <= 2047) && (n >= -2048) -+ -+(* Sizes, endianness *) -+ -+let big_endian = false -+ -+let rv64 = -+ match Config.model with "riscv64" -> true | "riscv32" -> false | _ -> assert false -+ -+let size_addr = if rv64 then 8 else 4 -+let size_int = size_addr -+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) -+ -+let num_args_addressing = function -+ | Iindexed _ -> 1 -+ -+(* Printing operations and addressing modes *) -+ -+let print_addressing printreg addr ppf arg = -+ match addr with -+ | Iindexed n -> -+ let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in -+ fprintf ppf "%a%s" printreg arg.(0) idx -+ -+let print_specific_operation printreg op ppf arg = -+ match op with -+ | Imultaddf false -> -+ fprintf ppf "%a *f %a +f %a" -+ printreg arg.(0) printreg arg.(1) printreg arg.(2) -+ | Imultaddf true -> -+ fprintf ppf "-f (%a *f %a +f %a)" -+ printreg arg.(0) printreg arg.(1) printreg arg.(2) -+ | Imultsubf false -> -+ fprintf ppf "%a *f %a -f %a" -+ printreg arg.(0) printreg arg.(1) printreg arg.(2) -+ | Imultsubf true -> -+ fprintf ppf "-f (%a *f %a -f %a)" -+ printreg arg.(0) printreg arg.(1) printreg arg.(2) -diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp -new file mode 100644 -index 000000000..88ea9f884 ---- /dev/null -+++ b/asmcomp/riscv/emit.mlp -@@ -0,0 +1,655 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* Copyright 2016 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* Emission of RISC-V assembly code *) -+ -+open Misc -+open Cmm -+open Arch -+open Proc -+open Reg -+open Mach -+open Linearize -+open Emitaux -+ -+(* Layout of the stack. The stack is kept 16-aligned. *) -+ -+let stack_offset = ref 0 -+ -+let frame_size () = -+ let size = -+ !stack_offset + (* Trap frame, outgoing parameters *) -+ size_int * num_stack_slots.(0) + (* Local int variables *) -+ size_float * num_stack_slots.(1) + (* Local float variables *) -+ (if !contains_calls then size_addr else 0) in (* The return address *) -+ Misc.align size 16 -+ -+let slot_offset loc cls = -+ match loc with -+ | Local n -> -+ if cls = 0 -+ then !stack_offset + num_stack_slots.(1) * size_float + n * size_int -+ else !stack_offset + n * size_float -+ | Incoming n -> frame_size() + n -+ | Outgoing n -> n -+ -+(* Output a symbol *) -+ -+let emit_symbol s = -+ Emitaux.emit_symbol '.' s -+ -+(* Output a label *) -+ -+let label_prefix = "L" -+ -+let emit_label lbl = -+ emit_string label_prefix; emit_int lbl -+ -+(* Section switching *) -+ -+let data_space = -+ ".section .data" -+ -+let code_space = -+ ".section .text" -+ -+let rodata_space = -+ ".section .rodata" -+ -+let reg_tmp1 = phys_reg 21 (* used by the assembler *) -+let reg_tmp2 = phys_reg 22 -+let reg_t2 = phys_reg 16 -+(* let reg_fp = phys_reg 23 *) -+let reg_trap = phys_reg 24 -+let reg_alloc_ptr = phys_reg 25 -+let reg_alloc_lim = phys_reg 26 -+ -+(* Names of instructions that differ in 32 and 64-bit modes *) -+ -+let lg = if rv64 then "ld" else "lw" -+let stg = if rv64 then "sd" else "sw" -+let datag = if rv64 then ".quad" else ".long" -+ -+(* Output a pseudo-register *) -+ -+let emit_reg = function -+ | {loc = Reg r} -> emit_string (register_name r) -+ | _ -> fatal_error "Emit.emit_reg" -+ -+(* Adjust sp by the given byte amount *) -+ -+let emit_stack_adjustment = function -+ | 0 -> () -+ | n when is_immediate n -> -+ ` addi sp, sp, {emit_int n}\n` -+ | n -> -+ ` li {emit_reg reg_tmp1}, {emit_int n}\n`; -+ ` add sp, sp, {emit_reg reg_tmp1}\n` -+ -+let reload_ra n = -+ let ofs = n - size_addr in -+ if is_immediate ofs then -+ ` {emit_string lg} ra, {emit_int ofs}(sp)\n` -+ else begin -+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; -+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; -+ ` {emit_string lg} ra, 0({emit_reg reg_tmp1})\n` -+ end -+ -+let store_ra n = -+ let ofs = n - size_addr in -+ if is_immediate ofs then -+ ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n` -+ else begin -+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; -+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; -+ ` {emit_string stg} ra, 0({emit_reg reg_tmp1})\n` -+ end -+ -+let emit_store stg src ofs = -+ if is_immediate ofs then -+ ` {emit_string stg} {emit_reg src}, {emit_int ofs}(sp)\n` -+ else begin -+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; -+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; -+ ` {emit_string stg} {emit_reg src}, 0({emit_reg reg_tmp1})\n` -+ end -+ -+let emit_load lg dst ofs = -+ if is_immediate ofs then -+ ` {emit_string lg} {emit_reg dst}, {emit_int ofs}(sp)\n` -+ else begin -+ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; -+ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; -+ ` {emit_string lg} {emit_reg dst}, 0({emit_reg reg_tmp1})\n` -+ end -+ -+(* Record live pointers at call points *) -+ -+let record_frame_label ?label live raise_ dbg = -+ let lbl = -+ match label with -+ | None -> new_label() -+ | Some label -> label -+ in -+ let live_offset = ref [] in -+ Reg.Set.iter -+ (function -+ {typ = Val; loc = Reg r} -> -+ live_offset := (r lsl 1) + 1 :: !live_offset -+ | {typ = Val; loc = Stack s} as reg -> -+ live_offset := slot_offset s (register_class reg) :: !live_offset -+ | {typ = Addr} as r -> -+ Misc.fatal_error ("bad GC root " ^ Reg.name r) -+ | _ -> () -+ ) -+ live; -+ record_frame_descr ~label:lbl ~frame_size:(frame_size()) -+ ~live_offset:!live_offset ~raise_frame:raise_ dbg; -+ lbl -+ -+let record_frame ?label live raise_ dbg = -+ let lbl = record_frame_label ?label live raise_ dbg in -+ `{emit_label lbl}:\n` -+ -+(* 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}:\n`; -+ ` call {emit_symbol "caml_call_gc"}\n`; -+ `{emit_label gc.gc_frame_lbl}:\n`; -+ ` j {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 ?label dbg = -+ if !Clflags.debug || !bound_error_sites = [] then begin -+ let lbl_bound_error = new_label() in -+ let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in -+ bound_error_sites := -+ { bd_lbl = lbl_bound_error; -+ bd_frame_lbl = lbl_frame } :: !bound_error_sites; -+ lbl_bound_error -+ end else -+ let bd = List.hd !bound_error_sites in -+ bd.bd_lbl -+ -+let emit_call_bound_error bd = -+ `{emit_label bd.bd_lbl}:\n`; -+ ` call {emit_symbol "caml_ml_array_bound_error"}\n`; -+ `{emit_label bd.bd_frame_lbl}:\n` -+ -+(* Record floating-point literals *) -+ -+let float_literals = ref ([] : (int64 * int) list) -+ -+(* Names for various instructions *) -+ -+let name_for_intop = function -+ | Iadd -> "add" -+ | Isub -> "sub" -+ | Imul -> "mul" -+ | Imulh -> "mulh" -+ | Idiv -> "div" -+ | Iand -> "and" -+ | Ior -> "or" -+ | Ixor -> "xor" -+ | Ilsl -> "sll" -+ | Ilsr -> "srl" -+ | Iasr -> "sra" -+ | Imod -> "rem" -+ | _ -> fatal_error "Emit.Intop" -+ -+let name_for_intop_imm = function -+ | Iadd -> "addi" -+ | Iand -> "andi" -+ | Ior -> "ori" -+ | Ixor -> "xori" -+ | Ilsl -> "slli" -+ | Ilsr -> "srli" -+ | Iasr -> "srai" -+ | _ -> fatal_error "Emit.Intop_imm" -+ -+let name_for_floatop1 = function -+ | Inegf -> "fneg.d" -+ | Iabsf -> "fabs.d" -+ | _ -> fatal_error "Emit.Iopf1" -+ -+let name_for_floatop2 = function -+ | Iaddf -> "fadd.d" -+ | Isubf -> "fsub.d" -+ | Imulf -> "fmul.d" -+ | Idivf -> "fdiv.d" -+ | _ -> fatal_error "Emit.Iopf2" -+ -+let name_for_specific = function -+ | Imultaddf false -> "fmadd.d" -+ | Imultaddf true -> "fnmadd.d" -+ | Imultsubf false -> "fmsub.d" -+ | Imultsubf true -> "fnmsub.d" -+ -+(* Name of current function *) -+let function_name = ref "" -+ -+(* Entry point for tail recursive calls *) -+let tailrec_entry_point = ref 0 -+ -+(* Output the assembly code for an instruction *) -+ -+let emit_instr i = -+ match i.desc with -+ Lend -> () -+ | Lprologue -> -+ let n = frame_size() in -+ emit_stack_adjustment (-n); -+ if !contains_calls then store_ra n; -+ `{emit_label !tailrec_entry_point}:\n`; -+ | Lop(Imove | Ispill | Ireload) -> -+ let src = i.arg.(0) and dst = i.res.(0) in -+ if src.loc <> dst.loc then begin -+ match (src, dst) with -+ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Reg _} -> -+ ` mv {emit_reg dst}, {emit_reg src}\n` -+ | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} -> -+ ` fmv.d {emit_reg dst}, {emit_reg src}\n` -+ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} -> -+ let ofs = slot_offset s (register_class dst) in -+ emit_store stg src ofs -+ | {loc = Reg _; typ = Float}, {loc = Stack s} -> -+ let ofs = slot_offset s (register_class dst) in -+ emit_store "fsd" src ofs -+ | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} -> -+ let ofs = slot_offset s (register_class src) in -+ emit_load lg dst ofs -+ | {loc = Stack s; typ = Float}, {loc = Reg _} -> -+ let ofs = slot_offset s (register_class src) in -+ emit_load "fld" dst ofs -+ | _ -> -+ fatal_error "Emit: Imove" -+ end -+ | Lop(Iconst_int n) -> -+ ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n` -+ | Lop(Iconst_float f) -> -+ let lbl = new_label() in -+ float_literals := (f, lbl) :: !float_literals; -+ ` fld {emit_reg i.res.(0)}, {emit_label lbl}, {emit_reg reg_tmp1}\n` -+ | Lop(Iconst_symbol s) -> -+ ` la {emit_reg i.res.(0)}, {emit_symbol s}\n` -+ | Lop(Icall_ind {label_after = label}) -> -+ ` jalr {emit_reg i.arg.(0)}\n`; -+ record_frame ~label i.live false i.dbg -+ | Lop(Icall_imm {func; label_after = label}) -> -+ ` call {emit_symbol func}\n`; -+ record_frame ~label i.live false i.dbg -+ | Lop(Itailcall_ind {label_after = _}) -> -+ let n = frame_size() in -+ if !contains_calls then reload_ra n; -+ emit_stack_adjustment n; -+ ` jr {emit_reg i.arg.(0)}\n` -+ | Lop(Itailcall_imm {func; label_after = _}) -> -+ if func = !function_name then begin -+ ` j {emit_label !tailrec_entry_point}\n` -+ end else begin -+ let n = frame_size() in -+ if !contains_calls then reload_ra n; -+ emit_stack_adjustment n; -+ ` tail {emit_symbol func}\n` -+ end -+ | Lop(Iextcall{func; alloc = true; label_after = label}) -> -+ ` la {emit_reg reg_t2}, {emit_symbol func}\n`; -+ ` call {emit_symbol "caml_c_call"}\n`; -+ record_frame ~label i.live false i.dbg -+ | Lop(Iextcall{func; alloc = false; label_after = _}) -> -+ ` call {emit_symbol func}\n` -+ | Lop(Istackoffset n) -> -+ assert (n mod 16 = 0); -+ emit_stack_adjustment (-n); -+ stack_offset := !stack_offset + n -+ | Lop(Iload(Single, Iindexed ofs)) -> -+ ` flw {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`; -+ ` fcvt.d.s {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` -+ | Lop(Iload(chunk, Iindexed ofs)) -> -+ let instr = -+ match chunk with -+ | Byte_unsigned -> "lbu" -+ | Byte_signed -> "lb" -+ | Sixteen_unsigned -> "lhu" -+ | Sixteen_signed -> "lh" -+ | Thirtytwo_unsigned -> if rv64 then "lwu" else "lw" -+ | Thirtytwo_signed -> "lw" -+ | Word_int | Word_val -> lg -+ | Single -> assert false -+ | Double | Double_u -> "fld" -+ in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n` -+ | Lop(Istore(Single, Iindexed ofs, _)) -> -+ ` fmv.x.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}\n`; -+ ` fcvt.s.d {emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}\n`; -+ ` fsw {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`; -+ ` fmv.d.x {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}\n` -+ | Lop(Istore(chunk, Iindexed ofs, _)) -> -+ let instr = -+ match chunk with -+ | Byte_unsigned | Byte_signed -> "sb" -+ | Sixteen_unsigned | Sixteen_signed -> "sh" -+ | Thirtytwo_unsigned | Thirtytwo_signed -> "sw" -+ | Word_int | Word_val -> stg -+ | Single -> assert false -+ | Double | Double_u -> "fsd" -+ in -+ ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n` -+ | Lop(Ialloc {bytes = n; label_after_call_gc = label; _}) -> -+ let lbl_frame_lbl = record_frame_label ?label i.live false i.dbg in -+ let lbl_redo = new_label () in -+ let lbl_call_gc = new_label () in -+ `{emit_label lbl_redo}:\n`; -+ ` addi {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, -{emit_int n}\n`; -+ ` addi {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`; -+ ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_lim}, {emit_label lbl_call_gc}\n`; -+ call_gc_sites := -+ { gc_lbl = lbl_call_gc; -+ gc_return_lbl = lbl_redo; -+ gc_frame_lbl = lbl_frame_lbl } :: !call_gc_sites -+ | Lop(Iintop(Icomp cmp)) -> -+ begin match cmp with -+ | Isigned Clt -> -+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` -+ | Isigned Cge -> -+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; -+ | Isigned Cgt -> -+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` -+ | Isigned Cle -> -+ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`; -+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; -+ | Isigned Ceq | Iunsigned Ceq -> -+ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -+ ` seqz {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` -+ | Isigned Cne | Iunsigned Cne -> -+ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -+ ` snez {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` -+ | Iunsigned Clt -> -+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` -+ | Iunsigned Cge -> -+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; -+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; -+ | Iunsigned Cgt -> -+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` -+ | Iunsigned Cle -> -+ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`; -+ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; -+ end -+ | Lop(Iintop (Icheckbound {label_after_error = label; _})) -> -+ let lbl = bound_error_label ?label i.dbg in -+ ` bleu {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n` -+ | Lop(Iintop op) -> -+ let instr = name_for_intop op in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` -+ | Lop(Iintop_imm(Isub, n)) -> -+ ` addi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n` -+ | Lop(Iintop_imm(Icomp _, _)) -> -+ fatal_error "Emit.emit_instr (Iintop_imm (Icomp _, _))" -+ | Lop(Iintop_imm(Icheckbound {label_after_error = label; _}, n)) -> -+ let lbl = bound_error_label ?label i.dbg in -+ ` li {emit_reg reg_tmp1}, {emit_int n}\n`; -+ ` bleu {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, {emit_label lbl}\n` -+ | Lop(Iintop_imm(op, n)) -> -+ let instr = name_for_intop_imm op in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n` -+ | Lop(Inegf | Iabsf as op) -> -+ let instr = name_for_floatop1 op in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` -+ | Lop(Iaddf | Isubf | Imulf | Idivf as op) -> -+ let instr = name_for_floatop2 op in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` -+ | Lop(Ifloatofint) -> -+ let name = if rv64 then "fcvt.d.l" else "fcvt.d.w" in -+ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` -+ | Lop(Iintoffloat) -> -+ let name = if rv64 then "fcvt.l.d" else "fcvt.w.d" in -+ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` -+ | Lop(Ispecific sop) -> -+ let instr = name_for_specific sop in -+ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n` -+ | Lop (Iname_for_debugger _) -> -+ () -+ | Lreloadretaddr -> -+ let n = frame_size () in -+ reload_ra n -+ | Lreturn -> -+ let n = frame_size() in -+ emit_stack_adjustment n; -+ ` ret\n` -+ | Llabel lbl -> -+ `{emit_label lbl}:\n` -+ | Lbranch lbl -> -+ ` j {emit_label lbl}\n` -+ | Lcondbranch(tst, lbl) -> -+ begin match tst with -+ | Itruetest -> -+ ` bnez {emit_reg i.arg.(0)}, {emit_label lbl}\n` -+ | Ifalsetest -> -+ ` beqz {emit_reg i.arg.(0)}, {emit_label lbl}\n` -+ | Iinttest cmp -> -+ let name = match cmp with -+ | Iunsigned Ceq | Isigned Ceq -> "beq" -+ | Iunsigned Cne | Isigned Cne -> "bne" -+ | Iunsigned Cle -> "bleu" | Isigned Cle -> "ble" -+ | Iunsigned Cge -> "bgeu" | Isigned Cge -> "bge" -+ | Iunsigned Clt -> "bltu" | Isigned Clt -> "blt" -+ | Iunsigned Cgt -> "bgtu" | Isigned Cgt -> "bgt" -+ in -+ ` {emit_string name} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n` -+ | Iinttest_imm _ -> -+ fatal_error "Emit.emit_instr (Iinttest_imm _)" -+ | Ifloattest cmp -> -+ let branch = -+ match cmp with -+ | CFneq | CFnlt | CFngt | CFnle | CFnge -> "beqz" -+ | CFeq | CFlt | CFgt | CFle | CFge -> "bnez" -+ in -+ begin match cmp with -+ | CFeq | CFneq -> ` feq.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` -+ | CFlt | CFnlt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` -+ | CFgt | CFngt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` -+ | CFle | CFnle -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` -+ | CFge | CFnge -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` -+ end; -+ ` {emit_string branch} {emit_reg reg_tmp1}, {emit_label lbl}\n` -+ | Ioddtest -> -+ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`; -+ ` bnez {emit_reg reg_tmp1}, {emit_label lbl}\n` -+ | Ieventest -> -+ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`; -+ ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n` -+ end -+ | Lcondbranch3(lbl0, lbl1, lbl2) -> -+ ` addi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, -1\n`; -+ begin match lbl0 with -+ | None -> () -+ | Some lbl -> ` bltz {emit_reg reg_tmp1}, {emit_label lbl}\n` -+ end; -+ begin match lbl1 with -+ | None -> () -+ | Some lbl -> ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n` -+ end; -+ begin match lbl2 with -+ | None -> () -+ | Some lbl -> ` bgtz {emit_reg reg_tmp1}, {emit_label lbl}\n` -+ end -+ | Lswitch jumptbl -> (* FIXME FIXME ? *) -+ let lbl = new_label() in -+ ` la {emit_reg reg_tmp1}, {emit_label lbl}\n`; -+ ` slli {emit_reg reg_tmp2}, {emit_reg i.arg.(0)}, 2\n`; -+ ` add {emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_reg reg_tmp2}\n`; -+ ` jr {emit_reg reg_tmp1}\n`; -+ `{emit_label lbl}:\n`; -+ for i = 0 to Array.length jumptbl - 1 do -+ ` j {emit_label jumptbl.(i)}\n` -+ done -+ | Lsetuptrap lbl -> -+ ` addi sp, sp, -16\n`; -+ ` jal {emit_label lbl}\n` -+ | Lpushtrap -> -+ stack_offset := !stack_offset + 16; -+ ` {emit_string stg} ra, {emit_int size_addr}(sp)\n`; -+ ` {emit_string stg} {emit_reg reg_trap}, 0(sp)\n`; -+ ` mv {emit_reg reg_trap}, sp\n` -+ | Lpoptrap -> -+ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`; -+ ` addi sp, sp, 16\n`; -+ stack_offset := !stack_offset - 16 -+ | Lraise k -> -+ begin match !Clflags.debug, k with -+ | true, Cmm.Raise_withtrace -> -+ ` call {emit_symbol "caml_raise_exn"}\n`; -+ record_frame Reg.Set.empty true i.dbg -+ | false, _ -+ | true, Cmm.Raise_notrace -> -+ ` mv sp, {emit_reg reg_trap}\n`; -+ ` {emit_string lg} {emit_reg reg_tmp1}, {emit_int size_addr}(sp)\n`; -+ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`; -+ ` addi sp, sp, 16\n`; -+ ` jalr {emit_reg reg_tmp1}\n` -+ end -+ -+(* Emit a sequence of instructions *) -+ -+let rec emit_all = function -+ | {desc = Lend} -> () | i -> emit_instr i; emit_all i.next -+ -+(* Emission of a function declaration *) -+ -+let fundecl fundecl = -+ function_name := fundecl.fun_name; -+ tailrec_entry_point := new_label(); -+ stack_offset := 0; -+ call_gc_sites := []; -+ bound_error_sites := []; -+ float_literals := []; -+ ` .globl {emit_symbol fundecl.fun_name}\n`; -+ ` .type {emit_symbol fundecl.fun_name}, @function\n`; -+ ` {emit_string code_space}\n`; -+ ` .align 2\n`; -+ `{emit_symbol fundecl.fun_name}:\n`; -+ emit_all fundecl.fun_body; -+ List.iter emit_call_gc !call_gc_sites; -+ List.iter emit_call_bound_error !bound_error_sites; -+ ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`; -+ (* Emit the float literals *) -+ if !float_literals <> [] then begin -+ ` {emit_string rodata_space}\n`; -+ ` .align 3\n`; -+ List.iter -+ (fun (f, lbl) -> -+ `{emit_label lbl}:\n`; -+ if rv64 -+ then emit_float64_directive ".quad" f -+ else emit_float64_split_directive ".long" f) -+ !float_literals; -+ end -+ -+(* Emission of data *) -+ -+let declare_global_data s = -+ ` .globl {emit_symbol s}\n`; -+ ` .type {emit_symbol s}, @object\n` -+ -+let emit_item = function -+ | Cglobal_symbol s -> -+ declare_global_data s -+ | Cdefine_symbol s -> -+ `{emit_symbol s}:\n`; -+ | Cint8 n -> -+ ` .byte {emit_int n}\n` -+ | Cint16 n -> -+ ` .short {emit_int n}\n` -+ | Cint32 n -> -+ ` .long {emit_nativeint n}\n` -+ | Cint n -> -+ ` {emit_string datag} {emit_nativeint n}\n` -+ | Csingle f -> -+ emit_float32_directive ".long" (Int32.bits_of_float f) -+ | Cdouble f -> -+ if rv64 -+ then emit_float64_directive ".quad" (Int64.bits_of_float f) -+ else emit_float64_split_directive ".long" (Int64.bits_of_float f) -+ | Csymbol_address s -> -+ ` {emit_string datag} {emit_symbol s}\n` -+ | Cstring s -> -+ emit_bytes_directive " .byte " s -+ | Cskip n -> -+ if n > 0 then ` .space {emit_int n}\n` -+ | Calign n -> -+ ` .align {emit_int (Misc.log2 n)}\n` -+ -+let data l = -+ ` {emit_string data_space}\n`; -+ List.iter emit_item l -+ -+(* Beginning / end of an assembly file *) -+ -+let begin_assembly() = -+ ` .file \"\"\n`; (* PR#7073 *) -+ (* Emit the beginning of the segments *) -+ let lbl_begin = Compilenv.make_symbol (Some "data_begin") in -+ ` {emit_string data_space}\n`; -+ declare_global_data lbl_begin; -+ `{emit_symbol lbl_begin}:\n`; -+ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in -+ ` {emit_string code_space}\n`; -+ declare_global_data lbl_begin; -+ `{emit_symbol lbl_begin}:\n` -+ -+let end_assembly() = -+ ` {emit_string code_space}\n`; -+ let lbl_end = Compilenv.make_symbol (Some "code_end") in -+ declare_global_data lbl_end; -+ `{emit_symbol lbl_end}:\n`; -+ ` .long 0\n`; -+ ` {emit_string data_space}\n`; -+ let lbl_end = Compilenv.make_symbol (Some "data_end") in -+ declare_global_data lbl_end; -+ `{emit_symbol lbl_end}:\n`; -+ ` {emit_string datag} 0\n`; -+ (* Emit the frame descriptors *) -+ ` {emit_string rodata_space}\n`; -+ let lbl = Compilenv.make_symbol (Some "frametable") in -+ declare_global_data lbl; -+ `{emit_symbol lbl}:\n`; -+ emit_frames -+ { efa_code_label = (fun l -> ` {emit_string datag} {emit_label l}\n`); -+ efa_data_label = (fun l -> ` {emit_string datag} {emit_label l}\n`); -+ efa_16 = (fun n -> ` .short {emit_int n}\n`); -+ efa_32 = (fun n -> ` .long {emit_int32 n}\n`); -+ efa_word = (fun n -> ` {emit_string datag} {emit_int n}\n`); -+ efa_align = (fun n -> ` .align {emit_int (Misc.log2 n)}\n`); -+ efa_label_rel = (fun lbl ofs -> -+ ` .long ({emit_label lbl} - .) + {emit_int32 ofs}\n`); -+ efa_def_label = (fun l -> `{emit_label l}:\n`); -+ efa_string = (fun s -> emit_bytes_directive " .byte " (s ^ "\000")) -+ } -diff --git a/asmcomp/riscv/proc.ml b/asmcomp/riscv/proc.ml -new file mode 100644 -index 000000000..c0db0fd7b ---- /dev/null -+++ b/asmcomp/riscv/proc.ml -@@ -0,0 +1,330 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* Copyright 2016 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* Description of the RISC-V *) -+ -+open Misc -+open Cmm -+open Reg -+open Arch -+open Mach -+ -+(* Instruction selection *) -+ -+let word_addressed = false -+ -+(* Registers available for register allocation *) -+ -+(* Integer register map: -+ zero always zero -+ ra return address -+ sp, gp, tp stack pointer, global pointer, thread pointer (preserved by C) -+ a0 - a7 0 - 7 arguments/results -+ s2 - s9 8 - 15 arguments/results (preserved by C) -+ t2 - t6 16 - 20 temporary -+ t0 21 temporary (used by assembler) -+ t1 22 temporary (reserved for code gen) -+ s0 23 frame pointer (preserved by C) -+ s1 24 trap pointer (preserved by C) -+ s10 25 allocation pointer (preserved by C) -+ s11 26 allocation limit (preserved by C) -+ Floating-point register map: -+ ft0 - ft7 100 - 107 temporary -+ fs0 - fs1 108 - 109 general purpose (preserved by C) -+ fa0 - fa7 110 - 117 arguments/results -+ fs2 - fs9 118 - 125 arguments/results (preserved by C) -+ fs10 - fs11 126 - 127 general purpose (preserved by C) -+ ft8 - ft11 128 - 131 temporary -+*) -+ -+let int_reg_name = -+ [| "a0"; "a1"; "a2"; "a3"; "a4"; "a5"; "a6"; "a7"; -+ "s2"; "s3"; "s4"; "s5"; "s6"; "s7"; "s8"; "s9"; -+ "t2"; "t3"; "t4"; "t5"; "t6"; -+ "t0"; "t1"; -+ "s0"; "s1"; "s10"; "s11" |] -+ -+let float_reg_name = -+ [| "ft0"; "ft1"; "ft2"; "ft3"; "ft4"; "ft5"; "ft6"; "ft7"; -+ "fs0"; "fs1"; -+ "fa0"; "fa1"; "fa2"; "fa3"; "fa4"; "fa5"; "fa6"; "fa7"; -+ "fs2"; "fs3"; "fs4"; "fs5"; "fs6"; "fs7"; "fs8"; "fs9"; "fs10"; "fs11"; -+ "ft8"; "ft9"; "ft10"; "ft11" |] -+ -+let num_register_classes = 2 -+ -+let register_class r = -+ match r.typ with -+ | Val | Int | Addr -> 0 -+ | Float -> 1 -+ -+let num_available_registers = [| 21; 32 |] -+ -+let first_available_register = [| 0; 100 |] -+ -+let register_name r = -+ if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) -+ -+let rotate_registers = true -+ -+(* Representation of hard registers by pseudo-registers *) -+ -+let hard_int_reg = -+ let v = Array.make 27 Reg.dummy in -+ for i = 0 to 26 do -+ v.(i) <- Reg.at_location Int (Reg i) -+ done; -+ v -+ -+let hard_float_reg = -+ let v = Array.make 32 Reg.dummy in -+ for i = 0 to 31 do -+ v.(i) <- Reg.at_location Float (Reg(100 + i)) -+ done; -+ v -+ -+let all_phys_regs = -+ Array.append hard_int_reg hard_float_reg -+ -+let phys_reg n = -+ if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) -+ -+let stack_slot slot ty = -+ Reg.at_location ty (Stack slot) -+ -+(* Calling conventions *) -+ -+let calling_conventions -+ first_int last_int first_float last_float make_stack arg = -+ let loc = Array.make (Array.length arg) Reg.dummy in -+ let int = ref first_int in -+ let float = ref first_float in -+ let ofs = ref 0 in -+ for i = 0 to Array.length arg - 1 do -+ match arg.(i).typ with -+ | Val | Int | Addr as ty -> -+ if !int <= last_int then begin -+ loc.(i) <- phys_reg !int; -+ incr int -+ end else begin -+ loc.(i) <- stack_slot (make_stack !ofs) ty; -+ ofs := !ofs + size_int -+ end -+ | Float -> -+ if !float <= last_float then begin -+ loc.(i) <- phys_reg !float; -+ incr float -+ end else begin -+ loc.(i) <- stack_slot (make_stack !ofs) Float; -+ ofs := !ofs + size_float -+ end -+ done; -+ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *) -+ -+let incoming ofs = Incoming ofs -+let outgoing ofs = Outgoing ofs -+let not_supported _ = fatal_error "Proc.loc_results: cannot call" -+ -+let max_arguments_for_tailcalls = 16 -+ -+let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *) -+ -+(* OCaml calling convention: -+ first integer args in a0 .. a7, s2 .. s9 -+ first float args in fa0 .. fa7, fs2 .. fs9 -+ remaining args on stack. -+ Return values in a0 .. a7, s2 .. s9 or fa0 .. fa7, fs2 .. fs9. *) -+ -+let single_regs arg = Array.map (fun arg -> [| arg |]) arg -+let ensure_single_regs res = -+ Array.map (function -+ | [| res |] -> res -+ | _ -> failwith "proc.ensure_single_regs" -+ ) res -+ -+let loc_arguments arg = -+ calling_conventions 0 15 110 125 outgoing arg -+ -+let loc_parameters arg = -+ let (loc, _ofs) = -+ calling_conventions 0 15 110 125 incoming arg -+ in -+ loc -+ -+let loc_results res = -+ let (loc, _ofs) = -+ calling_conventions 0 15 110 125 not_supported res -+ in -+ loc -+ -+(* C calling convention: -+ first integer args in a0 .. a7 -+ first float args in fa0 .. fa7 -+ remaining args on stack. -+ Return values in a0 .. a1 or fa0 .. fa1. *) -+ -+let external_calling_conventions -+ first_int last_int first_float last_float make_stack arg = -+ let loc = Array.make (Array.length arg) [| Reg.dummy |] in -+ let int = ref first_int in -+ let float = ref first_float in -+ let ofs = ref 0 in -+ for i = 0 to Array.length arg - 1 do -+ match arg.(i) with -+ | [| arg |] -> -+ begin match arg.typ with -+ | Val | Int | Addr as ty -> -+ if !int <= last_int then begin -+ loc.(i) <- [| phys_reg !int |]; -+ incr int; -+ incr float; -+ end else begin -+ loc.(i) <- [| stack_slot (make_stack !ofs) ty |]; -+ ofs := !ofs + size_int -+ end -+ | Float -> -+ if !float <= last_float then begin -+ loc.(i) <- [| phys_reg !float |]; -+ incr float; -+ incr int; -+ end else begin -+ loc.(i) <- [| stack_slot (make_stack !ofs) Float |]; -+ ofs := !ofs + size_float -+ end -+ end -+ | [| arg1; arg2 |] -> -+ (* Passing of 64-bit quantities to external functions on 32-bit -+ platform. *) -+ assert (size_int = 4); -+ begin match arg1.typ, arg2.typ with -+ | Int, Int -> -+ int := Misc.align !int 2; -+ if !int <= last_int - 1 then begin -+ let reg_lower = phys_reg !int in -+ let reg_upper = phys_reg (!int + 1) in -+ loc.(i) <- [| reg_lower; reg_upper |]; -+ int := !int + 2 -+ end else begin -+ let size_int64 = 8 in -+ ofs := Misc.align !ofs size_int64; -+ let ofs_lower = !ofs in -+ let ofs_upper = !ofs + size_int in -+ let stack_lower = stack_slot (make_stack ofs_lower) Int in -+ let stack_upper = stack_slot (make_stack ofs_upper) Int in -+ loc.(i) <- [| stack_lower; stack_upper |]; -+ ofs := !ofs + size_int64 -+ end -+ | _ -> -+ let f = function Int -> "I" | Addr -> "A" | Val -> "V" | Float -> "F" in -+ fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \ -+ type(s) for multi-register argument: %s, %s" -+ (f arg1.typ) (f arg2.typ)) -+ end -+ | _ -> -+ fatal_error "Proc.calling_conventions: bad number of register for \ -+ multi-register argument" -+ done; -+ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *) -+ -+let loc_external_arguments arg = -+ external_calling_conventions 0 7 110 117 outgoing arg -+ -+let loc_external_results res = -+ let (loc, _ofs) = -+ external_calling_conventions 0 1 110 111 not_supported (single_regs res) -+ in -+ ensure_single_regs loc -+ -+(* Exceptions are in GPR 3 *) -+ -+let loc_exn_bucket = phys_reg 0 -+ -+(* Volatile registers: none *) -+ -+let regs_are_volatile _ = false -+ -+(* Registers destroyed by operations *) -+ -+let destroyed_at_c_call = -+ Array.of_list(List.map phys_reg -+ [0; 1; 2; 3; 4; 5; 6; 7; 16; 17; 18; 19; 20; (* 21; 22; *) -+ 100; 101; 102; 103; 104; 105; 106; 107; 110; 111; 112; 113; 114; 115; 116; -+ 117; 128; 129; 130; 131]) -+ -+let destroyed_at_oper = function -+ | Iop(Icall_ind _ | Icall_imm _ | Iextcall{alloc = true; _}) -> all_phys_regs -+ | Iop(Iextcall{alloc = false; _}) -> destroyed_at_c_call -+ | _ -> [||] -+ -+let destroyed_at_raise = all_phys_regs -+ -+let destroyed_at_reloadretaddr = [| |] (* CHECK *) -+ -+(* Maximal register pressure *) -+ -+let safe_register_pressure = function -+ | Iextcall _ -> 15 -+ | _ -> 21 -+ -+let max_register_pressure = function -+ | Iextcall _ -> [| 15; 18 |] -+ | _ -> [| 21; 30 |] -+ -+(* Pure operations (without any side effect besides updating their result -+ registers). *) -+ -+let op_is_pure = function -+ | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _ -+ | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _ -+ | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false -+ | Ispecific(Imultaddf _ | Imultsubf _) -> true -+ | _ -> true -+ -+(* Layout of the stack *) -+ -+let num_stack_slots = [| 0; 0 |] -+let contains_calls = ref false -+ -+(* See -+ https://github.com/riscv/riscv-elf-psabi-doc/blob/master/riscv-elf.md *) -+ -+let int_dwarf_reg_numbers = -+ [| 10; 11; 12; 13; 14; 15; 16; 17; -+ 18; 19; 20; 21; 22; 23; 24; 25; -+ 7; 29; 29; 30; 31; -+ 5; 6; 8; 9; 26; 27; -+ |] -+ -+let float_dwarf_reg_numbers = -+ [| 32; 33; 34; 35; 36; 37; 38; 39; -+ 40; 41; -+ 42; 43; 44; 45; 46; 47; 48; 49; -+ 50; 51; 52; 53; 54; 55; 56; 57; -+ 58; 59; -+ 60; 61; 62; 63; -+ |] -+ -+let dwarf_register_numbers ~reg_class = -+ match reg_class with -+ | 0 -> int_dwarf_reg_numbers -+ | 1 -> float_dwarf_reg_numbers -+ | _ -> Misc.fatal_errorf "Bad register class %d" reg_class -+ -+let stack_ptr_dwarf_register_number = 2 -+ -+(* Calling the assembler *) -+ -+let assemble_file infile outfile = -+ Ccomp.command -+ (Config.asm ^ " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile) -+ -+let init () = () -diff --git a/asmcomp/riscv/reload.ml b/asmcomp/riscv/reload.ml -new file mode 100644 -index 000000000..85b970342 ---- /dev/null -+++ b/asmcomp/riscv/reload.ml -@@ -0,0 +1,16 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* Copyright 2016 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* Reloading for the RISC-V *) -+ -+let fundecl f = -+ (new Reloadgen.reload_generic)#fundecl f -diff --git a/asmcomp/riscv/scheduling.ml b/asmcomp/riscv/scheduling.ml -new file mode 100644 -index 000000000..e436be1cc ---- /dev/null -+++ b/asmcomp/riscv/scheduling.ml -@@ -0,0 +1,19 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* Copyright 2016 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* Instruction scheduling for the RISC-V *) -+ -+let _ = let module M = Schedgen in () (* to create a dependency *) -+ -+(* Scheduling is turned off. *) -+ -+let fundecl f = f -diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml -new file mode 100644 -index 000000000..85bac1161 ---- /dev/null -+++ b/asmcomp/riscv/selection.ml -@@ -0,0 +1,71 @@ -+(***********************************************************************) -+(* *) -+(* OCaml *) -+(* *) -+(* Nicolas Ojeda Bar *) -+(* *) -+(* Copyright 2016 Institut National de Recherche en Informatique et *) -+(* en Automatique. All rights reserved. This file is distributed *) -+(* under the terms of the Q Public License version 1.0. *) -+(* *) -+(***********************************************************************) -+ -+(* Instruction selection for the RISC-V processor *) -+ -+open Cmm -+open Arch -+open Mach -+ -+(* Instruction selection *) -+ -+class selector = object (self) -+ -+inherit Selectgen.selector_generic as super -+ -+method is_immediate n = is_immediate n -+ -+method select_addressing _ = function -+ | Cop(Cadda, [arg; Cconst_int n], _) when self#is_immediate n -> -+ (Iindexed n, arg) -+ | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n], _)], dbg) when self#is_immediate n -> -+ (Iindexed n, Cop(Caddi, [arg1; arg2], dbg)) -+ | arg -> -+ (Iindexed 0, arg) -+ -+method! select_operation op args dbg = -+ match (op, args) with -+ (* RISC-V does not support immediate operands for multiply high *) -+ | (Cmulhi, _) -> (Iintop Imulh, args) -+ (* Recognize (neg-)mult-add and (neg-)mult-sub instructions *) -+ | (Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3]) -+ | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2], _)]) -> -+ (Ispecific (Imultaddf false), [arg1; arg2; arg3]) -+ | (Csubf, [Cop(Cmulf, [arg1; arg2], _); arg3]) -> -+ (Ispecific (Imultsubf false), [arg1; arg2; arg3]) -+ | (Cnegf, [Cop(Csubf, [Cop(Cmulf, [arg1; arg2], _); arg3], _)]) -> -+ (Ispecific (Imultsubf true), [arg1; arg2; arg3]) -+ | (Cnegf, [Cop(Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3], _)]) -> -+ (Ispecific (Imultaddf true), [arg1; arg2; arg3]) -+ (* RISC-V does not support immediate operands for comparison operators *) -+ | (Ccmpi comp, args) -> (Iintop(Icomp (Isigned comp)), args) -+ | (Ccmpa comp, args) -> (Iintop(Icomp (Iunsigned comp)), args) -+ | (Cmuli, _) -> (Iintop Imul, args) -+ | _ -> -+ super#select_operation op args dbg -+ -+(* Instruction selection for conditionals *) -+ -+method! select_condition = function -+ Cop(Ccmpi cmp, args, _) -> -+ (Iinttest(Isigned cmp), Ctuple args) -+ | Cop(Ccmpa cmp, args, _) -> -+ (Iinttest(Iunsigned cmp), Ctuple args) -+ | Cop(Ccmpf cmp, args, _) -> -+ (Ifloattest cmp, Ctuple args) -+ | Cop(Cand, [arg; Cconst_int 1], _) -> -+ (Ioddtest, arg) -+ | arg -> -+ (Itruetest, arg) -+end -+ -+let fundecl f = (new selector)#emit_fundecl f -diff --git a/config/gnu/config.guess b/config/gnu/config.guess -index b79252d6b..a81aa505b 100755 ---- a/config/gnu/config.guess -+++ b/config/gnu/config.guess -@@ -1,8 +1,8 @@ - #! /bin/sh - # Attempt to guess a canonical system name. --# Copyright 1992-2013 Free Software Foundation, Inc. -+# Copyright 1992-2019 Free Software Foundation, Inc. - --timestamp='2013-06-10' -+timestamp='2019-01-15' - - # This file is free software; you can redistribute it and/or modify it - # under the terms of the GNU General Public License as published by -@@ -15,7 +15,7 @@ timestamp='2013-06-10' - # General Public License for more details. - # - # You should have received a copy of the GNU General Public License --# along with this program; if not, see . -+# along with this program; if not, see . - # - # As a special exception to the GNU General Public License, if you - # distribute this file as part of a program that contains a -@@ -24,12 +24,12 @@ timestamp='2013-06-10' - # program. This Exception is an additional permission under section 7 - # of the GNU General Public License, version 3 ("GPLv3"). - # --# Originally written by Per Bothner. -+# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. - # - # You can get the latest version of this script from: --# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD -+# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess - # --# Please send patches with a ChangeLog entry to config-patches@gnu.org. -+# Please send patches to . - - - me=`echo "$0" | sed -e 's,.*/,,'` -@@ -39,7 +39,7 @@ Usage: $0 [OPTION] - - Output the configuration name of the system \`$me' is run on. - --Operation modes: -+Options: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit -@@ -50,7 +50,7 @@ version="\ - GNU config.guess ($timestamp) - - Originally written by Per Bothner. --Copyright 1992-2013 Free Software Foundation, Inc. -+Copyright 1992-2019 Free Software Foundation, Inc. - - This is free software; see the source for copying conditions. There is NO - warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -@@ -84,8 +84,6 @@ if test $# != 0; then - exit 1 - fi - --trap 'exit 1' 1 2 15 -- - # CC_FOR_BUILD -- compiler used by this script. Note that the use of a - # compiler to aid in system detection is discouraged as it requires - # temporary files to be created and, as you can see below, it is a -@@ -96,34 +94,38 @@ trap 'exit 1' 1 2 15 - - # Portable tmp directory creation inspired by the Autoconf team. - --set_cc_for_build=' --trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; --trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; --: ${TMPDIR=/tmp} ; -- { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || -- { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || -- { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || -- { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; --dummy=$tmp/dummy ; --tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; --case $CC_FOR_BUILD,$HOST_CC,$CC in -- ,,) echo "int x;" > $dummy.c ; -- for c in cc gcc c89 c99 ; do -- if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then -- CC_FOR_BUILD="$c"; break ; -- fi ; -- done ; -- if test x"$CC_FOR_BUILD" = x ; then -- CC_FOR_BUILD=no_compiler_found ; -- fi -- ;; -- ,,*) CC_FOR_BUILD=$CC ;; -- ,*,*) CC_FOR_BUILD=$HOST_CC ;; --esac ; set_cc_for_build= ;' -+tmp= -+# shellcheck disable=SC2172 -+trap 'test -z "$tmp" || rm -fr "$tmp"' 0 1 2 13 15 -+ -+set_cc_for_build() { -+ : "${TMPDIR=/tmp}" -+ # shellcheck disable=SC2039 -+ { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || -+ { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir "$tmp" 2>/dev/null) ; } || -+ { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir "$tmp" 2>/dev/null) && echo "Warning: creating insecure temp directory" >&2 ; } || -+ { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } -+ dummy=$tmp/dummy -+ case ${CC_FOR_BUILD-},${HOST_CC-},${CC-} in -+ ,,) echo "int x;" > "$dummy.c" -+ for driver in cc gcc c89 c99 ; do -+ if ($driver -c -o "$dummy.o" "$dummy.c") >/dev/null 2>&1 ; then -+ CC_FOR_BUILD="$driver" -+ break -+ fi -+ done -+ if test x"$CC_FOR_BUILD" = x ; then -+ CC_FOR_BUILD=no_compiler_found -+ fi -+ ;; -+ ,,*) CC_FOR_BUILD=$CC ;; -+ ,*,*) CC_FOR_BUILD=$HOST_CC ;; -+ esac -+} - - # This is needed to find uname on a Pyramid OSx when run in the BSD universe. - # (ghazi@noc.rutgers.edu 1994-08-24) --if (test -f /.attbin/uname) >/dev/null 2>&1 ; then -+if test -f /.attbin/uname ; then - PATH=$PATH:/.attbin ; export PATH - fi - -@@ -132,14 +134,14 @@ UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown - UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown - UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown - --case "${UNAME_SYSTEM}" in -+case "$UNAME_SYSTEM" in - Linux|GNU|GNU/*) - # If the system lacks a compiler, then just pick glibc. - # We could probably try harder. - LIBC=gnu - -- eval $set_cc_for_build -- cat <<-EOF > $dummy.c -+ set_cc_for_build -+ cat <<-EOF > "$dummy.c" - #include - #if defined(__UCLIBC__) - LIBC=uclibc -@@ -149,13 +151,20 @@ Linux|GNU|GNU/*) - LIBC=gnu - #endif - EOF -- eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC'` -+ eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^LIBC' | sed 's, ,,g'`" -+ -+ # If ldd exists, use it to detect musl libc. -+ if command -v ldd >/dev/null && \ -+ ldd --version 2>&1 | grep -q ^musl -+ then -+ LIBC=musl -+ fi - ;; - esac - - # Note: order is significant - the case branches are not exclusive. - --case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in -+case "$UNAME_MACHINE:$UNAME_SYSTEM:$UNAME_RELEASE:$UNAME_VERSION" in - *:NetBSD:*:*) - # NetBSD (nbsd) targets should (where applicable) match one or - # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, -@@ -168,21 +177,31 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - # Note: NetBSD doesn't particularly care about the vendor - # portion of the name. We always set it to "unknown". - sysctl="sysctl -n hw.machine_arch" -- UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ -- /usr/sbin/$sysctl 2>/dev/null || echo unknown)` -- case "${UNAME_MACHINE_ARCH}" in -+ UNAME_MACHINE_ARCH=`(uname -p 2>/dev/null || \ -+ "/sbin/$sysctl" 2>/dev/null || \ -+ "/usr/sbin/$sysctl" 2>/dev/null || \ -+ echo unknown)` -+ case "$UNAME_MACHINE_ARCH" in - armeb) machine=armeb-unknown ;; - arm*) machine=arm-unknown ;; - sh3el) machine=shl-unknown ;; - sh3eb) machine=sh-unknown ;; - sh5el) machine=sh5le-unknown ;; -- *) machine=${UNAME_MACHINE_ARCH}-unknown ;; -+ earmv*) -+ arch=`echo "$UNAME_MACHINE_ARCH" | sed -e 's,^e\(armv[0-9]\).*$,\1,'` -+ endian=`echo "$UNAME_MACHINE_ARCH" | sed -ne 's,^.*\(eb\)$,\1,p'` -+ machine="${arch}${endian}"-unknown -+ ;; -+ *) machine="$UNAME_MACHINE_ARCH"-unknown ;; - esac - # The Operating System including object format, if it has switched -- # to ELF recently, or will in the future. -- case "${UNAME_MACHINE_ARCH}" in -+ # to ELF recently (or will in the future) and ABI. -+ case "$UNAME_MACHINE_ARCH" in -+ earm*) -+ os=netbsdelf -+ ;; - arm*|i386|m68k|ns32k|sh3*|sparc|vax) -- eval $set_cc_for_build -+ set_cc_for_build - if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ELF__ - then -@@ -197,44 +216,67 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - os=netbsd - ;; - esac -+ # Determine ABI tags. -+ case "$UNAME_MACHINE_ARCH" in -+ earm*) -+ expr='s/^earmv[0-9]/-eabi/;s/eb$//' -+ abi=`echo "$UNAME_MACHINE_ARCH" | sed -e "$expr"` -+ ;; -+ esac - # The OS release - # Debian GNU/NetBSD machines have a different userland, and - # thus, need a distinct triplet. However, they do not need - # kernel version information, so it can be replaced with a - # suitable tag, in the style of linux-gnu. -- case "${UNAME_VERSION}" in -+ case "$UNAME_VERSION" in - Debian*) - release='-gnu' - ;; - *) -- release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` -+ release=`echo "$UNAME_RELEASE" | sed -e 's/[-_].*//' | cut -d. -f1,2` - ;; - esac - # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: - # contains redundant information, the shorter form: - # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. -- echo "${machine}-${os}${release}" -+ echo "$machine-${os}${release}${abi-}" - exit ;; - *:Bitrig:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` -- echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} -+ echo "$UNAME_MACHINE_ARCH"-unknown-bitrig"$UNAME_RELEASE" - exit ;; - *:OpenBSD:*:*) - UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` -- echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} -+ echo "$UNAME_MACHINE_ARCH"-unknown-openbsd"$UNAME_RELEASE" -+ exit ;; -+ *:LibertyBSD:*:*) -+ UNAME_MACHINE_ARCH=`arch | sed 's/^.*BSD\.//'` -+ echo "$UNAME_MACHINE_ARCH"-unknown-libertybsd"$UNAME_RELEASE" -+ exit ;; -+ *:MidnightBSD:*:*) -+ echo "$UNAME_MACHINE"-unknown-midnightbsd"$UNAME_RELEASE" - exit ;; - *:ekkoBSD:*:*) -- echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} -+ echo "$UNAME_MACHINE"-unknown-ekkobsd"$UNAME_RELEASE" - exit ;; - *:SolidBSD:*:*) -- echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} -+ echo "$UNAME_MACHINE"-unknown-solidbsd"$UNAME_RELEASE" - exit ;; - macppc:MirBSD:*:*) -- echo powerpc-unknown-mirbsd${UNAME_RELEASE} -+ echo powerpc-unknown-mirbsd"$UNAME_RELEASE" - exit ;; - *:MirBSD:*:*) -- echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} -+ echo "$UNAME_MACHINE"-unknown-mirbsd"$UNAME_RELEASE" -+ exit ;; -+ *:Sortix:*:*) -+ echo "$UNAME_MACHINE"-unknown-sortix -+ exit ;; -+ *:Redox:*:*) -+ echo "$UNAME_MACHINE"-unknown-redox - exit ;; -+ mips:OSF1:*.*) -+ echo mips-dec-osf1 -+ exit ;; - alpha:OSF1:*:*) - case $UNAME_RELEASE in - *4.0) -@@ -251,63 +293,54 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` - case "$ALPHA_CPU_TYPE" in - "EV4 (21064)") -- UNAME_MACHINE="alpha" ;; -+ UNAME_MACHINE=alpha ;; - "EV4.5 (21064)") -- UNAME_MACHINE="alpha" ;; -+ UNAME_MACHINE=alpha ;; - "LCA4 (21066/21068)") -- UNAME_MACHINE="alpha" ;; -+ UNAME_MACHINE=alpha ;; - "EV5 (21164)") -- UNAME_MACHINE="alphaev5" ;; -+ UNAME_MACHINE=alphaev5 ;; - "EV5.6 (21164A)") -- UNAME_MACHINE="alphaev56" ;; -+ UNAME_MACHINE=alphaev56 ;; - "EV5.6 (21164PC)") -- UNAME_MACHINE="alphapca56" ;; -+ UNAME_MACHINE=alphapca56 ;; - "EV5.7 (21164PC)") -- UNAME_MACHINE="alphapca57" ;; -+ UNAME_MACHINE=alphapca57 ;; - "EV6 (21264)") -- UNAME_MACHINE="alphaev6" ;; -+ UNAME_MACHINE=alphaev6 ;; - "EV6.7 (21264A)") -- UNAME_MACHINE="alphaev67" ;; -+ UNAME_MACHINE=alphaev67 ;; - "EV6.8CB (21264C)") -- UNAME_MACHINE="alphaev68" ;; -+ UNAME_MACHINE=alphaev68 ;; - "EV6.8AL (21264B)") -- UNAME_MACHINE="alphaev68" ;; -+ UNAME_MACHINE=alphaev68 ;; - "EV6.8CX (21264D)") -- UNAME_MACHINE="alphaev68" ;; -+ UNAME_MACHINE=alphaev68 ;; - "EV6.9A (21264/EV69A)") -- UNAME_MACHINE="alphaev69" ;; -+ UNAME_MACHINE=alphaev69 ;; - "EV7 (21364)") -- UNAME_MACHINE="alphaev7" ;; -+ UNAME_MACHINE=alphaev7 ;; - "EV7.9 (21364A)") -- UNAME_MACHINE="alphaev79" ;; -+ UNAME_MACHINE=alphaev79 ;; - esac - # A Pn.n version is a patched version. - # A Vn.n version is a released version. - # A Tn.n version is a released field test version. - # A Xn.n version is an unreleased experimental baselevel. - # 1.2 uses "1.2" for uname -r. -- echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` -+ echo "$UNAME_MACHINE"-dec-osf"`echo "$UNAME_RELEASE" | sed -e 's/^[PVTX]//' | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz`" - # Reset EXIT trap before exiting to avoid spurious non-zero exit code. - exitcode=$? - trap '' 0 - exit $exitcode ;; -- Alpha\ *:Windows_NT*:*) -- # How do we know it's Interix rather than the generic POSIX subsystem? -- # Should we change UNAME_MACHINE based on the output of uname instead -- # of the specific Alpha model? -- echo alpha-pc-interix -- exit ;; -- 21064:Windows_NT:50:3) -- echo alpha-dec-winnt3.5 -- exit ;; - Amiga*:UNIX_System_V:4.0:*) - echo m68k-unknown-sysv4 - exit ;; - *:[Aa]miga[Oo][Ss]:*:*) -- echo ${UNAME_MACHINE}-unknown-amigaos -+ echo "$UNAME_MACHINE"-unknown-amigaos - exit ;; - *:[Mm]orph[Oo][Ss]:*:*) -- echo ${UNAME_MACHINE}-unknown-morphos -+ echo "$UNAME_MACHINE"-unknown-morphos - exit ;; - *:OS/390:*:*) - echo i370-ibm-openedition -@@ -319,7 +352,7 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - echo powerpc-ibm-os400 - exit ;; - arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) -- echo arm-acorn-riscix${UNAME_RELEASE} -+ echo arm-acorn-riscix"$UNAME_RELEASE" - exit ;; - arm*:riscos:*:*|arm*:RISCOS:*:*) - echo arm-unknown-riscos -@@ -346,38 +379,38 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - sparc) echo sparc-icl-nx7; exit ;; - esac ;; - s390x:SunOS:*:*) -- echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` -+ echo "$UNAME_MACHINE"-ibm-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" - exit ;; - sun4H:SunOS:5.*:*) -- echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` -+ echo sparc-hal-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; - sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) -- echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` -+ echo sparc-sun-solaris2"`echo "$UNAME_RELEASE" | sed -e 's/[^.]*//'`" - exit ;; - i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) -- echo i386-pc-auroraux${UNAME_RELEASE} -+ echo i386-pc-auroraux"$UNAME_RELEASE" - exit ;; - i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) -- eval $set_cc_for_build -- SUN_ARCH="i386" -+ set_cc_for_build -+ SUN_ARCH=i386 - # If there is a compiler, see if it is configured for 64-bit objects. - # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. - # This test works for both compilers. -- if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then -+ if [ "$CC_FOR_BUILD" != no_compiler_found ]; then - if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ -- (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ -+ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ - grep IS_64BIT_ARCH >/dev/null - then -- SUN_ARCH="x86_64" -+ SUN_ARCH=x86_64 - fi - fi -- echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` -+ echo "$SUN_ARCH"-pc-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; - sun4*:SunOS:6*:*) - # According to config.sub, this is the proper way to canonicalize - # SunOS6. Hard to guess exactly what SunOS6 will be like, but - # it's likely to be more like Solaris than SunOS4. -- echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` -+ echo sparc-sun-solaris3"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; - sun4*:SunOS:*:*) - case "`/usr/bin/arch -k`" in -@@ -386,25 +419,25 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - ;; - esac - # Japanese Language versions have a version number like `4.1.3-JL'. -- echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` -+ echo sparc-sun-sunos"`echo "$UNAME_RELEASE"|sed -e 's/-/_/'`" - exit ;; - sun3*:SunOS:*:*) -- echo m68k-sun-sunos${UNAME_RELEASE} -+ echo m68k-sun-sunos"$UNAME_RELEASE" - exit ;; - sun*:*:4.2BSD:*) - UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` -- test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 -+ test "x$UNAME_RELEASE" = x && UNAME_RELEASE=3 - case "`/bin/arch`" in - sun3) -- echo m68k-sun-sunos${UNAME_RELEASE} -+ echo m68k-sun-sunos"$UNAME_RELEASE" - ;; - sun4) -- echo sparc-sun-sunos${UNAME_RELEASE} -+ echo sparc-sun-sunos"$UNAME_RELEASE" - ;; - esac - exit ;; - aushp:SunOS:*:*) -- echo sparc-auspex-sunos${UNAME_RELEASE} -+ echo sparc-auspex-sunos"$UNAME_RELEASE" - exit ;; - # The situation for MiNT is a little confusing. The machine name - # can be virtually everything (everything which is not -@@ -415,44 +448,44 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - # MiNT. But MiNT is downward compatible to TOS, so this should - # be no problem. - atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) -- echo m68k-atari-mint${UNAME_RELEASE} -+ echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; - atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) -- echo m68k-atari-mint${UNAME_RELEASE} -+ echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; - *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) -- echo m68k-atari-mint${UNAME_RELEASE} -+ echo m68k-atari-mint"$UNAME_RELEASE" - exit ;; - milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) -- echo m68k-milan-mint${UNAME_RELEASE} -+ echo m68k-milan-mint"$UNAME_RELEASE" - exit ;; - hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) -- echo m68k-hades-mint${UNAME_RELEASE} -+ echo m68k-hades-mint"$UNAME_RELEASE" - exit ;; - *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) -- echo m68k-unknown-mint${UNAME_RELEASE} -+ echo m68k-unknown-mint"$UNAME_RELEASE" - exit ;; - m68k:machten:*:*) -- echo m68k-apple-machten${UNAME_RELEASE} -+ echo m68k-apple-machten"$UNAME_RELEASE" - exit ;; - powerpc:machten:*:*) -- echo powerpc-apple-machten${UNAME_RELEASE} -+ echo powerpc-apple-machten"$UNAME_RELEASE" - exit ;; - RISC*:Mach:*:*) - echo mips-dec-mach_bsd4.3 - exit ;; - RISC*:ULTRIX:*:*) -- echo mips-dec-ultrix${UNAME_RELEASE} -+ echo mips-dec-ultrix"$UNAME_RELEASE" - exit ;; - VAX*:ULTRIX*:*:*) -- echo vax-dec-ultrix${UNAME_RELEASE} -+ echo vax-dec-ultrix"$UNAME_RELEASE" - exit ;; - 2020:CLIX:*:* | 2430:CLIX:*:*) -- echo clipper-intergraph-clix${UNAME_RELEASE} -+ echo clipper-intergraph-clix"$UNAME_RELEASE" - exit ;; - mips:*:*:UMIPS | mips:*:*:RISCos) -- eval $set_cc_for_build -- sed 's/^ //' << EOF >$dummy.c -+ set_cc_for_build -+ sed 's/^ //' << EOF > "$dummy.c" - #ifdef __cplusplus - #include /* for printf() prototype */ - int main (int argc, char *argv[]) { -@@ -461,23 +494,23 @@ case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in - #endif - #if defined (host_mips) && defined (MIPSEB) - #if defined (SYSTYPE_SYSV) -- printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); -+ printf ("mips-mips-riscos%ssysv\\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_SVR4) -- printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); -+ printf ("mips-mips-riscos%ssvr4\\n", argv[1]); exit (0); - #endif - #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) -- printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); -+ printf ("mips-mips-riscos%sbsd\\n", argv[1]); exit (0); - #endif - #endif - exit (-1); - } - EOF -- $CC_FOR_BUILD -o $dummy $dummy.c && -- dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && -- SYSTEM_NAME=`$dummy $dummyarg` && -+ $CC_FOR_BUILD -o "$dummy" "$dummy.c" && -+ dummyarg=`echo "$UNAME_RELEASE" | sed -n 's/\([0-9]*\).*/\1/p'` && -+ SYSTEM_NAME=`"$dummy" "$dummyarg"` && - { echo "$SYSTEM_NAME"; exit; } -- echo mips-mips-riscos${UNAME_RELEASE} -+ echo mips-mips-riscos"$UNAME_RELEASE" - exit ;; - Motorola:PowerMAX_OS:*:*) - echo powerpc-motorola-powermax -@@ -503,17 +536,17 @@ EOF - AViiON:dgux:*:*) - # DG/UX returns AViiON for all architectures - UNAME_PROCESSOR=`/usr/bin/uname -p` -- if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] -+ if [ "$UNAME_PROCESSOR" = mc88100 ] || [ "$UNAME_PROCESSOR" = mc88110 ] - then -- if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ -- [ ${TARGET_BINARY_INTERFACE}x = x ] -+ if [ "$TARGET_BINARY_INTERFACE"x = m88kdguxelfx ] || \ -+ [ "$TARGET_BINARY_INTERFACE"x = x ] - then -- echo m88k-dg-dgux${UNAME_RELEASE} -+ echo m88k-dg-dgux"$UNAME_RELEASE" - else -- echo m88k-dg-dguxbcs${UNAME_RELEASE} -+ echo m88k-dg-dguxbcs"$UNAME_RELEASE" - fi - else -- echo i586-dg-dgux${UNAME_RELEASE} -+ echo i586-dg-dgux"$UNAME_RELEASE" - fi - exit ;; - M88*:DolphinOS:*:*) # DolphinOS (SVR3) -@@ -530,7 +563,7 @@ EOF - echo m68k-tektronix-bsd - exit ;; - *:IRIX*:*:*) -- echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` -+ echo mips-sgi-irix"`echo "$UNAME_RELEASE"|sed -e 's/-/_/g'`" - exit ;; - ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. - echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id -@@ -542,14 +575,14 @@ EOF - if [ -x /usr/bin/oslevel ] ; then - IBM_REV=`/usr/bin/oslevel` - else -- IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} -+ IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" - fi -- echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} -+ echo "$UNAME_MACHINE"-ibm-aix"$IBM_REV" - exit ;; - *:AIX:2:3) - if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then -- eval $set_cc_for_build -- sed 's/^ //' << EOF >$dummy.c -+ set_cc_for_build -+ sed 's/^ //' << EOF > "$dummy.c" - #include - - main() -@@ -560,7 +593,7 @@ EOF - exit(0); - } - EOF -- if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` -+ if $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` - then - echo "$SYSTEM_NAME" - else -@@ -574,26 +607,27 @@ EOF - exit ;; - *:AIX:*:[4567]) - IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` -- if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then -+ if /usr/sbin/lsattr -El "$IBM_CPU_ID" | grep ' POWER' >/dev/null 2>&1; then - IBM_ARCH=rs6000 - else - IBM_ARCH=powerpc - fi -- if [ -x /usr/bin/oslevel ] ; then -- IBM_REV=`/usr/bin/oslevel` -+ if [ -x /usr/bin/lslpp ] ; then -+ IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | -+ awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` - else -- IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} -+ IBM_REV="$UNAME_VERSION.$UNAME_RELEASE" - fi -- echo ${IBM_ARCH}-ibm-aix${IBM_REV} -+ echo "$IBM_ARCH"-ibm-aix"$IBM_REV" - exit ;; - *:AIX:*:*) - echo rs6000-ibm-aix - exit ;; -- ibmrt:4.4BSD:*|romp-ibm:BSD:*) -+ ibmrt:4.4BSD:*|romp-ibm:4.4BSD:*) - echo romp-ibm-bsd4.4 - exit ;; - ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and -- echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to -+ echo romp-ibm-bsd"$UNAME_RELEASE" # 4.3 with uname added to - exit ;; # report: romp-ibm BSD 4.3 - *:BOSX:*:*) - echo rs6000-bull-bosx -@@ -608,28 +642,28 @@ EOF - echo m68k-hp-bsd4.4 - exit ;; - 9000/[34678]??:HP-UX:*:*) -- HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` -- case "${UNAME_MACHINE}" in -- 9000/31? ) HP_ARCH=m68000 ;; -- 9000/[34]?? ) HP_ARCH=m68k ;; -+ HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'` -+ case "$UNAME_MACHINE" in -+ 9000/31?) HP_ARCH=m68000 ;; -+ 9000/[34]??) HP_ARCH=m68k ;; - 9000/[678][0-9][0-9]) - if [ -x /usr/bin/getconf ]; then - sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` - sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` -- case "${sc_cpu_version}" in -- 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 -- 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 -+ case "$sc_cpu_version" in -+ 523) HP_ARCH=hppa1.0 ;; # CPU_PA_RISC1_0 -+ 528) HP_ARCH=hppa1.1 ;; # CPU_PA_RISC1_1 - 532) # CPU_PA_RISC2_0 -- case "${sc_kernel_bits}" in -- 32) HP_ARCH="hppa2.0n" ;; -- 64) HP_ARCH="hppa2.0w" ;; -- '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 -+ case "$sc_kernel_bits" in -+ 32) HP_ARCH=hppa2.0n ;; -+ 64) HP_ARCH=hppa2.0w ;; -+ '') HP_ARCH=hppa2.0 ;; # HP-UX 10.20 - esac ;; - esac - fi -- if [ "${HP_ARCH}" = "" ]; then -- eval $set_cc_for_build -- sed 's/^ //' << EOF >$dummy.c -+ if [ "$HP_ARCH" = "" ]; then -+ set_cc_for_build -+ sed 's/^ //' << EOF > "$dummy.c" - - #define _HPUX_SOURCE - #include -@@ -662,13 +696,13 @@ EOF - exit (0); - } - EOF -- (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` -+ (CCOPTS="" $CC_FOR_BUILD -o "$dummy" "$dummy.c" 2>/dev/null) && HP_ARCH=`"$dummy"` - test -z "$HP_ARCH" && HP_ARCH=hppa - fi ;; - esac -- if [ ${HP_ARCH} = "hppa2.0w" ] -+ if [ "$HP_ARCH" = hppa2.0w ] - then -- eval $set_cc_for_build -+ set_cc_for_build - - # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating - # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler -@@ -679,23 +713,23 @@ EOF - # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess - # => hppa64-hp-hpux11.23 - -- if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | -+ if echo __LP64__ | (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | - grep -q __LP64__ - then -- HP_ARCH="hppa2.0w" -+ HP_ARCH=hppa2.0w - else -- HP_ARCH="hppa64" -+ HP_ARCH=hppa64 - fi - fi -- echo ${HP_ARCH}-hp-hpux${HPUX_REV} -+ echo "$HP_ARCH"-hp-hpux"$HPUX_REV" - exit ;; - ia64:HP-UX:*:*) -- HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` -- echo ia64-hp-hpux${HPUX_REV} -+ HPUX_REV=`echo "$UNAME_RELEASE"|sed -e 's/[^.]*.[0B]*//'` -+ echo ia64-hp-hpux"$HPUX_REV" - exit ;; - 3050*:HI-UX:*:*) -- eval $set_cc_for_build -- sed 's/^ //' << EOF >$dummy.c -+ set_cc_for_build -+ sed 's/^ //' << EOF > "$dummy.c" - #include - int - main () -@@ -720,11 +754,11 @@ EOF - exit (0); - } - EOF -- $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && -+ $CC_FOR_BUILD -o "$dummy" "$dummy.c" && SYSTEM_NAME=`"$dummy"` && - { echo "$SYSTEM_NAME"; exit; } - echo unknown-hitachi-hiuxwe2 - exit ;; -- 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) -+ 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:*) - echo hppa1.1-hp-bsd - exit ;; - 9000/8??:4.3bsd:*:*) -@@ -733,7 +767,7 @@ EOF - *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) - echo hppa1.0-hp-mpeix - exit ;; -- hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) -+ hp7??:OSF1:*:* | hp8?[79]:OSF1:*:*) - echo hppa1.1-hp-osf - exit ;; - hp8??:OSF1:*:*) -@@ -741,9 +775,9 @@ EOF - exit ;; - i*86:OSF1:*:*) - if [ -x /usr/sbin/sysversion ] ; then -- echo ${UNAME_MACHINE}-unknown-osf1mk -+ echo "$UNAME_MACHINE"-unknown-osf1mk - else -- echo ${UNAME_MACHINE}-unknown-osf1 -+ echo "$UNAME_MACHINE"-unknown-osf1 - fi - exit ;; - parisc*:Lites*:*:*) -@@ -768,127 +802,120 @@ EOF - echo c4-convex-bsd - exit ;; - CRAY*Y-MP:*:*:*) -- echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' -+ echo ymp-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*[A-Z]90:*:*:*) -- echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ -+ echo "$UNAME_MACHINE"-cray-unicos"$UNAME_RELEASE" \ - | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ - -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ - -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*TS:*:*:*) -- echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' -+ echo t90-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*T3E:*:*:*) -- echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' -+ echo alphaev5-cray-unicosmk"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; - CRAY*SV1:*:*:*) -- echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' -+ echo sv1-cray-unicos"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; - *:UNICOS/mp:*:*) -- echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' -+ echo craynv-cray-unicosmp"$UNAME_RELEASE" | sed -e 's/\.[^.]*$/.X/' - exit ;; - F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) -- FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` -- FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` -- FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` -+ FUJITSU_PROC=`uname -m | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz` -+ FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` -+ FUJITSU_REL=`echo "$UNAME_RELEASE" | sed -e 's/ /_/'` - echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - 5000:UNIX_System_V:4.*:*) -- FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` -- FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` -+ FUJITSU_SYS=`uname -p | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/\///'` -+ FUJITSU_REL=`echo "$UNAME_RELEASE" | tr ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz | sed -e 's/ /_/'` - echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" - exit ;; - i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) -- echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} -+ echo "$UNAME_MACHINE"-pc-bsdi"$UNAME_RELEASE" - exit ;; - sparc*:BSD/OS:*:*) -- echo sparc-unknown-bsdi${UNAME_RELEASE} -+ echo sparc-unknown-bsdi"$UNAME_RELEASE" - exit ;; - *:BSD/OS:*:*) -- echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} -+ echo "$UNAME_MACHINE"-unknown-bsdi"$UNAME_RELEASE" -+ exit ;; -+ arm:FreeBSD:*:*) -+ UNAME_PROCESSOR=`uname -p` -+ set_cc_for_build -+ if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ -+ | grep -q __ARM_PCS_VFP -+ then -+ echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabi -+ else -+ echo "${UNAME_PROCESSOR}"-unknown-freebsd"`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`"-gnueabihf -+ fi - exit ;; - *:FreeBSD:*:*) - UNAME_PROCESSOR=`/usr/bin/uname -p` -- case ${UNAME_PROCESSOR} in -+ case "$UNAME_PROCESSOR" in - amd64) -- echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; -- *) -- echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; -+ UNAME_PROCESSOR=x86_64 ;; -+ i386) -+ UNAME_PROCESSOR=i586 ;; - esac -+ echo "$UNAME_PROCESSOR"-unknown-freebsd"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" - exit ;; - i*:CYGWIN*:*) -- echo ${UNAME_MACHINE}-pc-cygwin -+ echo "$UNAME_MACHINE"-pc-cygwin - exit ;; - *:MINGW64*:*) -- echo ${UNAME_MACHINE}-pc-mingw64 -+ echo "$UNAME_MACHINE"-pc-mingw64 - exit ;; - *:MINGW*:*) -- echo ${UNAME_MACHINE}-pc-mingw32 -- exit ;; -- i*:MSYS*:*) -- echo ${UNAME_MACHINE}-pc-msys -+ echo "$UNAME_MACHINE"-pc-mingw32 - exit ;; -- i*:windows32*:*) -- # uname -m includes "-pc" on this system. -- echo ${UNAME_MACHINE}-mingw32 -+ *:MSYS*:*) -+ echo "$UNAME_MACHINE"-pc-msys - exit ;; - i*:PW*:*) -- echo ${UNAME_MACHINE}-pc-pw32 -+ echo "$UNAME_MACHINE"-pc-pw32 - exit ;; - *:Interix*:*) -- case ${UNAME_MACHINE} in -+ case "$UNAME_MACHINE" in - x86) -- echo i586-pc-interix${UNAME_RELEASE} -+ echo i586-pc-interix"$UNAME_RELEASE" - exit ;; - authenticamd | genuineintel | EM64T) -- echo x86_64-unknown-interix${UNAME_RELEASE} -+ echo x86_64-unknown-interix"$UNAME_RELEASE" - exit ;; - IA64) -- echo ia64-unknown-interix${UNAME_RELEASE} -+ echo ia64-unknown-interix"$UNAME_RELEASE" - exit ;; - esac ;; -- [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) -- echo i${UNAME_MACHINE}-pc-mks -- exit ;; -- 8664:Windows_NT:*) -- echo x86_64-pc-mks -- exit ;; -- i*:Windows_NT*:* | Pentium*:Windows_NT*:*) -- # How do we know it's Interix rather than the generic POSIX subsystem? -- # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we -- # UNAME_MACHINE based on the output of uname instead of i386? -- echo i586-pc-interix -- exit ;; - i*:UWIN*:*) -- echo ${UNAME_MACHINE}-pc-uwin -+ echo "$UNAME_MACHINE"-pc-uwin - exit ;; - amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) -- echo x86_64-unknown-cygwin -- exit ;; -- p*:CYGWIN*:*) -- echo powerpcle-unknown-cygwin -+ echo x86_64-pc-cygwin - exit ;; - prep*:SunOS:5.*:*) -- echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` -+ echo powerpcle-unknown-solaris2"`echo "$UNAME_RELEASE"|sed -e 's/[^.]*//'`" - exit ;; - *:GNU:*:*) - # the GNU system -- echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-${LIBC}`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` -+ echo "`echo "$UNAME_MACHINE"|sed -e 's,[-/].*$,,'`-unknown-$LIBC`echo "$UNAME_RELEASE"|sed -e 's,/.*$,,'`" - exit ;; - *:GNU/*:*:*) - # other systems with GNU libc and userland -- echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-${LIBC} -+ echo "$UNAME_MACHINE-unknown-`echo "$UNAME_SYSTEM" | sed 's,^[^/]*/,,' | tr "[:upper:]" "[:lower:]"``echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`-$LIBC" - exit ;; -- i*86:Minix:*:*) -- echo ${UNAME_MACHINE}-pc-minix -+ *:Minix:*:*) -+ echo "$UNAME_MACHINE"-unknown-minix - exit ;; - aarch64:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - aarch64_be:Linux:*:*) - UNAME_MACHINE=aarch64_be -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - alpha:Linux:*:*) - case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in -@@ -901,58 +928,64 @@ EOF - EV68*) UNAME_MACHINE=alphaev68 ;; - esac - objdump --private-headers /bin/sh | grep -q ld.so.1 -- if test "$?" = 0 ; then LIBC="gnulibc1" ; fi -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ if test "$?" = 0 ; then LIBC=gnulibc1 ; fi -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - arc:Linux:*:* | arceb:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - arm*:Linux:*:*) -- eval $set_cc_for_build -+ set_cc_for_build - if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_EABI__ - then -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - else - if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ - | grep -q __ARM_PCS_VFP - then -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabi -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabi - else -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabihf -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC"eabihf - fi - fi - exit ;; - avr32*:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - cris:Linux:*:*) -- echo ${UNAME_MACHINE}-axis-linux-${LIBC} -+ echo "$UNAME_MACHINE"-axis-linux-"$LIBC" - exit ;; - crisv32:Linux:*:*) -- echo ${UNAME_MACHINE}-axis-linux-${LIBC} -+ echo "$UNAME_MACHINE"-axis-linux-"$LIBC" -+ exit ;; -+ e2k:Linux:*:*) -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - frv:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - hexagon:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - i*86:Linux:*:*) -- echo ${UNAME_MACHINE}-pc-linux-${LIBC} -+ echo "$UNAME_MACHINE"-pc-linux-"$LIBC" - exit ;; - ia64:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" -+ exit ;; -+ k1om:Linux:*:*) -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - m32r*:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - m68*:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - mips:Linux:*:* | mips64:Linux:*:*) -- eval $set_cc_for_build -- sed 's/^ //' << EOF >$dummy.c -+ set_cc_for_build -+ sed 's/^ //' << EOF > "$dummy.c" - #undef CPU - #undef ${UNAME_MACHINE} - #undef ${UNAME_MACHINE}el -@@ -966,64 +999,70 @@ EOF - #endif - #endif - EOF -- eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` -- test x"${CPU}" != x && { echo "${CPU}-unknown-linux-${LIBC}"; exit; } -+ eval "`$CC_FOR_BUILD -E "$dummy.c" 2>/dev/null | grep '^CPU'`" -+ test "x$CPU" != x && { echo "$CPU-unknown-linux-$LIBC"; exit; } - ;; -- or1k:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ mips64el:Linux:*:*) -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" -+ exit ;; -+ openrisc*:Linux:*:*) -+ echo or1k-unknown-linux-"$LIBC" - exit ;; -- or32:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ or32:Linux:*:* | or1k*:Linux:*:*) -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - padre:Linux:*:*) -- echo sparc-unknown-linux-${LIBC} -+ echo sparc-unknown-linux-"$LIBC" - exit ;; - parisc64:Linux:*:* | hppa64:Linux:*:*) -- echo hppa64-unknown-linux-${LIBC} -+ echo hppa64-unknown-linux-"$LIBC" - exit ;; - parisc:Linux:*:* | hppa:Linux:*:*) - # Look for CPU level - case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in -- PA7*) echo hppa1.1-unknown-linux-${LIBC} ;; -- PA8*) echo hppa2.0-unknown-linux-${LIBC} ;; -- *) echo hppa-unknown-linux-${LIBC} ;; -+ PA7*) echo hppa1.1-unknown-linux-"$LIBC" ;; -+ PA8*) echo hppa2.0-unknown-linux-"$LIBC" ;; -+ *) echo hppa-unknown-linux-"$LIBC" ;; - esac - exit ;; - ppc64:Linux:*:*) -- echo powerpc64-unknown-linux-${LIBC} -+ echo powerpc64-unknown-linux-"$LIBC" - exit ;; - ppc:Linux:*:*) -- echo powerpc-unknown-linux-${LIBC} -+ echo powerpc-unknown-linux-"$LIBC" - exit ;; - ppc64le:Linux:*:*) -- echo powerpc64le-unknown-linux-${LIBC} -+ echo powerpc64le-unknown-linux-"$LIBC" - exit ;; - ppcle:Linux:*:*) -- echo powerpcle-unknown-linux-${LIBC} -+ echo powerpcle-unknown-linux-"$LIBC" -+ exit ;; -+ riscv32:Linux:*:* | riscv64:Linux:*:*) -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - s390:Linux:*:* | s390x:Linux:*:*) -- echo ${UNAME_MACHINE}-ibm-linux-${LIBC} -+ echo "$UNAME_MACHINE"-ibm-linux-"$LIBC" - exit ;; - sh64*:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - sh*:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - sparc:Linux:*:* | sparc64:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - tile*:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - vax:Linux:*:*) -- echo ${UNAME_MACHINE}-dec-linux-${LIBC} -+ echo "$UNAME_MACHINE"-dec-linux-"$LIBC" - exit ;; - x86_64:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-pc-linux-"$LIBC" - exit ;; - xtensa*:Linux:*:*) -- echo ${UNAME_MACHINE}-unknown-linux-${LIBC} -+ echo "$UNAME_MACHINE"-unknown-linux-"$LIBC" - exit ;; - i*86:DYNIX/ptx:4*:*) - # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. -@@ -1037,34 +1076,34 @@ EOF - # I am not positive that other SVR4 systems won't match this, - # I just have to hope. -- rms. - # Use sysv4.2uw... so that sysv4* matches it. -- echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} -+ echo "$UNAME_MACHINE"-pc-sysv4.2uw"$UNAME_VERSION" - exit ;; - i*86:OS/2:*:*) - # If we were able to find `uname', then EMX Unix compatibility - # is probably installed. -- echo ${UNAME_MACHINE}-pc-os2-emx -+ echo "$UNAME_MACHINE"-pc-os2-emx - exit ;; - i*86:XTS-300:*:STOP) -- echo ${UNAME_MACHINE}-unknown-stop -+ echo "$UNAME_MACHINE"-unknown-stop - exit ;; - i*86:atheos:*:*) -- echo ${UNAME_MACHINE}-unknown-atheos -+ echo "$UNAME_MACHINE"-unknown-atheos - exit ;; - i*86:syllable:*:*) -- echo ${UNAME_MACHINE}-pc-syllable -+ echo "$UNAME_MACHINE"-pc-syllable - exit ;; - i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) -- echo i386-unknown-lynxos${UNAME_RELEASE} -+ echo i386-unknown-lynxos"$UNAME_RELEASE" - exit ;; - i*86:*DOS:*:*) -- echo ${UNAME_MACHINE}-pc-msdosdjgpp -+ echo "$UNAME_MACHINE"-pc-msdosdjgpp - exit ;; -- i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) -- UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` -+ i*86:*:4.*:*) -+ UNAME_REL=`echo "$UNAME_RELEASE" | sed 's/\/MP$//'` - if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then -- echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} -+ echo "$UNAME_MACHINE"-univel-sysv"$UNAME_REL" - else -- echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} -+ echo "$UNAME_MACHINE"-pc-sysv"$UNAME_REL" - fi - exit ;; - i*86:*:5:[678]*) -@@ -1074,12 +1113,12 @@ EOF - *Pentium) UNAME_MACHINE=i586 ;; - *Pent*|*Celeron) UNAME_MACHINE=i686 ;; - esac -- echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} -+ echo "$UNAME_MACHINE-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}{$UNAME_VERSION}" - exit ;; - i*86:*:3.2:*) - if test -f /usr/options/cb.name; then - UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then - UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` - (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 -@@ -1089,9 +1128,9 @@ EOF - && UNAME_MACHINE=i686 - (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ - && UNAME_MACHINE=i686 -- echo ${UNAME_MACHINE}-pc-sco$UNAME_REL -+ echo "$UNAME_MACHINE"-pc-sco"$UNAME_REL" - else -- echo ${UNAME_MACHINE}-pc-sysv32 -+ echo "$UNAME_MACHINE"-pc-sysv32 - fi - exit ;; - pc:*:*:*) -@@ -1099,7 +1138,7 @@ EOF - # uname -m prints for DJGPP always 'pc', but it prints nothing about - # the processor, so we play safe by assuming i586. - # Note: whatever this is, it MUST be the same as what config.sub -- # prints for the "djgpp" host, or else GDB configury will decide that -+ # prints for the "djgpp" host, or else GDB configure will decide that - # this is a cross-build. - echo i586-pc-msdosdjgpp - exit ;; -@@ -1111,9 +1150,9 @@ EOF - exit ;; - i860:*:4.*:*) # i860-SVR4 - if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then -- echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 -+ echo i860-stardent-sysv"$UNAME_RELEASE" # Stardent Vistra i860-SVR4 - else # Add other i860-SVR4 vendors below as they are discovered. -- echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 -+ echo i860-unknown-sysv"$UNAME_RELEASE" # Unknown i860-SVR4 - fi - exit ;; - mini*:CTIX:SYS*5:*) -@@ -1133,9 +1172,9 @@ EOF - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ -- && { echo i486-ncr-sysv4.3${OS_REL}; exit; } -+ && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ -- && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; -+ && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; - 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ - && { echo i486-ncr-sysv4; exit; } ;; -@@ -1144,28 +1183,28 @@ EOF - test -r /etc/.relid \ - && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` - /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ -- && { echo i486-ncr-sysv4.3${OS_REL}; exit; } -+ && { echo i486-ncr-sysv4.3"$OS_REL"; exit; } - /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ -- && { echo i586-ncr-sysv4.3${OS_REL}; exit; } -+ && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } - /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ -- && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; -+ && { echo i586-ncr-sysv4.3"$OS_REL"; exit; } ;; - m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) -- echo m68k-unknown-lynxos${UNAME_RELEASE} -+ echo m68k-unknown-lynxos"$UNAME_RELEASE" - exit ;; - mc68030:UNIX_System_V:4.*:*) - echo m68k-atari-sysv4 - exit ;; - TSUNAMI:LynxOS:2.*:*) -- echo sparc-unknown-lynxos${UNAME_RELEASE} -+ echo sparc-unknown-lynxos"$UNAME_RELEASE" - exit ;; - rs6000:LynxOS:2.*:*) -- echo rs6000-unknown-lynxos${UNAME_RELEASE} -+ echo rs6000-unknown-lynxos"$UNAME_RELEASE" - exit ;; - PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) -- echo powerpc-unknown-lynxos${UNAME_RELEASE} -+ echo powerpc-unknown-lynxos"$UNAME_RELEASE" - exit ;; - SM[BE]S:UNIX_SV:*:*) -- echo mips-dde-sysv${UNAME_RELEASE} -+ echo mips-dde-sysv"$UNAME_RELEASE" - exit ;; - RM*:ReliantUNIX-*:*:*) - echo mips-sni-sysv4 -@@ -1176,7 +1215,7 @@ EOF - *:SINIX-*:*:*) - if uname -p 2>/dev/null >/dev/null ; then - UNAME_MACHINE=`(uname -p) 2>/dev/null` -- echo ${UNAME_MACHINE}-sni-sysv4 -+ echo "$UNAME_MACHINE"-sni-sysv4 - else - echo ns32k-sni-sysv - fi -@@ -1196,23 +1235,23 @@ EOF - exit ;; - i*86:VOS:*:*) - # From Paul.Green@stratus.com. -- echo ${UNAME_MACHINE}-stratus-vos -+ echo "$UNAME_MACHINE"-stratus-vos - exit ;; - *:VOS:*:*) - # From Paul.Green@stratus.com. - echo hppa1.1-stratus-vos - exit ;; - mc68*:A/UX:*:*) -- echo m68k-apple-aux${UNAME_RELEASE} -+ echo m68k-apple-aux"$UNAME_RELEASE" - exit ;; - news*:NEWS-OS:6*:*) - echo mips-sony-newsos6 - exit ;; - R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) - if [ -d /usr/nec ]; then -- echo mips-nec-sysv${UNAME_RELEASE} -+ echo mips-nec-sysv"$UNAME_RELEASE" - else -- echo mips-unknown-sysv${UNAME_RELEASE} -+ echo mips-unknown-sysv"$UNAME_RELEASE" - fi - exit ;; - BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. -@@ -1231,67 +1270,93 @@ EOF - echo x86_64-unknown-haiku - exit ;; - SX-4:SUPER-UX:*:*) -- echo sx4-nec-superux${UNAME_RELEASE} -+ echo sx4-nec-superux"$UNAME_RELEASE" - exit ;; - SX-5:SUPER-UX:*:*) -- echo sx5-nec-superux${UNAME_RELEASE} -+ echo sx5-nec-superux"$UNAME_RELEASE" - exit ;; - SX-6:SUPER-UX:*:*) -- echo sx6-nec-superux${UNAME_RELEASE} -+ echo sx6-nec-superux"$UNAME_RELEASE" - exit ;; - SX-7:SUPER-UX:*:*) -- echo sx7-nec-superux${UNAME_RELEASE} -+ echo sx7-nec-superux"$UNAME_RELEASE" - exit ;; - SX-8:SUPER-UX:*:*) -- echo sx8-nec-superux${UNAME_RELEASE} -+ echo sx8-nec-superux"$UNAME_RELEASE" - exit ;; - SX-8R:SUPER-UX:*:*) -- echo sx8r-nec-superux${UNAME_RELEASE} -+ echo sx8r-nec-superux"$UNAME_RELEASE" -+ exit ;; -+ SX-ACE:SUPER-UX:*:*) -+ echo sxace-nec-superux"$UNAME_RELEASE" - exit ;; - Power*:Rhapsody:*:*) -- echo powerpc-apple-rhapsody${UNAME_RELEASE} -+ echo powerpc-apple-rhapsody"$UNAME_RELEASE" - exit ;; - *:Rhapsody:*:*) -- echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} -+ echo "$UNAME_MACHINE"-apple-rhapsody"$UNAME_RELEASE" - exit ;; - *:Darwin:*:*) - UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown -- eval $set_cc_for_build -+ set_cc_for_build - if test "$UNAME_PROCESSOR" = unknown ; then - UNAME_PROCESSOR=powerpc - fi -- if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then -- if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ -- (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ -- grep IS_64BIT_ARCH >/dev/null -- then -- case $UNAME_PROCESSOR in -- i386) UNAME_PROCESSOR=x86_64 ;; -- powerpc) UNAME_PROCESSOR=powerpc64 ;; -- esac -+ if test "`echo "$UNAME_RELEASE" | sed -e 's/\..*//'`" -le 10 ; then -+ if [ "$CC_FOR_BUILD" != no_compiler_found ]; then -+ if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ -+ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ -+ grep IS_64BIT_ARCH >/dev/null -+ then -+ case $UNAME_PROCESSOR in -+ i386) UNAME_PROCESSOR=x86_64 ;; -+ powerpc) UNAME_PROCESSOR=powerpc64 ;; -+ esac -+ fi -+ # On 10.4-10.6 one might compile for PowerPC via gcc -arch ppc -+ if (echo '#ifdef __POWERPC__'; echo IS_PPC; echo '#endif') | \ -+ (CCOPTS="" $CC_FOR_BUILD -E - 2>/dev/null) | \ -+ grep IS_PPC >/dev/null -+ then -+ UNAME_PROCESSOR=powerpc -+ fi - fi -+ elif test "$UNAME_PROCESSOR" = i386 ; then -+ # Avoid executing cc on OS X 10.9, as it ships with a stub -+ # that puts up a graphical alert prompting to install -+ # developer tools. Any system running Mac OS X 10.7 or -+ # later (Darwin 11 and later) is required to have a 64-bit -+ # processor. This is not true of the ARM version of Darwin -+ # that Apple uses in portable devices. -+ UNAME_PROCESSOR=x86_64 - fi -- echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} -+ echo "$UNAME_PROCESSOR"-apple-darwin"$UNAME_RELEASE" - exit ;; - *:procnto*:*:* | *:QNX:[0123456789]*:*) - UNAME_PROCESSOR=`uname -p` -- if test "$UNAME_PROCESSOR" = "x86"; then -+ if test "$UNAME_PROCESSOR" = x86; then - UNAME_PROCESSOR=i386 - UNAME_MACHINE=pc - fi -- echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} -+ echo "$UNAME_PROCESSOR"-"$UNAME_MACHINE"-nto-qnx"$UNAME_RELEASE" - exit ;; - *:QNX:*:4*) - echo i386-pc-qnx - exit ;; -- NEO-?:NONSTOP_KERNEL:*:*) -- echo neo-tandem-nsk${UNAME_RELEASE} -+ NEO-*:NONSTOP_KERNEL:*:*) -+ echo neo-tandem-nsk"$UNAME_RELEASE" - exit ;; - NSE-*:NONSTOP_KERNEL:*:*) -- echo nse-tandem-nsk${UNAME_RELEASE} -+ echo nse-tandem-nsk"$UNAME_RELEASE" -+ exit ;; -+ NSR-*:NONSTOP_KERNEL:*:*) -+ echo nsr-tandem-nsk"$UNAME_RELEASE" -+ exit ;; -+ NSV-*:NONSTOP_KERNEL:*:*) -+ echo nsv-tandem-nsk"$UNAME_RELEASE" - exit ;; -- NSR-?:NONSTOP_KERNEL:*:*) -- echo nsr-tandem-nsk${UNAME_RELEASE} -+ NSX-*:NONSTOP_KERNEL:*:*) -+ echo nsx-tandem-nsk"$UNAME_RELEASE" - exit ;; - *:NonStop-UX:*:*) - echo mips-compaq-nonstopux -@@ -1300,18 +1365,19 @@ EOF - echo bs2000-siemens-sysv - exit ;; - DS/*:UNIX_System_V:*:*) -- echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} -+ echo "$UNAME_MACHINE"-"$UNAME_SYSTEM"-"$UNAME_RELEASE" - exit ;; - *:Plan9:*:*) - # "uname -m" is not consistent, so use $cputype instead. 386 - # is converted to i386 for consistency with other x86 - # operating systems. -- if test "$cputype" = "386"; then -+ # shellcheck disable=SC2154 -+ if test "$cputype" = 386; then - UNAME_MACHINE=i386 - else - UNAME_MACHINE="$cputype" - fi -- echo ${UNAME_MACHINE}-unknown-plan9 -+ echo "$UNAME_MACHINE"-unknown-plan9 - exit ;; - *:TOPS-10:*:*) - echo pdp10-unknown-tops10 -@@ -1332,14 +1398,14 @@ EOF - echo pdp10-unknown-its - exit ;; - SEI:*:*:SEIUX) -- echo mips-sei-seiux${UNAME_RELEASE} -+ echo mips-sei-seiux"$UNAME_RELEASE" - exit ;; - *:DragonFly:*:*) -- echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` -+ echo "$UNAME_MACHINE"-unknown-dragonfly"`echo "$UNAME_RELEASE"|sed -e 's/[-(].*//'`" - exit ;; - *:*VMS:*:*) - UNAME_MACHINE=`(uname -p) 2>/dev/null` -- case "${UNAME_MACHINE}" in -+ case "$UNAME_MACHINE" in - A*) echo alpha-dec-vms ; exit ;; - I*) echo ia64-dec-vms ; exit ;; - V*) echo vax-dec-vms ; exit ;; -@@ -1348,182 +1414,51 @@ EOF - echo i386-pc-xenix - exit ;; - i*86:skyos:*:*) -- echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' -+ echo "$UNAME_MACHINE"-pc-skyos"`echo "$UNAME_RELEASE" | sed -e 's/ .*$//'`" - exit ;; - i*86:rdos:*:*) -- echo ${UNAME_MACHINE}-pc-rdos -+ echo "$UNAME_MACHINE"-pc-rdos - exit ;; - i*86:AROS:*:*) -- echo ${UNAME_MACHINE}-pc-aros -+ echo "$UNAME_MACHINE"-pc-aros - exit ;; - x86_64:VMkernel:*:*) -- echo ${UNAME_MACHINE}-unknown-esx -+ echo "$UNAME_MACHINE"-unknown-esx -+ exit ;; -+ amd64:Isilon\ OneFS:*:*) -+ echo x86_64-unknown-onefs -+ exit ;; -+ *:Unleashed:*:*) -+ echo "$UNAME_MACHINE"-unknown-unleashed"$UNAME_RELEASE" - exit ;; - esac - --eval $set_cc_for_build --cat >$dummy.c < --# include --#endif --main () --{ --#if defined (sony) --#if defined (MIPSEB) -- /* BFD wants "bsd" instead of "newsos". Perhaps BFD should be changed, -- I don't know.... */ -- printf ("mips-sony-bsd\n"); exit (0); --#else --#include -- printf ("m68k-sony-newsos%s\n", --#ifdef NEWSOS4 -- "4" --#else -- "" --#endif -- ); exit (0); --#endif --#endif -- --#if defined (__arm) && defined (__acorn) && defined (__unix) -- printf ("arm-acorn-riscix\n"); exit (0); --#endif -- --#if defined (hp300) && !defined (hpux) -- printf ("m68k-hp-bsd\n"); exit (0); --#endif -- --#if defined (NeXT) --#if !defined (__ARCHITECTURE__) --#define __ARCHITECTURE__ "m68k" --#endif -- int version; -- version=`(hostinfo | sed -n 's/.*NeXT Mach \([0-9]*\).*/\1/p') 2>/dev/null`; -- if (version < 4) -- printf ("%s-next-nextstep%d\n", __ARCHITECTURE__, version); -- else -- printf ("%s-next-openstep%d\n", __ARCHITECTURE__, version); -- exit (0); --#endif -- --#if defined (MULTIMAX) || defined (n16) --#if defined (UMAXV) -- printf ("ns32k-encore-sysv\n"); exit (0); --#else --#if defined (CMU) -- printf ("ns32k-encore-mach\n"); exit (0); --#else -- printf ("ns32k-encore-bsd\n"); exit (0); --#endif --#endif --#endif -- --#if defined (__386BSD__) -- printf ("i386-pc-bsd\n"); exit (0); --#endif -- --#if defined (sequent) --#if defined (i386) -- printf ("i386-sequent-dynix\n"); exit (0); --#endif --#if defined (ns32000) -- printf ("ns32k-sequent-dynix\n"); exit (0); --#endif --#endif -- --#if defined (_SEQUENT_) -- struct utsname un; -- -- uname(&un); -- -- if (strncmp(un.version, "V2", 2) == 0) { -- printf ("i386-sequent-ptx2\n"); exit (0); -- } -- if (strncmp(un.version, "V1", 2) == 0) { /* XXX is V1 correct? */ -- printf ("i386-sequent-ptx1\n"); exit (0); -- } -- printf ("i386-sequent-ptx\n"); exit (0); -- --#endif -- --#if defined (vax) --# if !defined (ultrix) --# include --# if defined (BSD) --# if BSD == 43 -- printf ("vax-dec-bsd4.3\n"); exit (0); --# else --# if BSD == 199006 -- printf ("vax-dec-bsd4.3reno\n"); exit (0); --# else -- printf ("vax-dec-bsd\n"); exit (0); --# endif --# endif --# else -- printf ("vax-dec-bsd\n"); exit (0); --# endif --# else -- printf ("vax-dec-ultrix\n"); exit (0); --# endif --#endif -+echo "$0: unable to guess system type" >&2 - --#if defined (alliant) && defined (i860) -- printf ("i860-alliant-bsd\n"); exit (0); --#endif -+case "$UNAME_MACHINE:$UNAME_SYSTEM" in -+ mips:Linux | mips64:Linux) -+ # If we got here on MIPS GNU/Linux, output extra information. -+ cat >&2 </dev/null && SYSTEM_NAME=`$dummy` && -- { echo "$SYSTEM_NAME"; exit; } -- --# Apollos put the system type in the environment. -- --test -d /usr/apollo && { echo ${ISP}-apollo-${SYSTYPE}; exit; } -- --# Convex versions that predate uname can use getsysinfo(1) -- --if [ -x /usr/convex/getsysinfo ] --then -- case `getsysinfo -f cpu_type` in -- c1*) -- echo c1-convex-bsd -- exit ;; -- c2*) -- if getsysinfo -f scalar_acc -- then echo c32-convex-bsd -- else echo c2-convex-bsd -- fi -- exit ;; -- c34*) -- echo c34-convex-bsd -- exit ;; -- c38*) -- echo c38-convex-bsd -- exit ;; -- c4*) -- echo c4-convex-bsd -- exit ;; -- esac --fi -+ ;; -+esac - - cat >&2 < in order to provide the needed --information to handle your system. -+If $0 has already been updated, send the following data and any -+information you think might be pertinent to config-patches@gnu.org to -+provide the necessary information to handle your system. - - config.guess timestamp = $timestamp - -@@ -1542,16 +1477,16 @@ hostinfo = `(hostinfo) 2>/dev/null` - /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` - /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` - --UNAME_MACHINE = ${UNAME_MACHINE} --UNAME_RELEASE = ${UNAME_RELEASE} --UNAME_SYSTEM = ${UNAME_SYSTEM} --UNAME_VERSION = ${UNAME_VERSION} -+UNAME_MACHINE = "$UNAME_MACHINE" -+UNAME_RELEASE = "$UNAME_RELEASE" -+UNAME_SYSTEM = "$UNAME_SYSTEM" -+UNAME_VERSION = "$UNAME_VERSION" - EOF - - exit 1 - - # Local variables: --# eval: (add-hook 'write-file-hooks 'time-stamp) -+# eval: (add-hook 'before-save-hook 'time-stamp) - # time-stamp-start: "timestamp='" - # time-stamp-format: "%:y-%02m-%02d" - # time-stamp-end: "'" -diff --git a/config/gnu/config.sub b/config/gnu/config.sub -index 8b612ab89..3b4c7624b 100755 ---- a/config/gnu/config.sub -+++ b/config/gnu/config.sub -@@ -1,8 +1,8 @@ - #! /bin/sh - # Configuration validation subroutine script. --# Copyright 1992-2013 Free Software Foundation, Inc. -+# Copyright 1992-2019 Free Software Foundation, Inc. - --timestamp='2013-04-24' -+timestamp='2019-01-05' - - # This file is free software; you can redistribute it and/or modify it - # under the terms of the GNU General Public License as published by -@@ -15,7 +15,7 @@ timestamp='2013-04-24' - # General Public License for more details. - # - # You should have received a copy of the GNU General Public License --# along with this program; if not, see . -+# along with this program; if not, see . - # - # As a special exception to the GNU General Public License, if you - # distribute this file as part of a program that contains a -@@ -25,7 +25,7 @@ timestamp='2013-04-24' - # of the GNU General Public License, version 3 ("GPLv3"). - - --# Please send patches with a ChangeLog entry to config-patches@gnu.org. -+# Please send patches to . - # - # Configuration subroutine to validate and canonicalize a configuration type. - # Supply the specified configuration type as an argument. -@@ -33,7 +33,7 @@ timestamp='2013-04-24' - # Otherwise, we print the canonical config type on stdout and succeed. - - # You can get the latest version of this script from: --# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD -+# https://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub - - # This file is supposed to be the same for all GNU packages - # and recognize all the CPU types, system types and aliases -@@ -53,12 +53,11 @@ timestamp='2013-04-24' - me=`echo "$0" | sed -e 's,.*/,,'` - - usage="\ --Usage: $0 [OPTION] CPU-MFR-OPSYS -- $0 [OPTION] ALIAS -+Usage: $0 [OPTION] CPU-MFR-OPSYS or ALIAS - - Canonicalize a configuration name. - --Operation modes: -+Options: - -h, --help print this help, then exit - -t, --time-stamp print date of last modification, then exit - -v, --version print version number, then exit -@@ -68,7 +67,7 @@ Report bugs and patches to ." - version="\ - GNU config.sub ($timestamp) - --Copyright 1992-2013 Free Software Foundation, Inc. -+Copyright 1992-2019 Free Software Foundation, Inc. - - This is free software; see the source for copying conditions. There is NO - warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." -@@ -90,12 +89,12 @@ while test $# -gt 0 ; do - - ) # Use stdin as input. - break ;; - -* ) -- echo "$me: invalid option $1$help" -+ echo "$me: invalid option $1$help" >&2 - exit 1 ;; - - *local*) - # First pass through any local machine types. -- echo $1 -+ echo "$1" - exit ;; - - * ) -@@ -111,1209 +110,1164 @@ case $# in - exit 1;; - esac - --# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). --# Here we must recognize all the valid KERNEL-OS combinations. --maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` --case $maybe_os in -- nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ -- linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ -- knetbsd*-gnu* | netbsd*-gnu* | \ -- kopensolaris*-gnu* | \ -- storm-chaos* | os2-emx* | rtmk-nova*) -- os=-$maybe_os -- basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` -- ;; -- android-linux) -- os=-linux-android -- basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown -- ;; -- *) -- basic_machine=`echo $1 | sed 's/-[^-]*$//'` -- if [ $basic_machine != $1 ] -- then os=`echo $1 | sed 's/.*-/-/'` -- else os=; fi -- ;; --esac -+# Split fields of configuration type -+# shellcheck disable=SC2162 -+IFS="-" read field1 field2 field3 field4 <&2 -+ exit 1 - ;; -- -ptx*) -- basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` -+ *-*-*-*) -+ basic_machine=$field1-$field2 -+ os=$field3-$field4 - ;; -- -windowsnt*) -- os=`echo $os | sed -e 's/windowsnt/winnt/'` -+ *-*-*) -+ # Ambiguous whether COMPANY is present, or skipped and KERNEL-OS is two -+ # parts -+ maybe_os=$field2-$field3 -+ case $maybe_os in -+ nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc \ -+ | linux-newlib* | linux-musl* | linux-uclibc* | uclinux-uclibc* \ -+ | uclinux-gnu* | kfreebsd*-gnu* | knetbsd*-gnu* | netbsd*-gnu* \ -+ | netbsd*-eabi* | kopensolaris*-gnu* | cloudabi*-eabi* \ -+ | storm-chaos* | os2-emx* | rtmk-nova*) -+ basic_machine=$field1 -+ os=$maybe_os -+ ;; -+ android-linux) -+ basic_machine=$field1-unknown -+ os=linux-android -+ ;; -+ *) -+ basic_machine=$field1-$field2 -+ os=$field3 -+ ;; -+ esac - ;; -- -psos*) -- os=-psos -+ *-*) -+ # A lone config we happen to match not fitting any pattern -+ case $field1-$field2 in -+ decstation-3100) -+ basic_machine=mips-dec -+ os= -+ ;; -+ *-*) -+ # Second component is usually, but not always the OS -+ case $field2 in -+ # Prevent following clause from handling this valid os -+ sun*os*) -+ basic_machine=$field1 -+ os=$field2 -+ ;; -+ # Manufacturers -+ dec* | mips* | sequent* | encore* | pc533* | sgi* | sony* \ -+ | att* | 7300* | 3300* | delta* | motorola* | sun[234]* \ -+ | unicom* | ibm* | next | hp | isi* | apollo | altos* \ -+ | convergent* | ncr* | news | 32* | 3600* | 3100* \ -+ | hitachi* | c[123]* | convex* | sun | crds | omron* | dg \ -+ | ultra | tti* | harris | dolphin | highlevel | gould \ -+ | cbm | ns | masscomp | apple | axis | knuth | cray \ -+ | microblaze* | sim | cisco \ -+ | oki | wec | wrs | winbond) -+ basic_machine=$field1-$field2 -+ os= -+ ;; -+ *) -+ basic_machine=$field1 -+ os=$field2 -+ ;; -+ esac -+ ;; -+ esac - ;; -- -mint | -mint[0-9]*) -- basic_machine=m68k-atari -- os=-mint -+ *) -+ # Convert single-component short-hands not valid as part of -+ # multi-component configurations. -+ case $field1 in -+ 386bsd) -+ basic_machine=i386-pc -+ os=bsd -+ ;; -+ a29khif) -+ basic_machine=a29k-amd -+ os=udi -+ ;; -+ adobe68k) -+ basic_machine=m68010-adobe -+ os=scout -+ ;; -+ alliant) -+ basic_machine=fx80-alliant -+ os= -+ ;; -+ altos | altos3068) -+ basic_machine=m68k-altos -+ os= -+ ;; -+ am29k) -+ basic_machine=a29k-none -+ os=bsd -+ ;; -+ amdahl) -+ basic_machine=580-amdahl -+ os=sysv -+ ;; -+ amiga) -+ basic_machine=m68k-unknown -+ os= -+ ;; -+ amigaos | amigados) -+ basic_machine=m68k-unknown -+ os=amigaos -+ ;; -+ amigaunix | amix) -+ basic_machine=m68k-unknown -+ os=sysv4 -+ ;; -+ apollo68) -+ basic_machine=m68k-apollo -+ os=sysv -+ ;; -+ apollo68bsd) -+ basic_machine=m68k-apollo -+ os=bsd -+ ;; -+ aros) -+ basic_machine=i386-pc -+ os=aros -+ ;; -+ aux) -+ basic_machine=m68k-apple -+ os=aux -+ ;; -+ balance) -+ basic_machine=ns32k-sequent -+ os=dynix -+ ;; -+ blackfin) -+ basic_machine=bfin-unknown -+ os=linux -+ ;; -+ cegcc) -+ basic_machine=arm-unknown -+ os=cegcc -+ ;; -+ convex-c1) -+ basic_machine=c1-convex -+ os=bsd -+ ;; -+ convex-c2) -+ basic_machine=c2-convex -+ os=bsd -+ ;; -+ convex-c32) -+ basic_machine=c32-convex -+ os=bsd -+ ;; -+ convex-c34) -+ basic_machine=c34-convex -+ os=bsd -+ ;; -+ convex-c38) -+ basic_machine=c38-convex -+ os=bsd -+ ;; -+ cray) -+ basic_machine=j90-cray -+ os=unicos -+ ;; -+ crds | unos) -+ basic_machine=m68k-crds -+ os= -+ ;; -+ da30) -+ basic_machine=m68k-da30 -+ os= -+ ;; -+ decstation | pmax | pmin | dec3100 | decstatn) -+ basic_machine=mips-dec -+ os= -+ ;; -+ delta88) -+ basic_machine=m88k-motorola -+ os=sysv3 -+ ;; -+ dicos) -+ basic_machine=i686-pc -+ os=dicos -+ ;; -+ djgpp) -+ basic_machine=i586-pc -+ os=msdosdjgpp -+ ;; -+ ebmon29k) -+ basic_machine=a29k-amd -+ os=ebmon -+ ;; -+ es1800 | OSE68k | ose68k | ose | OSE) -+ basic_machine=m68k-ericsson -+ os=ose -+ ;; -+ gmicro) -+ basic_machine=tron-gmicro -+ os=sysv -+ ;; -+ go32) -+ basic_machine=i386-pc -+ os=go32 -+ ;; -+ h8300hms) -+ basic_machine=h8300-hitachi -+ os=hms -+ ;; -+ h8300xray) -+ basic_machine=h8300-hitachi -+ os=xray -+ ;; -+ h8500hms) -+ basic_machine=h8500-hitachi -+ os=hms -+ ;; -+ harris) -+ basic_machine=m88k-harris -+ os=sysv3 -+ ;; -+ hp300) -+ basic_machine=m68k-hp -+ ;; -+ hp300bsd) -+ basic_machine=m68k-hp -+ os=bsd -+ ;; -+ hp300hpux) -+ basic_machine=m68k-hp -+ os=hpux -+ ;; -+ hppaosf) -+ basic_machine=hppa1.1-hp -+ os=osf -+ ;; -+ hppro) -+ basic_machine=hppa1.1-hp -+ os=proelf -+ ;; -+ i386mach) -+ basic_machine=i386-mach -+ os=mach -+ ;; -+ vsta) -+ basic_machine=i386-pc -+ os=vsta -+ ;; -+ isi68 | isi) -+ basic_machine=m68k-isi -+ os=sysv -+ ;; -+ m68knommu) -+ basic_machine=m68k-unknown -+ os=linux -+ ;; -+ magnum | m3230) -+ basic_machine=mips-mips -+ os=sysv -+ ;; -+ merlin) -+ basic_machine=ns32k-utek -+ os=sysv -+ ;; -+ mingw64) -+ basic_machine=x86_64-pc -+ os=mingw64 -+ ;; -+ mingw32) -+ basic_machine=i686-pc -+ os=mingw32 -+ ;; -+ mingw32ce) -+ basic_machine=arm-unknown -+ os=mingw32ce -+ ;; -+ monitor) -+ basic_machine=m68k-rom68k -+ os=coff -+ ;; -+ morphos) -+ basic_machine=powerpc-unknown -+ os=morphos -+ ;; -+ moxiebox) -+ basic_machine=moxie-unknown -+ os=moxiebox -+ ;; -+ msdos) -+ basic_machine=i386-pc -+ os=msdos -+ ;; -+ msys) -+ basic_machine=i686-pc -+ os=msys -+ ;; -+ mvs) -+ basic_machine=i370-ibm -+ os=mvs -+ ;; -+ nacl) -+ basic_machine=le32-unknown -+ os=nacl -+ ;; -+ ncr3000) -+ basic_machine=i486-ncr -+ os=sysv4 -+ ;; -+ netbsd386) -+ basic_machine=i386-pc -+ os=netbsd -+ ;; -+ netwinder) -+ basic_machine=armv4l-rebel -+ os=linux -+ ;; -+ news | news700 | news800 | news900) -+ basic_machine=m68k-sony -+ os=newsos -+ ;; -+ news1000) -+ basic_machine=m68030-sony -+ os=newsos -+ ;; -+ necv70) -+ basic_machine=v70-nec -+ os=sysv -+ ;; -+ nh3000) -+ basic_machine=m68k-harris -+ os=cxux -+ ;; -+ nh[45]000) -+ basic_machine=m88k-harris -+ os=cxux -+ ;; -+ nindy960) -+ basic_machine=i960-intel -+ os=nindy -+ ;; -+ mon960) -+ basic_machine=i960-intel -+ os=mon960 -+ ;; -+ nonstopux) -+ basic_machine=mips-compaq -+ os=nonstopux -+ ;; -+ os400) -+ basic_machine=powerpc-ibm -+ os=os400 -+ ;; -+ OSE68000 | ose68000) -+ basic_machine=m68000-ericsson -+ os=ose -+ ;; -+ os68k) -+ basic_machine=m68k-none -+ os=os68k -+ ;; -+ paragon) -+ basic_machine=i860-intel -+ os=osf -+ ;; -+ parisc) -+ basic_machine=hppa-unknown -+ os=linux -+ ;; -+ pw32) -+ basic_machine=i586-unknown -+ os=pw32 -+ ;; -+ rdos | rdos64) -+ basic_machine=x86_64-pc -+ os=rdos -+ ;; -+ rdos32) -+ basic_machine=i386-pc -+ os=rdos -+ ;; -+ rom68k) -+ basic_machine=m68k-rom68k -+ os=coff -+ ;; -+ sa29200) -+ basic_machine=a29k-amd -+ os=udi -+ ;; -+ sei) -+ basic_machine=mips-sei -+ os=seiux -+ ;; -+ sequent) -+ basic_machine=i386-sequent -+ os= -+ ;; -+ sps7) -+ basic_machine=m68k-bull -+ os=sysv2 -+ ;; -+ st2000) -+ basic_machine=m68k-tandem -+ os= -+ ;; -+ stratus) -+ basic_machine=i860-stratus -+ os=sysv4 -+ ;; -+ sun2) -+ basic_machine=m68000-sun -+ os= -+ ;; -+ sun2os3) -+ basic_machine=m68000-sun -+ os=sunos3 -+ ;; -+ sun2os4) -+ basic_machine=m68000-sun -+ os=sunos4 -+ ;; -+ sun3) -+ basic_machine=m68k-sun -+ os= -+ ;; -+ sun3os3) -+ basic_machine=m68k-sun -+ os=sunos3 -+ ;; -+ sun3os4) -+ basic_machine=m68k-sun -+ os=sunos4 -+ ;; -+ sun4) -+ basic_machine=sparc-sun -+ os= -+ ;; -+ sun4os3) -+ basic_machine=sparc-sun -+ os=sunos3 -+ ;; -+ sun4os4) -+ basic_machine=sparc-sun -+ os=sunos4 -+ ;; -+ sun4sol2) -+ basic_machine=sparc-sun -+ os=solaris2 -+ ;; -+ sun386 | sun386i | roadrunner) -+ basic_machine=i386-sun -+ os= -+ ;; -+ sv1) -+ basic_machine=sv1-cray -+ os=unicos -+ ;; -+ symmetry) -+ basic_machine=i386-sequent -+ os=dynix -+ ;; -+ t3e) -+ basic_machine=alphaev5-cray -+ os=unicos -+ ;; -+ t90) -+ basic_machine=t90-cray -+ os=unicos -+ ;; -+ toad1) -+ basic_machine=pdp10-xkl -+ os=tops20 -+ ;; -+ tpf) -+ basic_machine=s390x-ibm -+ os=tpf -+ ;; -+ udi29k) -+ basic_machine=a29k-amd -+ os=udi -+ ;; -+ ultra3) -+ basic_machine=a29k-nyu -+ os=sym1 -+ ;; -+ v810 | necv810) -+ basic_machine=v810-nec -+ os=none -+ ;; -+ vaxv) -+ basic_machine=vax-dec -+ os=sysv -+ ;; -+ vms) -+ basic_machine=vax-dec -+ os=vms -+ ;; -+ vxworks960) -+ basic_machine=i960-wrs -+ os=vxworks -+ ;; -+ vxworks68) -+ basic_machine=m68k-wrs -+ os=vxworks -+ ;; -+ vxworks29k) -+ basic_machine=a29k-wrs -+ os=vxworks -+ ;; -+ xbox) -+ basic_machine=i686-pc -+ os=mingw32 -+ ;; -+ ymp) -+ basic_machine=ymp-cray -+ os=unicos -+ ;; -+ *) -+ basic_machine=$1 -+ os= -+ ;; -+ esac - ;; - esac - --# Decode aliases for certain CPU-COMPANY combinations. -+# Decode 1-component or ad-hoc basic machines - case $basic_machine in -- # Recognize the basic CPU types without company name. -- # Some are omitted here because they have special meanings below. -- 1750a | 580 \ -- | a29k \ -- | aarch64 | aarch64_be \ -- | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ -- | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ -- | am33_2.0 \ -- | arc | arceb \ -- | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ -- | avr | avr32 \ -- | be32 | be64 \ -- | bfin \ -- | c4x | clipper \ -- | d10v | d30v | dlx | dsp16xx \ -- | epiphany \ -- | fido | fr30 | frv \ -- | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ -- | hexagon \ -- | i370 | i860 | i960 | ia64 \ -- | ip2k | iq2000 \ -- | le32 | le64 \ -- | lm32 \ -- | m32c | m32r | m32rle | m68000 | m68k | m88k \ -- | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ -- | mips | mipsbe | mipseb | mipsel | mipsle \ -- | mips16 \ -- | mips64 | mips64el \ -- | mips64octeon | mips64octeonel \ -- | mips64orion | mips64orionel \ -- | mips64r5900 | mips64r5900el \ -- | mips64vr | mips64vrel \ -- | mips64vr4100 | mips64vr4100el \ -- | mips64vr4300 | mips64vr4300el \ -- | mips64vr5000 | mips64vr5000el \ -- | mips64vr5900 | mips64vr5900el \ -- | mipsisa32 | mipsisa32el \ -- | mipsisa32r2 | mipsisa32r2el \ -- | mipsisa64 | mipsisa64el \ -- | mipsisa64r2 | mipsisa64r2el \ -- | mipsisa64sb1 | mipsisa64sb1el \ -- | mipsisa64sr71k | mipsisa64sr71kel \ -- | mipsr5900 | mipsr5900el \ -- | mipstx39 | mipstx39el \ -- | mn10200 | mn10300 \ -- | moxie \ -- | mt \ -- | msp430 \ -- | nds32 | nds32le | nds32be \ -- | nios | nios2 | nios2eb | nios2el \ -- | ns16k | ns32k \ -- | open8 \ -- | or1k | or32 \ -- | pdp10 | pdp11 | pj | pjl \ -- | powerpc | powerpc64 | powerpc64le | powerpcle \ -- | pyramid \ -- | rl78 | rx \ -- | score \ -- | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ -- | sh64 | sh64le \ -- | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ -- | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ -- | spu \ -- | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ -- | ubicom32 \ -- | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ -- | we32k \ -- | x86 | xc16x | xstormy16 | xtensa \ -- | z8k | z80) -- basic_machine=$basic_machine-unknown -- ;; -- c54x) -- basic_machine=tic54x-unknown -- ;; -- c55x) -- basic_machine=tic55x-unknown -- ;; -- c6x) -- basic_machine=tic6x-unknown -- ;; -- m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | picochip) -- basic_machine=$basic_machine-unknown -- os=-none -- ;; -- m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) -- ;; -- ms1) -- basic_machine=mt-unknown -+ # Here we handle the default manufacturer of certain CPU types. It is in -+ # some cases the only manufacturer, in others, it is the most popular. -+ w89k) -+ cpu=hppa1.1 -+ vendor=winbond - ;; -- -- strongarm | thumb | xscale) -- basic_machine=arm-unknown -+ op50n) -+ cpu=hppa1.1 -+ vendor=oki - ;; -- xgate) -- basic_machine=$basic_machine-unknown -- os=-none -+ op60c) -+ cpu=hppa1.1 -+ vendor=oki - ;; -- xscaleeb) -- basic_machine=armeb-unknown -+ ibm*) -+ cpu=i370 -+ vendor=ibm - ;; -- -- xscaleel) -- basic_machine=armel-unknown -+ orion105) -+ cpu=clipper -+ vendor=highlevel - ;; -- -- # We use `pc' rather than `unknown' -- # because (1) that's what they normally are, and -- # (2) the word "unknown" tends to confuse beginning users. -- i*86 | x86_64) -- basic_machine=$basic_machine-pc -- ;; -- # Object if more than one company name word. -- *-*-*) -- echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 -- exit 1 -+ mac | mpw | mac-mpw) -+ cpu=m68k -+ vendor=apple - ;; -- # Recognize the basic CPU types with company name. -- 580-* \ -- | a29k-* \ -- | aarch64-* | aarch64_be-* \ -- | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ -- | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ -- | alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \ -- | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ -- | avr-* | avr32-* \ -- | be32-* | be64-* \ -- | bfin-* | bs2000-* \ -- | c[123]* | c30-* | [cjt]90-* | c4x-* \ -- | clipper-* | craynv-* | cydra-* \ -- | d10v-* | d30v-* | dlx-* \ -- | elxsi-* \ -- | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ -- | h8300-* | h8500-* \ -- | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ -- | hexagon-* \ -- | i*86-* | i860-* | i960-* | ia64-* \ -- | ip2k-* | iq2000-* \ -- | le32-* | le64-* \ -- | lm32-* \ -- | m32c-* | m32r-* | m32rle-* \ -- | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ -- | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ -- | microblaze-* | microblazeel-* \ -- | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ -- | mips16-* \ -- | mips64-* | mips64el-* \ -- | mips64octeon-* | mips64octeonel-* \ -- | mips64orion-* | mips64orionel-* \ -- | mips64r5900-* | mips64r5900el-* \ -- | mips64vr-* | mips64vrel-* \ -- | mips64vr4100-* | mips64vr4100el-* \ -- | mips64vr4300-* | mips64vr4300el-* \ -- | mips64vr5000-* | mips64vr5000el-* \ -- | mips64vr5900-* | mips64vr5900el-* \ -- | mipsisa32-* | mipsisa32el-* \ -- | mipsisa32r2-* | mipsisa32r2el-* \ -- | mipsisa64-* | mipsisa64el-* \ -- | mipsisa64r2-* | mipsisa64r2el-* \ -- | mipsisa64sb1-* | mipsisa64sb1el-* \ -- | mipsisa64sr71k-* | mipsisa64sr71kel-* \ -- | mipsr5900-* | mipsr5900el-* \ -- | mipstx39-* | mipstx39el-* \ -- | mmix-* \ -- | mt-* \ -- | msp430-* \ -- | nds32-* | nds32le-* | nds32be-* \ -- | nios-* | nios2-* | nios2eb-* | nios2el-* \ -- | none-* | np1-* | ns16k-* | ns32k-* \ -- | open8-* \ -- | orion-* \ -- | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ -- | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ -- | pyramid-* \ -- | rl78-* | romp-* | rs6000-* | rx-* \ -- | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ -- | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ -- | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ -- | sparclite-* \ -- | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ -- | tahoe-* \ -- | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ -- | tile*-* \ -- | tron-* \ -- | ubicom32-* \ -- | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ -- | vax-* \ -- | we32k-* \ -- | x86-* | x86_64-* | xc16x-* | xps100-* \ -- | xstormy16-* | xtensa*-* \ -- | ymp-* \ -- | z8k-* | z80-*) -- ;; -- # Recognize the basic CPU types without company name, with glob match. -- xtensa*) -- basic_machine=$basic_machine-unknown -+ pmac | pmac-mpw) -+ cpu=powerpc -+ vendor=apple - ;; -+ - # Recognize the various machine names and aliases which stand - # for a CPU type and a company and sometimes even an OS. -- 386bsd) -- basic_machine=i386-unknown -- os=-bsd -- ;; - 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) -- basic_machine=m68000-att -+ cpu=m68000 -+ vendor=att - ;; - 3b*) -- basic_machine=we32k-att -- ;; -- a29khif) -- basic_machine=a29k-amd -- os=-udi -- ;; -- abacus) -- basic_machine=abacus-unknown -- ;; -- adobe68k) -- basic_machine=m68010-adobe -- os=-scout -- ;; -- alliant | fx80) -- basic_machine=fx80-alliant -- ;; -- altos | altos3068) -- basic_machine=m68k-altos -- ;; -- am29k) -- basic_machine=a29k-none -- os=-bsd -- ;; -- amd64) -- basic_machine=x86_64-pc -- ;; -- amd64-*) -- basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` -- ;; -- amdahl) -- basic_machine=580-amdahl -- os=-sysv -- ;; -- amiga | amiga-*) -- basic_machine=m68k-unknown -- ;; -- amigaos | amigados) -- basic_machine=m68k-unknown -- os=-amigaos -- ;; -- amigaunix | amix) -- basic_machine=m68k-unknown -- os=-sysv4 -- ;; -- apollo68) -- basic_machine=m68k-apollo -- os=-sysv -- ;; -- apollo68bsd) -- basic_machine=m68k-apollo -- os=-bsd -- ;; -- aros) -- basic_machine=i386-pc -- os=-aros -- ;; -- aux) -- basic_machine=m68k-apple -- os=-aux -- ;; -- balance) -- basic_machine=ns32k-sequent -- os=-dynix -- ;; -- blackfin) -- basic_machine=bfin-unknown -- os=-linux -- ;; -- blackfin-*) -- basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` -- os=-linux -+ cpu=we32k -+ vendor=att - ;; - bluegene*) -- basic_machine=powerpc-ibm -- os=-cnk -- ;; -- c54x-*) -- basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` -- ;; -- c55x-*) -- basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` -- ;; -- c6x-*) -- basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` -- ;; -- c90) -- basic_machine=c90-cray -- os=-unicos -- ;; -- cegcc) -- basic_machine=arm-unknown -- os=-cegcc -- ;; -- convex-c1) -- basic_machine=c1-convex -- os=-bsd -- ;; -- convex-c2) -- basic_machine=c2-convex -- os=-bsd -- ;; -- convex-c32) -- basic_machine=c32-convex -- os=-bsd -- ;; -- convex-c34) -- basic_machine=c34-convex -- os=-bsd -- ;; -- convex-c38) -- basic_machine=c38-convex -- os=-bsd -- ;; -- cray | j90) -- basic_machine=j90-cray -- os=-unicos -- ;; -- craynv) -- basic_machine=craynv-cray -- os=-unicosmp -- ;; -- cr16 | cr16-*) -- basic_machine=cr16-unknown -- os=-elf -- ;; -- crds | unos) -- basic_machine=m68k-crds -- ;; -- crisv32 | crisv32-* | etraxfs*) -- basic_machine=crisv32-axis -- ;; -- cris | cris-* | etrax*) -- basic_machine=cris-axis -- ;; -- crx) -- basic_machine=crx-unknown -- os=-elf -- ;; -- da30 | da30-*) -- basic_machine=m68k-da30 -- ;; -- decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) -- basic_machine=mips-dec -+ cpu=powerpc -+ vendor=ibm -+ os=cnk - ;; - decsystem10* | dec10*) -- basic_machine=pdp10-dec -- os=-tops10 -+ cpu=pdp10 -+ vendor=dec -+ os=tops10 - ;; - decsystem20* | dec20*) -- basic_machine=pdp10-dec -- os=-tops20 -+ cpu=pdp10 -+ vendor=dec -+ os=tops20 - ;; - delta | 3300 | motorola-3300 | motorola-delta \ - | 3300-motorola | delta-motorola) -- basic_machine=m68k-motorola -- ;; -- delta88) -- basic_machine=m88k-motorola -- os=-sysv3 -- ;; -- dicos) -- basic_machine=i686-pc -- os=-dicos -+ cpu=m68k -+ vendor=motorola - ;; -- djgpp) -- basic_machine=i586-pc -- os=-msdosdjgpp -- ;; -- dpx20 | dpx20-*) -- basic_machine=rs6000-bull -- os=-bosx -- ;; -- dpx2* | dpx2*-bull) -- basic_machine=m68k-bull -- os=-sysv3 -- ;; -- ebmon29k) -- basic_machine=a29k-amd -- os=-ebmon -- ;; -- elxsi) -- basic_machine=elxsi-elxsi -- os=-bsd -+ dpx2*) -+ cpu=m68k -+ vendor=bull -+ os=sysv3 - ;; - encore | umax | mmax) -- basic_machine=ns32k-encore -+ cpu=ns32k -+ vendor=encore - ;; -- es1800 | OSE68k | ose68k | ose | OSE) -- basic_machine=m68k-ericsson -- os=-ose -+ elxsi) -+ cpu=elxsi -+ vendor=elxsi -+ os=${os:-bsd} - ;; - fx2800) -- basic_machine=i860-alliant -+ cpu=i860 -+ vendor=alliant - ;; - genix) -- basic_machine=ns32k-ns -- ;; -- gmicro) -- basic_machine=tron-gmicro -- os=-sysv -- ;; -- go32) -- basic_machine=i386-pc -- os=-go32 -+ cpu=ns32k -+ vendor=ns - ;; - h3050r* | hiux*) -- basic_machine=hppa1.1-hitachi -- os=-hiuxwe2 -- ;; -- h8300hms) -- basic_machine=h8300-hitachi -- os=-hms -- ;; -- h8300xray) -- basic_machine=h8300-hitachi -- os=-xray -- ;; -- h8500hms) -- basic_machine=h8500-hitachi -- os=-hms -- ;; -- harris) -- basic_machine=m88k-harris -- os=-sysv3 -- ;; -- hp300-*) -- basic_machine=m68k-hp -- ;; -- hp300bsd) -- basic_machine=m68k-hp -- os=-bsd -- ;; -- hp300hpux) -- basic_machine=m68k-hp -- os=-hpux -+ cpu=hppa1.1 -+ vendor=hitachi -+ os=hiuxwe2 - ;; - hp3k9[0-9][0-9] | hp9[0-9][0-9]) -- basic_machine=hppa1.0-hp -+ cpu=hppa1.0 -+ vendor=hp - ;; - hp9k2[0-9][0-9] | hp9k31[0-9]) -- basic_machine=m68000-hp -+ cpu=m68000 -+ vendor=hp - ;; - hp9k3[2-9][0-9]) -- basic_machine=m68k-hp -+ cpu=m68k -+ vendor=hp - ;; - hp9k6[0-9][0-9] | hp6[0-9][0-9]) -- basic_machine=hppa1.0-hp -+ cpu=hppa1.0 -+ vendor=hp - ;; - hp9k7[0-79][0-9] | hp7[0-79][0-9]) -- basic_machine=hppa1.1-hp -+ cpu=hppa1.1 -+ vendor=hp - ;; - hp9k78[0-9] | hp78[0-9]) - # FIXME: really hppa2.0-hp -- basic_machine=hppa1.1-hp -+ cpu=hppa1.1 -+ vendor=hp - ;; - hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) - # FIXME: really hppa2.0-hp -- basic_machine=hppa1.1-hp -+ cpu=hppa1.1 -+ vendor=hp - ;; - hp9k8[0-9][13679] | hp8[0-9][13679]) -- basic_machine=hppa1.1-hp -+ cpu=hppa1.1 -+ vendor=hp - ;; - hp9k8[0-9][0-9] | hp8[0-9][0-9]) -- basic_machine=hppa1.0-hp -- ;; -- hppa-next) -- os=-nextstep3 -- ;; -- hppaosf) -- basic_machine=hppa1.1-hp -- os=-osf -- ;; -- hppro) -- basic_machine=hppa1.1-hp -- os=-proelf -- ;; -- i370-ibm* | ibm*) -- basic_machine=i370-ibm -+ cpu=hppa1.0 -+ vendor=hp - ;; - i*86v32) -- basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` -- os=-sysv32 -+ cpu=`echo "$1" | sed -e 's/86.*/86/'` -+ vendor=pc -+ os=sysv32 - ;; - i*86v4*) -- basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` -- os=-sysv4 -+ cpu=`echo "$1" | sed -e 's/86.*/86/'` -+ vendor=pc -+ os=sysv4 - ;; - i*86v) -- basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` -- os=-sysv -+ cpu=`echo "$1" | sed -e 's/86.*/86/'` -+ vendor=pc -+ os=sysv - ;; - i*86sol2) -- basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` -- os=-solaris2 -+ cpu=`echo "$1" | sed -e 's/86.*/86/'` -+ vendor=pc -+ os=solaris2 - ;; -- i386mach) -- basic_machine=i386-mach -- os=-mach -- ;; -- i386-vsta | vsta) -- basic_machine=i386-unknown -- os=-vsta -+ j90 | j90-cray) -+ cpu=j90 -+ vendor=cray -+ os=${os:-unicos} - ;; - iris | iris4d) -- basic_machine=mips-sgi -+ cpu=mips -+ vendor=sgi - case $os in -- -irix*) -+ irix*) - ;; - *) -- os=-irix4 -+ os=irix4 - ;; - esac - ;; -- isi68 | isi) -- basic_machine=m68k-isi -- os=-sysv -- ;; -- m68knommu) -- basic_machine=m68k-unknown -- os=-linux -- ;; -- m68knommu-*) -- basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` -- os=-linux -- ;; -- m88k-omron*) -- basic_machine=m88k-omron -- ;; -- magnum | m3230) -- basic_machine=mips-mips -- os=-sysv -- ;; -- merlin) -- basic_machine=ns32k-utek -- os=-sysv -- ;; -- microblaze*) -- basic_machine=microblaze-xilinx -- ;; -- mingw64) -- basic_machine=x86_64-pc -- os=-mingw64 -- ;; -- mingw32) -- basic_machine=i386-pc -- os=-mingw32 -- ;; -- mingw32ce) -- basic_machine=arm-unknown -- os=-mingw32ce -- ;; - miniframe) -- basic_machine=m68000-convergent -- ;; -- *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) -- basic_machine=m68k-atari -- os=-mint -- ;; -- mips3*-*) -- basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` -- ;; -- mips3*) -- basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown -- ;; -- monitor) -- basic_machine=m68k-rom68k -- os=-coff -- ;; -- morphos) -- basic_machine=powerpc-unknown -- os=-morphos -- ;; -- msdos) -- basic_machine=i386-pc -- os=-msdos -- ;; -- ms1-*) -- basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` -- ;; -- msys) -- basic_machine=i386-pc -- os=-msys -- ;; -- mvs) -- basic_machine=i370-ibm -- os=-mvs -- ;; -- nacl) -- basic_machine=le32-unknown -- os=-nacl -- ;; -- ncr3000) -- basic_machine=i486-ncr -- os=-sysv4 -+ cpu=m68000 -+ vendor=convergent - ;; -- netbsd386) -- basic_machine=i386-unknown -- os=-netbsd -- ;; -- netwinder) -- basic_machine=armv4l-rebel -- os=-linux -- ;; -- news | news700 | news800 | news900) -- basic_machine=m68k-sony -- os=-newsos -- ;; -- news1000) -- basic_machine=m68030-sony -- os=-newsos -+ *mint | mint[0-9]* | *MiNT | *MiNT[0-9]*) -+ cpu=m68k -+ vendor=atari -+ os=mint - ;; - news-3600 | risc-news) -- basic_machine=mips-sony -- os=-newsos -- ;; -- necv70) -- basic_machine=v70-nec -- os=-sysv -+ cpu=mips -+ vendor=sony -+ os=newsos - ;; -- next | m*-next ) -- basic_machine=m68k-next -+ next | m*-next) -+ cpu=m68k -+ vendor=next - case $os in -- -nextstep* ) -+ nextstep* ) - ;; -- -ns2*) -- os=-nextstep2 -+ ns2*) -+ os=nextstep2 - ;; - *) -- os=-nextstep3 -+ os=nextstep3 - ;; - esac - ;; -- nh3000) -- basic_machine=m68k-harris -- os=-cxux -- ;; -- nh[45]000) -- basic_machine=m88k-harris -- os=-cxux -- ;; -- nindy960) -- basic_machine=i960-intel -- os=-nindy -- ;; -- mon960) -- basic_machine=i960-intel -- os=-mon960 -- ;; -- nonstopux) -- basic_machine=mips-compaq -- os=-nonstopux -- ;; - np1) -- basic_machine=np1-gould -- ;; -- neo-tandem) -- basic_machine=neo-tandem -- ;; -- nse-tandem) -- basic_machine=nse-tandem -- ;; -- nsr-tandem) -- basic_machine=nsr-tandem -+ cpu=np1 -+ vendor=gould - ;; - op50n-* | op60c-*) -- basic_machine=hppa1.1-oki -- os=-proelf -- ;; -- openrisc | openrisc-*) -- basic_machine=or32-unknown -- ;; -- os400) -- basic_machine=powerpc-ibm -- os=-os400 -- ;; -- OSE68000 | ose68000) -- basic_machine=m68000-ericsson -- os=-ose -- ;; -- os68k) -- basic_machine=m68k-none -- os=-os68k -+ cpu=hppa1.1 -+ vendor=oki -+ os=proelf - ;; - pa-hitachi) -- basic_machine=hppa1.1-hitachi -- os=-hiuxwe2 -- ;; -- paragon) -- basic_machine=i860-intel -- os=-osf -- ;; -- parisc) -- basic_machine=hppa-unknown -- os=-linux -- ;; -- parisc-*) -- basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` -- os=-linux -+ cpu=hppa1.1 -+ vendor=hitachi -+ os=hiuxwe2 - ;; - pbd) -- basic_machine=sparc-tti -+ cpu=sparc -+ vendor=tti - ;; - pbb) -- basic_machine=m68k-tti -- ;; -- pc532 | pc532-*) -- basic_machine=ns32k-pc532 -- ;; -- pc98) -- basic_machine=i386-pc -+ cpu=m68k -+ vendor=tti - ;; -- pc98-*) -- basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` -- ;; -- pentium | p5 | k5 | k6 | nexgen | viac3) -- basic_machine=i586-pc -- ;; -- pentiumpro | p6 | 6x86 | athlon | athlon_*) -- basic_machine=i686-pc -- ;; -- pentiumii | pentium2 | pentiumiii | pentium3) -- basic_machine=i686-pc -- ;; -- pentium4) -- basic_machine=i786-pc -- ;; -- pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) -- basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` -- ;; -- pentiumpro-* | p6-* | 6x86-* | athlon-*) -- basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` -- ;; -- pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) -- basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` -- ;; -- pentium4-*) -- basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` -+ pc532) -+ cpu=ns32k -+ vendor=pc532 - ;; - pn) -- basic_machine=pn-gould -- ;; -- power) basic_machine=power-ibm -+ cpu=pn -+ vendor=gould - ;; -- ppc | ppcbe) basic_machine=powerpc-unknown -- ;; -- ppc-* | ppcbe-*) -- basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` -- ;; -- ppcle | powerpclittle | ppc-le | powerpc-little) -- basic_machine=powerpcle-unknown -- ;; -- ppcle-* | powerpclittle-*) -- basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` -- ;; -- ppc64) basic_machine=powerpc64-unknown -- ;; -- ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` -- ;; -- ppc64le | powerpc64little | ppc64-le | powerpc64-little) -- basic_machine=powerpc64le-unknown -- ;; -- ppc64le-* | powerpc64little-*) -- basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` -+ power) -+ cpu=power -+ vendor=ibm - ;; - ps2) -- basic_machine=i386-ibm -- ;; -- pw32) -- basic_machine=i586-unknown -- os=-pw32 -- ;; -- rdos | rdos64) -- basic_machine=x86_64-pc -- os=-rdos -- ;; -- rdos32) -- basic_machine=i386-pc -- os=-rdos -- ;; -- rom68k) -- basic_machine=m68k-rom68k -- os=-coff -+ cpu=i386 -+ vendor=ibm - ;; - rm[46]00) -- basic_machine=mips-siemens -+ cpu=mips -+ vendor=siemens - ;; - rtpc | rtpc-*) -- basic_machine=romp-ibm -- ;; -- s390 | s390-*) -- basic_machine=s390-ibm -- ;; -- s390x | s390x-*) -- basic_machine=s390x-ibm -- ;; -- sa29200) -- basic_machine=a29k-amd -- os=-udi -+ cpu=romp -+ vendor=ibm - ;; -- sb1) -- basic_machine=mipsisa64sb1-unknown -+ sde) -+ cpu=mipsisa32 -+ vendor=sde -+ os=${os:-elf} - ;; -- sb1el) -- basic_machine=mipsisa64sb1el-unknown -+ simso-wrs) -+ cpu=sparclite -+ vendor=wrs -+ os=vxworks - ;; -- sde) -- basic_machine=mipsisa32-sde -- os=-elf -+ tower | tower-32) -+ cpu=m68k -+ vendor=ncr - ;; -- sei) -- basic_machine=mips-sei -- os=-seiux -+ vpp*|vx|vx-*) -+ cpu=f301 -+ vendor=fujitsu - ;; -- sequent) -- basic_machine=i386-sequent -+ w65) -+ cpu=w65 -+ vendor=wdc - ;; -- sh) -- basic_machine=sh-hitachi -- os=-hms -+ w89k-*) -+ cpu=hppa1.1 -+ vendor=winbond -+ os=proelf - ;; -- sh5el) -- basic_machine=sh5le-unknown -+ none) -+ cpu=none -+ vendor=none - ;; -- sh64) -- basic_machine=sh64-unknown -+ leon|leon[3-9]) -+ cpu=sparc -+ vendor=$basic_machine - ;; -- sparclite-wrs | simso-wrs) -- basic_machine=sparclite-wrs -- os=-vxworks -+ leon-*|leon[3-9]-*) -+ cpu=sparc -+ vendor=`echo "$basic_machine" | sed 's/-.*//'` - ;; -- sps7) -- basic_machine=m68k-bull -- os=-sysv2 -+ -+ *-*) -+ # shellcheck disable=SC2162 -+ IFS="-" read cpu vendor <&2 -- exit 1 -+ # Recognize the canonical CPU types that are allowed with any -+ # company name. -+ case $cpu in -+ 1750a | 580 \ -+ | a29k \ -+ | aarch64 | aarch64_be \ -+ | abacus \ -+ | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] \ -+ | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] \ -+ | alphapca5[67] | alpha64pca5[67] \ -+ | am33_2.0 \ -+ | amdgcn \ -+ | arc | arceb \ -+ | arm | arm[lb]e | arme[lb] | armv* \ -+ | avr | avr32 \ -+ | asmjs \ -+ | ba \ -+ | be32 | be64 \ -+ | bfin | bs2000 \ -+ | c[123]* | c30 | [cjt]90 | c4x \ -+ | c8051 | clipper | craynv | csky | cydra \ -+ | d10v | d30v | dlx | dsp16xx \ -+ | e2k | elxsi | epiphany \ -+ | f30[01] | f700 | fido | fr30 | frv | ft32 | fx80 \ -+ | h8300 | h8500 \ -+ | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ -+ | hexagon \ -+ | i370 | i*86 | i860 | i960 | ia16 | ia64 \ -+ | ip2k | iq2000 \ -+ | k1om \ -+ | le32 | le64 \ -+ | lm32 \ -+ | m32c | m32r | m32rle \ -+ | m5200 | m68000 | m680[012346]0 | m68360 | m683?2 | m68k \ -+ | m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x \ -+ | m88110 | m88k | maxq | mb | mcore | mep | metag \ -+ | microblaze | microblazeel \ -+ | mips | mipsbe | mipseb | mipsel | mipsle \ -+ | mips16 \ -+ | mips64 | mips64eb | mips64el \ -+ | mips64octeon | mips64octeonel \ -+ | mips64orion | mips64orionel \ -+ | mips64r5900 | mips64r5900el \ -+ | mips64vr | mips64vrel \ -+ | mips64vr4100 | mips64vr4100el \ -+ | mips64vr4300 | mips64vr4300el \ -+ | mips64vr5000 | mips64vr5000el \ -+ | mips64vr5900 | mips64vr5900el \ -+ | mipsisa32 | mipsisa32el \ -+ | mipsisa32r2 | mipsisa32r2el \ -+ | mipsisa32r6 | mipsisa32r6el \ -+ | mipsisa64 | mipsisa64el \ -+ | mipsisa64r2 | mipsisa64r2el \ -+ | mipsisa64r6 | mipsisa64r6el \ -+ | mipsisa64sb1 | mipsisa64sb1el \ -+ | mipsisa64sr71k | mipsisa64sr71kel \ -+ | mipsr5900 | mipsr5900el \ -+ | mipstx39 | mipstx39el \ -+ | mmix \ -+ | mn10200 | mn10300 \ -+ | moxie \ -+ | mt \ -+ | msp430 \ -+ | nds32 | nds32le | nds32be \ -+ | nfp \ -+ | nios | nios2 | nios2eb | nios2el \ -+ | none | np1 | ns16k | ns32k | nvptx \ -+ | open8 \ -+ | or1k* \ -+ | or32 \ -+ | orion \ -+ | picochip \ -+ | pdp10 | pdp11 | pj | pjl | pn | power \ -+ | powerpc | powerpc64 | powerpc64le | powerpcle | powerpcspe \ -+ | pru \ -+ | pyramid \ -+ | riscv | riscv32 | riscv64 \ -+ | rl78 | romp | rs6000 | rx \ -+ | score \ -+ | sh | shl \ -+ | sh[1234] | sh[24]a | sh[24]ae[lb] | sh[23]e | she[lb] | sh[lb]e \ -+ | sh[1234]e[lb] | sh[12345][lb]e | sh[23]ele | sh64 | sh64le \ -+ | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet \ -+ | sparclite \ -+ | sparcv8 | sparcv9 | sparcv9b | sparcv9v | sv1 | sx* \ -+ | spu \ -+ | tahoe \ -+ | tic30 | tic4x | tic54x | tic55x | tic6x | tic80 \ -+ | tron \ -+ | ubicom32 \ -+ | v70 | v850 | v850e | v850e1 | v850es | v850e2 | v850e2v3 \ -+ | vax \ -+ | visium \ -+ | w65 | wasm32 \ -+ | we32k \ -+ | x86 | x86_64 | xc16x | xgate | xps100 \ -+ | xstormy16 | xtensa* \ -+ | ymp \ -+ | z8k | z80) -+ ;; -+ -+ *) -+ echo Invalid configuration \`"$1"\': machine \`"$cpu-$vendor"\' not recognized 1>&2 -+ exit 1 -+ ;; -+ esac - ;; - esac - - # Here we canonicalize certain aliases for manufacturers. --case $basic_machine in -- *-digital*) -- basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` -+case $vendor in -+ digital*) -+ vendor=dec - ;; -- *-commodore*) -- basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` -+ commodore*) -+ vendor=cbm - ;; - *) - ;; -@@ -1321,197 +1275,246 @@ esac - - # Decode manufacturer-specific aliases for certain operating systems. - --if [ x"$os" != x"" ] -+if [ x$os != x ] - then - case $os in -- # First match some system type aliases -- # that might get confused with valid system types. -- # -solaris* is a basic system type, with this one exception. -- -auroraux) -- os=-auroraux -+ # First match some system type aliases that might get confused -+ # with valid system types. -+ # solaris* is a basic system type, with this one exception. -+ auroraux) -+ os=auroraux - ;; -- -solaris1 | -solaris1.*) -- os=`echo $os | sed -e 's|solaris1|sunos4|'` -+ bluegene*) -+ os=cnk - ;; -- -solaris) -- os=-solaris2 -+ solaris1 | solaris1.*) -+ os=`echo $os | sed -e 's|solaris1|sunos4|'` - ;; -- -svr4*) -- os=-sysv4 -+ solaris) -+ os=solaris2 - ;; -- -unixware*) -- os=-sysv4.2uw -+ unixware*) -+ os=sysv4.2uw - ;; -- -gnu/linux*) -+ gnu/linux*) - os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` - ;; -- # First accept the basic system types. -+ # es1800 is here to avoid being matched by es* (a different OS) -+ es1800*) -+ os=ose -+ ;; -+ # Some version numbers need modification -+ chorusos*) -+ os=chorusos -+ ;; -+ isc) -+ os=isc2.2 -+ ;; -+ sco6) -+ os=sco5v6 -+ ;; -+ sco5) -+ os=sco3.2v5 -+ ;; -+ sco4) -+ os=sco3.2v4 -+ ;; -+ sco3.2.[4-9]*) -+ os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` -+ ;; -+ sco3.2v[4-9]* | sco5v6*) -+ # Don't forget version if it is 3.2v4 or newer. -+ ;; -+ scout) -+ # Don't match below -+ ;; -+ sco*) -+ os=sco3.2v2 -+ ;; -+ psos*) -+ os=psos -+ ;; -+ # Now accept the basic system types. - # The portable systems comes first. -- # Each alternative MUST END IN A *, to match a version number. -- # -sysv* is not here because it comes later, after sysvr4. -- -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ -- | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ -- | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ -- | -sym* | -kopensolaris* | -plan9* \ -- | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ -- | -aos* | -aros* \ -- | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ -- | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ -- | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ -- | -bitrig* | -openbsd* | -solidbsd* \ -- | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ -- | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ -- | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ -- | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ -- | -chorusos* | -chorusrdb* | -cegcc* \ -- | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ -- | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ -- | -linux-newlib* | -linux-musl* | -linux-uclibc* \ -- | -uxpv* | -beos* | -mpeix* | -udk* \ -- | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ -- | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ -- | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ -- | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ -- | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ -- | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ -- | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es*) -+ # Each alternative MUST end in a * to match a version number. -+ # sysv* is not here because it comes later, after sysvr4. -+ gnu* | bsd* | mach* | minix* | genix* | ultrix* | irix* \ -+ | *vms* | esix* | aix* | cnk* | sunos | sunos[34]*\ -+ | hpux* | unos* | osf* | luna* | dgux* | auroraux* | solaris* \ -+ | sym* | kopensolaris* | plan9* \ -+ | amigaos* | amigados* | msdos* | newsos* | unicos* | aof* \ -+ | aos* | aros* | cloudabi* | sortix* \ -+ | nindy* | vxsim* | vxworks* | ebmon* | hms* | mvs* \ -+ | clix* | riscos* | uniplus* | iris* | isc* | rtu* | xenix* \ -+ | knetbsd* | mirbsd* | netbsd* \ -+ | bitrig* | openbsd* | solidbsd* | libertybsd* \ -+ | ekkobsd* | kfreebsd* | freebsd* | riscix* | lynxos* \ -+ | bosx* | nextstep* | cxux* | aout* | elf* | oabi* \ -+ | ptx* | coff* | ecoff* | winnt* | domain* | vsta* \ -+ | udi* | eabi* | lites* | ieee* | go32* | aux* | hcos* \ -+ | chorusrdb* | cegcc* | glidix* \ -+ | cygwin* | msys* | pe* | moss* | proelf* | rtems* \ -+ | midipix* | mingw32* | mingw64* | linux-gnu* | linux-android* \ -+ | linux-newlib* | linux-musl* | linux-uclibc* \ -+ | uxpv* | beos* | mpeix* | udk* | moxiebox* \ -+ | interix* | uwin* | mks* | rhapsody* | darwin* \ -+ | openstep* | oskit* | conix* | pw32* | nonstopux* \ -+ | storm-chaos* | tops10* | tenex* | tops20* | its* \ -+ | os2* | vos* | palmos* | uclinux* | nucleus* \ -+ | morphos* | superux* | rtmk* | windiss* \ -+ | powermax* | dnix* | nx6 | nx7 | sei* | dragonfly* \ -+ | skyos* | haiku* | rdos* | toppers* | drops* | es* \ -+ | onefs* | tirtos* | phoenix* | fuchsia* | redox* | bme* \ -+ | midnightbsd* | amdhsa* | unleashed* | emscripten*) - # Remember, each alternative MUST END IN *, to match a version number. - ;; -- -qnx*) -- case $basic_machine in -- x86-* | i*86-*) -+ qnx*) -+ case $cpu in -+ x86 | i*86) - ;; - *) -- os=-nto$os -+ os=nto-$os - ;; - esac - ;; -- -nto-qnx*) -+ hiux*) -+ os=hiuxwe2 - ;; -- -nto*) -- os=`echo $os | sed -e 's|nto|nto-qnx|'` -+ nto-qnx*) - ;; -- -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ -- | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ -- | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) -+ nto*) -+ os=`echo $os | sed -e 's|nto|nto-qnx|'` - ;; -- -mac*) -- os=`echo $os | sed -e 's|mac|macos|'` -+ sim | xray | os68k* | v88r* \ -+ | windows* | osx | abug | netware* | os9* \ -+ | macos* | mpw* | magic* | mmixware* | mon960* | lnews*) - ;; -- -linux-dietlibc) -- os=-linux-dietlibc -+ linux-dietlibc) -+ os=linux-dietlibc - ;; -- -linux*) -+ linux*) - os=`echo $os | sed -e 's|linux|linux-gnu|'` - ;; -- -sunos5*) -- os=`echo $os | sed -e 's|sunos5|solaris2|'` -+ lynx*178) -+ os=lynxos178 -+ ;; -+ lynx*5) -+ os=lynxos5 - ;; -- -sunos6*) -- os=`echo $os | sed -e 's|sunos6|solaris3|'` -+ lynx*) -+ os=lynxos - ;; -- -opened*) -- os=-openedition -+ mac*) -+ os=`echo "$os" | sed -e 's|mac|macos|'` - ;; -- -os400*) -- os=-os400 -+ opened*) -+ os=openedition - ;; -- -wince*) -- os=-wince -+ os400*) -+ os=os400 - ;; -- -osfrose*) -- os=-osfrose -+ sunos5*) -+ os=`echo "$os" | sed -e 's|sunos5|solaris2|'` - ;; -- -osf*) -- os=-osf -+ sunos6*) -+ os=`echo "$os" | sed -e 's|sunos6|solaris3|'` - ;; -- -utek*) -- os=-bsd -+ wince*) -+ os=wince - ;; -- -dynix*) -- os=-bsd -+ utek*) -+ os=bsd - ;; -- -acis*) -- os=-aos -+ dynix*) -+ os=bsd - ;; -- -atheos*) -- os=-atheos -+ acis*) -+ os=aos - ;; -- -syllable*) -- os=-syllable -+ atheos*) -+ os=atheos - ;; -- -386bsd) -- os=-bsd -+ syllable*) -+ os=syllable - ;; -- -ctix* | -uts*) -- os=-sysv -+ 386bsd) -+ os=bsd - ;; -- -nova*) -- os=-rtmk-nova -+ ctix* | uts*) -+ os=sysv - ;; -- -ns2 ) -- os=-nextstep2 -+ nova*) -+ os=rtmk-nova - ;; -- -nsk*) -- os=-nsk -+ ns2) -+ os=nextstep2 -+ ;; -+ nsk*) -+ os=nsk - ;; - # Preserve the version number of sinix5. -- -sinix5.*) -+ sinix5.*) - os=`echo $os | sed -e 's|sinix|sysv|'` - ;; -- -sinix*) -- os=-sysv4 -+ sinix*) -+ os=sysv4 - ;; -- -tpf*) -- os=-tpf -+ tpf*) -+ os=tpf - ;; -- -triton*) -- os=-sysv3 -+ triton*) -+ os=sysv3 - ;; -- -oss*) -- os=-sysv3 -+ oss*) -+ os=sysv3 - ;; -- -svr4) -- os=-sysv4 -+ svr4*) -+ os=sysv4 - ;; -- -svr3) -- os=-sysv3 -+ svr3) -+ os=sysv3 - ;; -- -sysvr4) -- os=-sysv4 -+ sysvr4) -+ os=sysv4 - ;; -- # This must come after -sysvr4. -- -sysv*) -+ # This must come after sysvr4. -+ sysv*) - ;; -- -ose*) -- os=-ose -+ ose*) -+ os=ose - ;; -- -es1800*) -- os=-ose -+ *mint | mint[0-9]* | *MiNT | MiNT[0-9]*) -+ os=mint - ;; -- -xenix) -- os=-xenix -+ zvmoe) -+ os=zvmoe - ;; -- -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) -- os=-mint -+ dicos*) -+ os=dicos - ;; -- -aros*) -- os=-aros -+ pikeos*) -+ # Until real need of OS specific support for -+ # particular features comes up, bare metal -+ # configurations are quite functional. -+ case $cpu in -+ arm*) -+ os=eabi -+ ;; -+ *) -+ os=elf -+ ;; -+ esac - ;; -- -zvmoe) -- os=-zvmoe -+ nacl*) - ;; -- -dicos*) -- os=-dicos -+ ios) - ;; -- -nacl*) -+ none) - ;; -- -none) -+ *-eabi) - ;; - *) -- # Get rid of the `-' at the beginning of $os. -- os=`echo $os | sed 's/[^-]*-//'` -- echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 -+ echo Invalid configuration \`"$1"\': system \`"$os"\' not recognized 1>&2 - exit 1 - ;; - esac -@@ -1527,261 +1530,265 @@ else - # will signal an error saying that MANUFACTURER isn't an operating - # system, and we'll never get to this point. - --case $basic_machine in -+case $cpu-$vendor in - score-*) -- os=-elf -+ os=elf - ;; - spu-*) -- os=-elf -+ os=elf - ;; - *-acorn) -- os=-riscix1.2 -+ os=riscix1.2 - ;; - arm*-rebel) -- os=-linux -+ os=linux - ;; - arm*-semi) -- os=-aout -+ os=aout - ;; - c4x-* | tic4x-*) -- os=-coff -+ os=coff -+ ;; -+ c8051-*) -+ os=elf -+ ;; -+ clipper-intergraph) -+ os=clix - ;; - hexagon-*) -- os=-elf -+ os=elf - ;; - tic54x-*) -- os=-coff -+ os=coff - ;; - tic55x-*) -- os=-coff -+ os=coff - ;; - tic6x-*) -- os=-coff -+ os=coff - ;; - # This must come before the *-dec entry. - pdp10-*) -- os=-tops20 -+ os=tops20 - ;; - pdp11-*) -- os=-none -+ os=none - ;; - *-dec | vax-*) -- os=-ultrix4.2 -+ os=ultrix4.2 - ;; - m68*-apollo) -- os=-domain -+ os=domain - ;; - i386-sun) -- os=-sunos4.0.2 -+ os=sunos4.0.2 - ;; - m68000-sun) -- os=-sunos3 -+ os=sunos3 - ;; - m68*-cisco) -- os=-aout -+ os=aout - ;; - mep-*) -- os=-elf -+ os=elf - ;; - mips*-cisco) -- os=-elf -+ os=elf - ;; - mips*-*) -- os=-elf -- ;; -- or1k-*) -- os=-elf -+ os=elf - ;; - or32-*) -- os=-coff -+ os=coff - ;; - *-tti) # must be before sparc entry or we get the wrong os. -- os=-sysv3 -+ os=sysv3 - ;; - sparc-* | *-sun) -- os=-sunos4.1.1 -+ os=sunos4.1.1 - ;; -- *-be) -- os=-beos -+ pru-*) -+ os=elf - ;; -- *-haiku) -- os=-haiku -+ *-be) -+ os=beos - ;; - *-ibm) -- os=-aix -+ os=aix - ;; - *-knuth) -- os=-mmixware -+ os=mmixware - ;; - *-wec) -- os=-proelf -+ os=proelf - ;; - *-winbond) -- os=-proelf -+ os=proelf - ;; - *-oki) -- os=-proelf -+ os=proelf - ;; - *-hp) -- os=-hpux -+ os=hpux - ;; - *-hitachi) -- os=-hiux -+ os=hiux - ;; - i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) -- os=-sysv -+ os=sysv - ;; - *-cbm) -- os=-amigaos -+ os=amigaos - ;; - *-dg) -- os=-dgux -+ os=dgux - ;; - *-dolphin) -- os=-sysv3 -+ os=sysv3 - ;; - m68k-ccur) -- os=-rtu -+ os=rtu - ;; - m88k-omron*) -- os=-luna -+ os=luna - ;; -- *-next ) -- os=-nextstep -+ *-next) -+ os=nextstep - ;; - *-sequent) -- os=-ptx -+ os=ptx - ;; - *-crds) -- os=-unos -+ os=unos - ;; - *-ns) -- os=-genix -+ os=genix - ;; - i370-*) -- os=-mvs -- ;; -- *-next) -- os=-nextstep3 -+ os=mvs - ;; - *-gould) -- os=-sysv -+ os=sysv - ;; - *-highlevel) -- os=-bsd -+ os=bsd - ;; - *-encore) -- os=-bsd -+ os=bsd - ;; - *-sgi) -- os=-irix -+ os=irix - ;; - *-siemens) -- os=-sysv4 -+ os=sysv4 - ;; - *-masscomp) -- os=-rtu -+ os=rtu - ;; - f30[01]-fujitsu | f700-fujitsu) -- os=-uxpv -+ os=uxpv - ;; - *-rom68k) -- os=-coff -+ os=coff - ;; - *-*bug) -- os=-coff -+ os=coff - ;; - *-apple) -- os=-macos -+ os=macos - ;; - *-atari*) -- os=-mint -+ os=mint -+ ;; -+ *-wrs) -+ os=vxworks - ;; - *) -- os=-none -+ os=none - ;; - esac - fi - - # Here we handle the case where we know the os, and the CPU type, but not the - # manufacturer. We pick the logical manufacturer. --vendor=unknown --case $basic_machine in -- *-unknown) -+case $vendor in -+ unknown) - case $os in -- -riscix*) -+ riscix*) - vendor=acorn - ;; -- -sunos*) -+ sunos*) - vendor=sun - ;; -- -cnk*|-aix*) -+ cnk*|-aix*) - vendor=ibm - ;; -- -beos*) -+ beos*) - vendor=be - ;; -- -hpux*) -+ hpux*) - vendor=hp - ;; -- -mpeix*) -+ mpeix*) - vendor=hp - ;; -- -hiux*) -+ hiux*) - vendor=hitachi - ;; -- -unos*) -+ unos*) - vendor=crds - ;; -- -dgux*) -+ dgux*) - vendor=dg - ;; -- -luna*) -+ luna*) - vendor=omron - ;; -- -genix*) -+ genix*) - vendor=ns - ;; -- -mvs* | -opened*) -+ clix*) -+ vendor=intergraph -+ ;; -+ mvs* | opened*) - vendor=ibm - ;; -- -os400*) -+ os400*) - vendor=ibm - ;; -- -ptx*) -+ ptx*) - vendor=sequent - ;; -- -tpf*) -+ tpf*) - vendor=ibm - ;; -- -vxsim* | -vxworks* | -windiss*) -+ vxsim* | vxworks* | windiss*) - vendor=wrs - ;; -- -aux*) -+ aux*) - vendor=apple - ;; -- -hms*) -+ hms*) - vendor=hitachi - ;; -- -mpw* | -macos*) -+ mpw* | macos*) - vendor=apple - ;; -- -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) -+ *mint | mint[0-9]* | *MiNT | MiNT[0-9]*) - vendor=atari - ;; -- -vos*) -+ vos*) - vendor=stratus - ;; - esac -- basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` - ;; - esac - --echo $basic_machine$os -+echo "$cpu-$vendor-$os" - exit - - # Local variables: --# eval: (add-hook 'write-file-hooks 'time-stamp) -+# eval: (add-hook 'before-save-hook 'time-stamp) - # time-stamp-start: "timestamp='" - # time-stamp-format: "%:y-%02m-%02d" - # time-stamp-end: "'" -diff --git a/configure b/configure -index 9a78a4554..00bb37bae 100755 ---- a/configure -+++ b/configure -@@ -13415,6 +13415,8 @@ fi ;; #( - natdynlink=true ;; #( - aarch64-*-linux*) : - natdynlink=true ;; #( -+ riscv*-*-linux*) : -+ natdynlink=true ;; #( - *) : - ;; - esac -@@ -13545,7 +13547,11 @@ fi; system=elf ;; #( - aarch64-*-linux*) : - arch=arm64; system=linux ;; #( - x86_64-*-cygwin*) : -- arch=amd64; system=cygwin -+ arch=amd64; system=cygwin ;; #( -+ riscv32-*-linux*) : -+ arch=riscv; model=riscv32; system=linux ;; #( -+ riscv64-*-linux*) : -+ arch=riscv; model=riscv64; system=linux - ;; #( - *) : - ;; -@@ -13801,7 +13807,7 @@ esac ;; #( - *,freebsd) : - default_as="${toolpref}as" - default_aspp="${toolpref}cc -c" ;; #( -- amd64,*|arm,*|arm64,*|i386,*|power,bsd*|power,netbsd) : -+ amd64,*|arm,*|arm64,*|i386,*|power,bsd*|power,netbsd|riscv,*) : - default_as="${toolpref}as" - case $ocaml_cv_cc_vendor in #( - clang-*) : -diff --git a/configure.ac b/configure.ac -index 2227769e8..94b7e2b35 100644 ---- a/configure.ac -+++ b/configure.ac -@@ -803,7 +803,8 @@ AS_IF([test x"$enable_shared" != "xno"], - [arm*-*-linux*], [natdynlink=true], - [arm*-*-freebsd*], [natdynlink=true], - [earm*-*-netbsd*], [natdynlink=true], -- [aarch64-*-linux*], [natdynlink=true])]) -+ [aarch64-*-linux*], [natdynlink=true], -+ [riscv*-*-linux*], [natdynlink=true])]) - - # Try to work around the Skylake/Kaby Lake processor bug. - AS_CASE(["$CC,$host"], -@@ -898,7 +899,11 @@ AS_CASE([$host], - [aarch64-*-linux*], - [arch=arm64; system=linux], - [x86_64-*-cygwin*], -- [arch=amd64; system=cygwin] -+ [arch=amd64; system=cygwin], -+ [riscv32-*-linux*], -+ [arch=riscv; model=riscv32; system=linux], -+ [riscv64-*-linux*], -+ [arch=riscv; model=riscv64; system=linux] - ) - - AS_IF([test x"$enable_native_compiler" = "xno"], -@@ -1008,7 +1013,7 @@ AS_CASE(["$arch,$system"], - [*,freebsd], - [default_as="${toolpref}as" - default_aspp="${toolpref}cc -c"], -- [amd64,*|arm,*|arm64,*|i386,*|power,bsd*|power,netbsd], -+ [amd64,*|arm,*|arm64,*|i386,*|power,bsd*|power,netbsd|riscv,*], - [default_as="${toolpref}as" - AS_CASE([$ocaml_cv_cc_vendor], - [clang-*], [default_aspp="${toolpref}clang -c -Wno-trigraphs"], -diff --git a/runtime/caml/stack.h b/runtime/caml/stack.h -index 0c4aab159..f2fdec554 100644 ---- a/runtime/caml/stack.h -+++ b/runtime/caml/stack.h -@@ -70,6 +70,11 @@ - #define Callback_link(sp) ((struct caml_context *)((sp) + 16)) - #endif - -+#ifdef TARGET_riscv /* FIXME FIXME */ -+#define Saved_return_address(sp) *((intnat *)((sp) - 8)) -+#define Callback_link(sp) ((struct caml_context *)((sp) + 16)) -+#endif -+ - /* Structure of OCaml callback contexts */ - - struct caml_context { -diff --git a/runtime/riscv.S b/runtime/riscv.S -new file mode 100644 -index 000000000..d7e4e2d83 ---- /dev/null -+++ b/runtime/riscv.S -@@ -0,0 +1,424 @@ -+/***********************************************************************/ -+/* */ -+/* OCaml */ -+/* */ -+/* Nicolas Ojeda Bar */ -+/* */ -+/* Copyright 2017 Institut National de Recherche en Informatique et */ -+/* en Automatique. All rights reserved. This file is distributed */ -+/* under the terms of the GNU Library General Public License, with */ -+/* the special exception on linking described in file ../LICENSE. */ -+/* */ -+/***********************************************************************/ -+ -+/* Asm part of the runtime system, RISC-V processor, 64-bit mode */ -+/* Must be preprocessed by cpp */ -+ -+#define TRAP_PTR s1 -+#define ALLOC_PTR s10 -+#define ALLOC_LIMIT s11 -+#define TMP0 t0 -+#define TMP1 t1 -+#define ARG t2 -+ -+#if defined(MODEL_riscv64) -+#define store sd -+#define load ld -+#define WSZ 8 -+#else -+#define store sw -+#define load lw -+#define WSZ 4 -+#endif -+ -+#if defined(__PIC__) -+ .option pic -+#else -+ .option nopic -+#endif -+ -+ .section .text -+/* Invoke the garbage collector. */ -+ -+ .globl caml_system__code_begin -+caml_system__code_begin: -+ -+ .align 4 -+ .globl caml_call_gc -+ .type caml_call_gc, @function -+caml_call_gc: -+ /* Record return address */ -+ store ra, caml_last_return_address, TMP0 -+ /* Record lowest stack address */ -+ mv TMP1, sp -+ store sp, caml_bottom_of_stack, TMP0 -+.Lcaml_call_gc: -+ /* Set up stack space, saving return address */ -+ /* (1 reg for RA, 1 reg for FP, 21 allocatable int regs, 20 caller-save float regs) * 8 */ -+ /* + 1 for alignment */ -+ addi sp, sp, -0x160 -+ mv s0, sp -+ store ra, 0x8(sp) -+ store s0, 0x0(sp) -+ /* Save allocatable integer registers on the stack, -+ in the order given in proc.ml */ -+ store a0, 0x10(sp) -+ store a1, 0x18(sp) -+ store a2, 0x20(sp) -+ store a3, 0x28(sp) -+ store a4, 0x30(sp) -+ store a5, 0x38(sp) -+ store a6, 0x40(sp) -+ store a7, 0x48(sp) -+ store s2, 0x50(sp) -+ store s3, 0x58(sp) -+ store s4, 0x60(sp) -+ store s5, 0x68(sp) -+ store s6, 0x70(sp) -+ store s7, 0x78(sp) -+ store s8, 0x80(sp) -+ store s9, 0x88(sp) -+ store t2, 0x90(sp) -+ store t3, 0x98(sp) -+ store t4, 0xa0(sp) -+ store t5, 0xa8(sp) -+ store t6, 0xb0(sp) -+ /* Save caller-save floating-point registers on the stack -+ (callee-saves are preserved by caml_garbage_collection) */ -+ fsd ft0, 0xb8(sp) -+ fsd ft1, 0xc0(sp) -+ fsd ft2, 0xc8(sp) -+ fsd ft3, 0xd0(sp) -+ fsd ft4, 0xd8(sp) -+ fsd ft5, 0xe0(sp) -+ fsd ft6, 0xe8(sp) -+ fsd ft7, 0xf0(sp) -+ fsd fa0, 0xf8(sp) -+ fsd fa1, 0x100(sp) -+ fsd fa2, 0x108(sp) -+ fsd fa3, 0x110(sp) -+ fsd fa4, 0x118(sp) -+ fsd fa5, 0x120(sp) -+ fsd fa6, 0x128(sp) -+ fsd fa7, 0x130(sp) -+ fsd ft8, 0x138(sp) -+ fsd ft9, 0x140(sp) -+ fsd ft9, 0x148(sp) -+ fsd ft10, 0x150(sp) -+ fsd ft11, 0x158(sp) -+ /* Store pointer to saved integer registers in caml_gc_regs */ -+ addi TMP1, sp, 16 -+ store TMP1, caml_gc_regs, TMP0 -+ /* Save current allocation pointer for debugging purposes */ -+ store ALLOC_PTR, caml_young_ptr, TMP0 -+ /* Save trap pointer in case an exception is raised during GC */ -+ store TRAP_PTR, caml_exception_pointer, TMP0 -+ /* Call the garbage collector */ -+ call caml_garbage_collection -+ /* Restore registers */ -+ load a0, 0x10(sp) -+ load a1, 0x18(sp) -+ load a2, 0x20(sp) -+ load a3, 0x28(sp) -+ load a4, 0x30(sp) -+ load a5, 0x38(sp) -+ load a6, 0x40(sp) -+ load a7, 0x48(sp) -+ load s2, 0x50(sp) -+ load s3, 0x58(sp) -+ load s4, 0x60(sp) -+ load s5, 0x68(sp) -+ load s6, 0x70(sp) -+ load s7, 0x78(sp) -+ load s8, 0x80(sp) -+ load s9, 0x88(sp) -+ load t2, 0x90(sp) -+ load t3, 0x98(sp) -+ load t4, 0xa0(sp) -+ load t5, 0xa8(sp) -+ load t6, 0xb0(sp) -+ fld ft0, 0xb8(sp) -+ fld ft1, 0xc0(sp) -+ fld ft2, 0xc8(sp) -+ fld ft3, 0xd0(sp) -+ fld ft4, 0xd8(sp) -+ fld ft5, 0xe0(sp) -+ fld ft6, 0xe8(sp) -+ fld ft7, 0xf0(sp) -+ fld fa0, 0xf8(sp) -+ fld fa1, 0x100(sp) -+ fld fa2, 0x108(sp) -+ fld fa3, 0x110(sp) -+ fld fa4, 0x118(sp) -+ fld fa5, 0x120(sp) -+ fld fa6, 0x128(sp) -+ fld fa7, 0x130(sp) -+ fld ft8, 0x138(sp) -+ fld ft9, 0x140(sp) -+ fld ft9, 0x148(sp) -+ fld ft10, 0x150(sp) -+ fld ft11, 0x158(sp) -+ /* Reload new allocation pointer and allocation limit */ -+ load ALLOC_PTR, caml_young_ptr -+ load ALLOC_LIMIT, caml_young_limit -+ /* Free stack space and return to caller */ -+ load ra, 0x8(sp) -+ load s0, 0x0(sp) -+ addi sp, sp, 0x160 -+ ret -+ .size caml_call_gc, .-caml_call_gc -+ -+/* Call a C function from OCaml */ -+/* Function to call is in ARG */ -+ -+ .align 4 -+ .globl caml_c_call -+ .type caml_c_call, @function -+caml_c_call: -+ /* Preserve return address in callee-save register s2 */ -+ mv s2, ra -+ /* Record lowest stack address and return address */ -+ store ra, caml_last_return_address, TMP0 -+ store sp, caml_bottom_of_stack, TMP0 -+ /* Make the exception handler alloc ptr available to the C code */ -+ store ALLOC_PTR, caml_young_ptr, TMP0 -+ store TRAP_PTR, caml_exception_pointer, TMP0 -+ /* Call the function */ -+ jalr ARG -+ /* Reload alloc ptr and alloc limit */ -+ load ALLOC_PTR, caml_young_ptr -+ load ALLOC_LIMIT, caml_young_limit -+ /* Return */ -+ jr s2 -+ .size caml_c_call, .-caml_c_call -+ -+/* Raise an exception from OCaml */ -+ .align 4 -+ .globl caml_raise_exn -+ .type caml_raise_exn, @function -+caml_raise_exn: -+ /* Test if backtrace is active */ -+ load TMP1, caml_backtrace_active -+ bnez TMP1, 2f -+1: /* Cut stack at current trap handler */ -+ mv sp, TRAP_PTR -+ /* Pop previous handler and jump to it */ -+ load TMP1, 8(sp) -+ load TRAP_PTR, 0(sp) -+ addi sp, sp, 16 -+ jr TMP1 -+2: /* Preserve exception bucket in callee-save register s2 */ -+ mv s2, a0 -+ /* Stash the backtrace */ -+ mv a1, ra -+ mv a2, sp -+ mv a3, TRAP_PTR -+ call caml_stash_backtrace -+ /* Restore exception bucket and raise */ -+ mv a0, s2 -+ j 1b -+ .size caml_raise_exn, .-caml_raise_exn -+ -+ .globl caml_reraise_exn -+ .type caml_reraise_exn, @function -+ -+/* Raise an exception from C */ -+ -+ .align 4 -+ .globl caml_raise_exception -+ .type caml_raise_exception, @function -+caml_raise_exception: -+ load TRAP_PTR, caml_exception_pointer -+ load ALLOC_PTR, caml_young_ptr -+ load ALLOC_LIMIT, caml_young_limit -+ load TMP1, caml_backtrace_active -+ bnez TMP1, 2f -+1: /* Cut stack at current trap handler */ -+ mv sp, TRAP_PTR -+ load TMP1, 8(sp) -+ load TRAP_PTR, 0(sp) -+ addi sp, sp, 16 -+ jr TMP1 -+2: /* Preserve exception bucket in callee-save register s2 */ -+ mv s2, a0 -+ load a1, caml_last_return_address -+ load a2, caml_bottom_of_stack -+ mv a3, TRAP_PTR -+ call caml_stash_backtrace -+ mv a0, s2 -+ j 1b -+ .size caml_raise_exception, .-caml_raise_exception -+ -+/* Start the OCaml program */ -+ -+ .align 4 -+ .globl caml_start_program -+ .type caml_start_program, @function -+caml_start_program: -+ -+ la ARG, caml_program -+ /* Code shared with caml_callback* */ -+ /* Address of OCaml code to call is in ARG */ -+ /* Arguments to the OCaml code are in a0 ... a7 */ -+.Ljump_to_caml: -+ /* Set up stack frame and save callee-save registers */ -+ addi sp, sp, -0xd0 -+ store ra, 0xc0(sp) -+ store s0, 0x0(sp) -+ store s1, 0x8(sp) -+ store s2, 0x10(sp) -+ store s3, 0x18(sp) -+ store s4, 0x20(sp) -+ store s5, 0x28(sp) -+ store s6, 0x30(sp) -+ store s7, 0x38(sp) -+ store s8, 0x40(sp) -+ store s9, 0x48(sp) -+ store s10, 0x50(sp) -+ store s11, 0x58(sp) -+ fsd fs0, 0x60(sp) -+ fsd fs1, 0x68(sp) -+ fsd fs2, 0x70(sp) -+ fsd fs3, 0x78(sp) -+ fsd fs4, 0x80(sp) -+ fsd fs5, 0x88(sp) -+ fsd fs6, 0x90(sp) -+ fsd fs7, 0x98(sp) -+ fsd fs8, 0xa0(sp) -+ fsd fs9, 0xa8(sp) -+ fsd fs10, 0xb0(sp) -+ fsd fs11, 0xb8(sp) -+ addi sp, sp, -32 -+ /* Setup a callback link on the stack */ -+ load TMP1, caml_bottom_of_stack -+ store TMP1, 0(sp) -+ load TMP1, caml_last_return_address -+ store TMP1, 8(sp) -+ load TMP1, caml_gc_regs -+ store TMP1, 16(sp) -+ /* set up a trap frame */ -+ addi sp, sp, -16 -+ load TMP1, caml_exception_pointer -+ store TMP1, 0(sp) -+ lla TMP0, .Ltrap_handler -+ store TMP0, 8(sp) -+ mv TRAP_PTR, sp -+ load ALLOC_PTR, caml_young_ptr -+ load ALLOC_LIMIT, caml_young_limit -+ store x0, caml_last_return_address, TMP0 -+ jalr ARG -+.Lcaml_retaddr: /* pop trap frame, restoring caml_exception_pointer */ -+ load TMP1, 0(sp) -+ store TMP1, caml_exception_pointer, TMP0 -+ addi sp, sp, 16 -+.Lreturn_result: /* pop callback link, restoring global variables */ -+ load TMP1, 0(sp) -+ store TMP1, caml_bottom_of_stack, TMP0 -+ load TMP1, 8(sp) -+ store TMP1, caml_last_return_address, TMP0 -+ load TMP1, 16(sp) -+ store TMP1, caml_gc_regs, TMP0 -+ addi sp, sp, 32 -+ /* Update allocation pointer */ -+ store ALLOC_PTR, caml_young_ptr, TMP0 -+ /* reload callee-save registers and return */ -+ load ra, 0xc0(sp) -+ load s0, 0x0(sp) -+ load s1, 0x8(sp) -+ load s2, 0x10(sp) -+ load s3, 0x18(sp) -+ load s4, 0x20(sp) -+ load s5, 0x28(sp) -+ load s6, 0x30(sp) -+ load s7, 0x38(sp) -+ load s8, 0x40(sp) -+ load s9, 0x48(sp) -+ load s10, 0x50(sp) -+ load s11, 0x58(sp) -+ fld fs0, 0x60(sp) -+ fld fs1, 0x68(sp) -+ fld fs2, 0x70(sp) -+ fld fs3, 0x78(sp) -+ fld fs4, 0x80(sp) -+ fld fs5, 0x88(sp) -+ fld fs6, 0x90(sp) -+ fld fs7, 0x98(sp) -+ fld fs8, 0xa0(sp) -+ fld fs9, 0xa8(sp) -+ fld fs10, 0xb0(sp) -+ fld fs11, 0xb8(sp) -+ addi sp, sp, 0xd0 -+ ret -+.Ltrap_handler: -+ store TRAP_PTR, caml_exception_pointer, TMP0 -+ ori a0, a0, 2 -+ j .Lreturn_result -+ .size caml_start_program, .-caml_start_program -+ -+/* Callback from C to OCaml */ -+ -+ .align 4 -+ .globl caml_callback_exn -+ .type caml_callback_exn, @function -+caml_callback_exn: -+ /* Initial shuffling of arguments (a0 = closure, a1 = first arg) */ -+ mv TMP1, a0 -+ mv a0, a1 /* a0 = first arg */ -+ mv a1, TMP1 /* a1 = closure environment */ -+ load ARG, 0(TMP1) /* code pointer */ -+ j .Ljump_to_caml -+ .size caml_callback_exn, .-caml_callback_exn -+ -+ .align 4 -+ .globl caml_callback2_exn -+ .type caml_callback2_exn, @function -+caml_callback2_exn: -+ /* Initial shuffling of arguments (a0 = closure, a1 = arg1, a2 = arg2) */ -+ mv TMP1, a0 -+ mv a0, a1 -+ mv a1, a2 -+ mv a2, TMP1 -+ la ARG, caml_apply2 -+ j .Ljump_to_caml -+ .size caml_callback2_exn, .-caml_callback2_exn -+ -+ .align 4 -+ .globl caml_callback3_exn -+ .type caml_callback3_exn, @function -+caml_callback3_exn: -+ /* Initial shuffling of argumnets */ -+ /* (a0 = closure, a1 = arg1, a2 = arg2, a3 = arg3) */ -+ mv TMP1, a0 -+ mv a0, a1 -+ mv a1, a2 -+ mv a2, a3 -+ mv a3, TMP1 -+ la ARG, caml_apply3 -+ j .Ljump_to_caml -+ .size caml_callback3_exn, .-caml_callback3_exn -+ -+ .align 4 -+ .globl caml_ml_array_bound_error -+ .type caml_ml_array_bound_error, @function -+caml_ml_array_bound_error: -+ /* Load address of [caml_array_bound_error] in ARG */ -+ la ARG, caml_array_bound_error -+ /* Call that function */ -+ j caml_c_call -+ -+ .globl caml_system__code_end -+caml_system__code_end: -+ -+/* GC roots for callback */ -+ -+ .section .data -+ .align 3 -+ .globl caml_system__frametable -+ .type caml_system__frametable, @object -+caml_system__frametable: -+ .quad 1 /* one descriptor */ -+ .quad .Lcaml_retaddr /* return address into callback */ -+ .short -1 /* negative frame size => use callback link */ -+ .short 0 /* no roots */ -+ .align 3 -+ .size caml_system__frametable, .-caml_system__frametable --- -2.22.0.rc3 - diff --git a/0004-Merge-pull-request-8979-from-gasche-fix-Makefile.men.patch b/0004-Merge-pull-request-8979-from-gasche-fix-Makefile.men.patch new file mode 100644 index 0000000..db2e66e --- /dev/null +++ b/0004-Merge-pull-request-8979-from-gasche-fix-Makefile.men.patch @@ -0,0 +1,102 @@ +From 987e819b8fb8e36e660340931270a2ade02c439e Mon Sep 17 00:00:00 2001 +From: Gabriel Scherer +Date: Thu, 26 Sep 2019 21:46:03 +0200 +Subject: [PATCH 04/12] Merge pull request #8979 from + gasche/fix-Makefile.menhir + +Fix tools/check-parser-uptodate-or-warn.sh + +(cherry picked from commit f075ab6fdeedc8d53ececd1184d69a1cc35c0fd5) +--- + Changes | 3 +++ + Makefile | 6 +++--- + tools/check-parser-uptodate-or-warn.sh | 21 +++++++++++++++++---- + 3 files changed, 23 insertions(+), 7 deletions(-) + +diff --git a/Changes b/Changes +index 355cb1a94..63cac3ef9 100644 +--- a/Changes ++++ b/Changes +@@ -5,6 +5,9 @@ OCaml 4.09 maintenance branch: + dummy locations + (Armaël Guéneau, review by Gabriel Scherer) + ++- #8965, #8979: Alpine build failure caused by check-parser-uptodate-or-warn.sh ++ (Gabriel Scherer and David Allsopp, report by Anton Kochkov) ++ + OCaml 4.09.0 (19 September 2019): + --------------------------------- + +diff --git a/Makefile b/Makefile +index 47548c79d..7ac446f62 100644 +--- a/Makefile ++++ b/Makefile +@@ -1076,10 +1076,10 @@ parsing/camlinternalMenhirLib.mli: boot/menhir/menhirLib.mli + + parsing/parser.ml: boot/menhir/parser.ml parsing/parser.mly \ + tools/check-parser-uptodate-or-warn.sh +- @tools/check-parser-uptodate-or-warn.sh +- cat $< | sed "s/MenhirLib/CamlinternalMenhirLib/g" > $@ ++ @-tools/check-parser-uptodate-or-warn.sh ++ sed "s/MenhirLib/CamlinternalMenhirLib/g" $< > $@ + parsing/parser.mli: boot/menhir/parser.mli +- cat $< | sed "s/MenhirLib/CamlinternalMenhirLib/g" > $@ ++ sed "s/MenhirLib/CamlinternalMenhirLib/g" $< > $@ + + + partialclean:: partialclean-menhir +diff --git a/tools/check-parser-uptodate-or-warn.sh b/tools/check-parser-uptodate-or-warn.sh +index 5502eae54..2f07619a6 100755 +--- a/tools/check-parser-uptodate-or-warn.sh ++++ b/tools/check-parser-uptodate-or-warn.sh +@@ -15,6 +15,9 @@ + #* * + #************************************************************************** + ++# stop early if we are not on a development version ++grep -Fq '+dev' VERSION || exit 0 ++ + # We try to warn if the user edits parsing/parser.mly but forgets to + # rebuild the generated parser. Our heuristic is to use the file + # modification timestamp, but just testing +@@ -24,15 +27,20 @@ + # seconds after boot/menhir/parser.ml. + + # mtime(): access a file's last modification time as a timestamp, +-# using either GNU coreutils' stat --format, or BSD/macos stat -f. ++# using either ++# GNU coreutils' stat --format, or ++# busybox's stat -c, or ++# BSD/macOS stat -f. + # Default to 0 if 'stat' is not available. + + stat . 2>/dev/null 1>/dev/null + if test $? != 0 + then MTIME="" +-elif test -n "$(stat --version 2>/dev/null | grep coreutils)" ++elif stat --version 2>/dev/null | grep -Fq 'coreutils' + then MTIME="stat --format %Y" +-else MTIME="stat -f %m" ++elif stat 2>&1 | grep -Fq 'busybox' ++then MTIME="stat -c %Y" ++else MTIME="stat -f %m" # BSD stat? + fi + + mtime() { +@@ -45,7 +53,12 @@ mtime() { + # The check itself + SOURCE_MTIME=$(mtime parsing/parser.mly) + GENERATED_MTIME=$(mtime boot/menhir/parser.ml) +-if test $SOURCE_MTIME -gt $(( $GENERATED_MTIME + 10 )) ++if test -z "$SOURCE_MTIME" -o -z "$GENERATED_MTIME" ++then ++ echo ++ tput setaf 3; tput bold; printf "Warning: "; tput sgr0 ++ echo "Failed to check if boot/menhir/parser.ml is up-to-date." ++elif test "$SOURCE_MTIME" -gt $(( GENERATED_MTIME + 10 )) + then + echo + tput setaf 3; tput bold; printf "Warning: "; tput sgr0 +-- +2.23.0 + diff --git a/0005-Run-whole-of-gen_primitives.sh-with-LC_ALL-C.patch b/0005-Run-whole-of-gen_primitives.sh-with-LC_ALL-C.patch new file mode 100644 index 0000000..4865a5b --- /dev/null +++ b/0005-Run-whole-of-gen_primitives.sh-with-LC_ALL-C.patch @@ -0,0 +1,51 @@ +From 3ef8ce701db0a010771c62171fc7ae355214ed05 Mon Sep 17 00:00:00 2001 +From: David Allsopp +Date: Thu, 26 Sep 2019 13:51:08 +0100 +Subject: [PATCH 05/12] Run whole of gen_primitives.sh with LC_ALL=C + +Fixes #8985. Assuming the locale has been generated, running +LC_COLLATE=sv_SE.UTF-8 make world failed previously since the w +character is not matched in [a-z] in this locale. +--- + Changes | 4 ++++ + runtime/gen_primitives.sh | 5 ++++- + 2 files changed, 8 insertions(+), 1 deletion(-) + +diff --git a/Changes b/Changes +index 63cac3ef9..257a75e3d 100644 +--- a/Changes ++++ b/Changes +@@ -8,6 +8,10 @@ OCaml 4.09 maintenance branch: + - #8965, #8979: Alpine build failure caused by check-parser-uptodate-or-warn.sh + (Gabriel Scherer and David Allsopp, report by Anton Kochkov) + ++- #8985, #8986: fix generation of the primitives when the locale collation is ++ incompatible with C. ++ (David Allsopp, review by Nicolás Ojeda Bär, report by Sebastian Rasmussen) ++ + OCaml 4.09.0 (19 September 2019): + --------------------------------- + +diff --git a/runtime/gen_primitives.sh b/runtime/gen_primitives.sh +index e3ca2779b..63365a7fb 100755 +--- a/runtime/gen_primitives.sh ++++ b/runtime/gen_primitives.sh +@@ -17,6 +17,9 @@ + + # duplicated from $(ROOTDIR)/runtime/Makefile + ++# #8985: the meaning of character range a-z depends on the locale, so force C ++# locale throughout. ++export LC_ALL=C + ( + for prim in \ + alloc array compare extern floats gc_ctrl hash intern interp ints io \ +@@ -27,4 +30,4 @@ + done + sed -n -e 's/^CAMLprim_int64_[0-9](\([a-z0-9_][a-z0-9_]*\)).*/caml_int64_\1\ + caml_int64_\1_native/p' ints.c +-) | LC_ALL=C sort | uniq ++) | sort | uniq +-- +2.23.0 + diff --git a/0005-riscv-Emit-debug-info.patch b/0005-riscv-Emit-debug-info.patch deleted file mode 100644 index ff732cf..0000000 --- a/0005-riscv-Emit-debug-info.patch +++ /dev/null @@ -1,40 +0,0 @@ -From 2f23a53b4aa1b672b3919cc021b83548f713b90a Mon Sep 17 00:00:00 2001 -From: "Richard W.M. Jones" -Date: Tue, 5 Jun 2018 19:48:08 +0000 -Subject: [PATCH 5/5] riscv: Emit debug info. - ---- - asmcomp/riscv/emit.mlp | 3 +++ - 1 file changed, 3 insertions(+) - -diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp -index 88ea9f884..cc05aefe4 100644 ---- a/asmcomp/riscv/emit.mlp -+++ b/asmcomp/riscv/emit.mlp -@@ -261,6 +261,7 @@ let tailrec_entry_point = ref 0 - (* Output the assembly code for an instruction *) - - let emit_instr i = -+ emit_debug_info i.dbg; - match i.desc with - Lend -> () - | Lprologue -> -@@ -556,6 +557,7 @@ let fundecl fundecl = - ` {emit_string code_space}\n`; - ` .align 2\n`; - `{emit_symbol fundecl.fun_name}:\n`; -+ emit_debug_info fundecl.fun_dbg; - emit_all fundecl.fun_body; - List.iter emit_call_gc !call_gc_sites; - List.iter emit_call_bound_error !bound_error_sites; -@@ -615,6 +617,7 @@ let data l = - - let begin_assembly() = - ` .file \"\"\n`; (* PR#7073 *) -+ reset_debug_info (); - (* Emit the beginning of the segments *) - let lbl_begin = Compilenv.make_symbol (Some "data_begin") in - ` {emit_string data_space}\n`; --- -2.22.0.rc3 - diff --git a/0006-Merge-pull-request-8988-from-Octachron-fix_ocamlnat.patch b/0006-Merge-pull-request-8988-from-Octachron-fix_ocamlnat.patch new file mode 100644 index 0000000..0e3709a --- /dev/null +++ b/0006-Merge-pull-request-8988-from-Octachron-fix_ocamlnat.patch @@ -0,0 +1,28 @@ +From 8995e5828ebfe933b74d0c3704c0524a63c73467 Mon Sep 17 00:00:00 2001 +From: Florian Angeletti +Date: Fri, 27 Sep 2019 17:15:26 +0200 +Subject: [PATCH 06/12] Merge pull request #8988 from Octachron/fix_ocamlnat + +Fix ocamlnat + +(cherry picked from commit afb90bdf7476a92c024eee2e5745ed85200c654b) +--- + toplevel/opttoploop.ml | 2 +- + 1 file changed, 1 insertion(+), 1 deletion(-) + +diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml +index 0d1f73921..0174a9ab5 100644 +--- a/toplevel/opttoploop.ml ++++ b/toplevel/opttoploop.ml +@@ -257,7 +257,7 @@ let load_lambda ppf ~module_ident ~required_globals lam size = + else + Asmgen.compile_implementation_flambda + ~required_globals ~backend ~toplevel:need_symbol fn ~ppf_dump:ppf +- (Flambda_middle_end.middle_end ~ppf_dump:ppf ~prefixname:"" ~backend ~size ++ (Flambda_middle_end.middle_end ~ppf_dump:ppf ~prefixname:fn ~backend ~size + ~module_ident ~module_initializer:slam ~filename:"toplevel"); + Asmlink.call_linker_shared [fn ^ ext_obj] dll; + Sys.remove (fn ^ ext_obj); +-- +2.23.0 + diff --git a/0007-Fix-failure-to-install-tools-links.patch b/0007-Fix-failure-to-install-tools-links.patch new file mode 100644 index 0000000..5824bd8 --- /dev/null +++ b/0007-Fix-failure-to-install-tools-links.patch @@ -0,0 +1,45 @@ +From fa36269c5752bfb8f4b65dd0f9a2dd8f9c9eeb8f Mon Sep 17 00:00:00 2001 +From: David Allsopp +Date: Tue, 6 Aug 2019 09:23:06 +0100 +Subject: [PATCH 07/12] Fix failure to install tools links + +In --disable-installing-bytecode-programs mode, the .opt version of the +tools is installed, but the symlink for the tool itself is not created. + +(cherry picked from commit 705739fa54260b7a0e6cbba0b5a99e52c79f9c09) +--- + Changes | 5 +++++ + tools/Makefile | 1 + + 2 files changed, 6 insertions(+) + +diff --git a/Changes b/Changes +index 257a75e3d..3fdc31a5f 100644 +--- a/Changes ++++ b/Changes +@@ -1,6 +1,11 @@ + OCaml 4.09 maintenance branch: + ------------------------------ + ++- #8855, #8858: Links for tools not created when installing with ++ --disable-installing-byecode-programs (e.g. ocamldep.opt installed, but ++ ocamldep link not created) ++ (David Allsopp, report by Thomas Leonard) ++ + - #8953, #8954: Fix error submessages in the toplevel: do not display + dummy locations + (Armaël Guéneau, review by Gabriel Scherer) +diff --git a/tools/Makefile b/tools/Makefile +index afefc4d83..84ddd79fb 100644 +--- a/tools/Makefile ++++ b/tools/Makefile +@@ -242,6 +242,7 @@ else + do \ + if test -f "$$i".opt; then \ + $(INSTALL_PROG) "$$i.opt" "$(INSTALL_BINDIR)/$$i.opt$(EXE)"; \ ++ (cd "$(INSTALL_BINDIR)/" && $(LN) "$$i.opt$(EXE)" "$$i$(EXE)"); \ + fi; \ + done + endif +-- +2.23.0 + diff --git a/0008-Merge-pull-request-8996-from-dra27-win-reconfigure.patch b/0008-Merge-pull-request-8996-from-dra27-win-reconfigure.patch new file mode 100644 index 0000000..56ebcde --- /dev/null +++ b/0008-Merge-pull-request-8996-from-dra27-win-reconfigure.patch @@ -0,0 +1,31 @@ +From 308ea9a8d526160e2b45f16d63a0aee70984b814 Mon Sep 17 00:00:00 2001 +From: Gabriel Scherer +Date: Sun, 29 Sep 2019 19:33:29 +0200 +Subject: [PATCH 08/12] Merge pull request #8996 from dra27/win-reconfigure + +Windows supports make reconfigure now + +(cherry picked from commit c71997a167c3670d202c6ecaf830c6a25b4b95b8) +--- + Makefile | 2 -- + 1 file changed, 2 deletions(-) + +diff --git a/Makefile b/Makefile +index 7ac446f62..90583f1bc 100644 +--- a/Makefile ++++ b/Makefile +@@ -326,11 +326,9 @@ endif + utils/config.ml: utils/config.mlp Makefile.config utils/Makefile Makefile + $(MAKE) -C utils config.ml + +-ifeq "$(UNIX_OR_WIN32)" "unix" + .PHONY: reconfigure + reconfigure: + ./configure $(CONFIGURE_ARGS) +-endif + + .PHONY: partialclean + partialclean:: +-- +2.23.0 + diff --git a/0001-Don-t-add-rpaths-to-libraries.patch b/0009-Don-t-add-rpaths-to-libraries.patch similarity index 83% rename from 0001-Don-t-add-rpaths-to-libraries.patch rename to 0009-Don-t-add-rpaths-to-libraries.patch index 5b60aef..f2589ba 100644 --- a/0001-Don-t-add-rpaths-to-libraries.patch +++ b/0009-Don-t-add-rpaths-to-libraries.patch @@ -1,14 +1,14 @@ -From d3bc916ff1bc467c503e21015db9c1e2a47a64f2 Mon Sep 17 00:00:00 2001 +From 065c173840d0c379c26376b1de6363736043c969 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 24 Jun 2014 10:00:15 +0100 -Subject: [PATCH 1/5] Don't add rpaths to libraries. +Subject: [PATCH 09/12] Don't add rpaths to libraries. --- tools/Makefile | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tools/Makefile b/tools/Makefile -index ee0e0be4c..7c96b6405 100644 +index 84ddd79fb..796821968 100644 --- a/tools/Makefile +++ b/tools/Makefile @@ -153,8 +153,8 @@ $(call byte_and_opt,ocamlmklib,ocamlmklibconfig.cmo config.cmo \ @@ -23,5 +23,5 @@ index ee0e0be4c..7c96b6405 100644 > ocamlmklibconfig.ml -- -2.22.0.rc3 +2.23.0 diff --git a/0002-configure-Allow-user-defined-C-compiler-flags.patch b/0010-configure-Allow-user-defined-C-compiler-flags.patch similarity index 71% rename from 0002-configure-Allow-user-defined-C-compiler-flags.patch rename to 0010-configure-Allow-user-defined-C-compiler-flags.patch index 093be83..7d532d4 100644 --- a/0002-configure-Allow-user-defined-C-compiler-flags.patch +++ b/0010-configure-Allow-user-defined-C-compiler-flags.patch @@ -1,17 +1,17 @@ -From 8cc56a1515816c9cef84694e63eaed63a0474090 Mon Sep 17 00:00:00 2001 +From f1c04c17f5b42a969cbf3119ebbb851e799d664d Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Tue, 29 May 2012 20:44:18 +0100 -Subject: [PATCH 2/5] configure: Allow user defined C compiler flags. +Subject: [PATCH 10/12] configure: Allow user defined C compiler flags. --- configure.ac | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/configure.ac b/configure.ac -index f5d8a2687..ad5b701bd 100644 +index c2f185373..12d9f6cde 100644 --- a/configure.ac +++ b/configure.ac -@@ -553,6 +553,10 @@ AS_CASE([$host], +@@ -549,6 +549,10 @@ AS_CASE([$host], internal_cflags="$gcc_warnings"], [common_cflags="-O"])]) @@ -23,5 +23,5 @@ index f5d8a2687..ad5b701bd 100644 # Enable SSE2 on x86 mingw to avoid using 80-bit registers. -- -2.22.0.rc3 +2.23.0 diff --git a/0003-configure-Remove-incorrect-assumption-about-cross-co.patch b/0011-configure-Remove-incorrect-assumption-about-cross-co.patch similarity index 67% rename from 0003-configure-Remove-incorrect-assumption-about-cross-co.patch rename to 0011-configure-Remove-incorrect-assumption-about-cross-co.patch index 99bca0e..d7ab72d 100644 --- a/0003-configure-Remove-incorrect-assumption-about-cross-co.patch +++ b/0011-configure-Remove-incorrect-assumption-about-cross-co.patch @@ -1,7 +1,7 @@ -From 0204a1137a8e8058afd1665aa6112656bc7bf0be Mon Sep 17 00:00:00 2001 +From 3432e0eb653e670025642b6e40e2d4a2eb4c28ae Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Fri, 26 Apr 2019 16:16:29 +0100 -Subject: [PATCH 3/5] configure: Remove incorrect assumption about +Subject: [PATCH 11/12] configure: Remove incorrect assumption about cross-compiling. See https://github.com/ocaml/ocaml/issues/8647#issuecomment-487094390 @@ -10,12 +10,12 @@ See https://github.com/ocaml/ocaml/issues/8647#issuecomment-487094390 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/configure.ac b/configure.ac -index ad5b701bd..2227769e8 100644 +index 12d9f6cde..e85cc9ffa 100644 --- a/configure.ac +++ b/configure.ac -@@ -959,7 +959,7 @@ AS_CASE([$host], - [*-*-mingw32|*-pc-windows], [asppprofflags=''], - [asppprofflags='-DPROFILING']) +@@ -927,7 +927,7 @@ AS_IF([test $arch != "none" && $arch64 ], + + # Assembler -AS_IF([test -n "$host_alias"], [toolpref="${host_alias}-"], [toolpref=""]) +#AS_IF([test -n "$host_alias"], [toolpref="${host_alias}-"], [toolpref=""]) @@ -23,5 +23,5 @@ index ad5b701bd..2227769e8 100644 # We first compute default values for as and aspp # If values have been given by the user then they take precedence over -- -2.22.0.rc3 +2.23.0 diff --git a/0012-Add-riscv64-backend.patch b/0012-Add-riscv64-backend.patch new file mode 100644 index 0000000..5883ba8 --- /dev/null +++ b/0012-Add-riscv64-backend.patch @@ -0,0 +1,1912 @@ +From a861b131c28af6b313c7e778e2b6712e6b6fa5f2 Mon Sep 17 00:00:00 2001 +From: =?UTF-8?q?Nicol=C3=A1s=20Ojeda=20B=C3=A4r?= +Date: Mon, 18 Nov 2019 01:13:30 +0100 +Subject: [PATCH 12/12] Add riscv64 backend + +(cherry picked from commit c8a361f586c21eca25108ee79c495bb480a1c3f3) +--- + README.adoc | 1 + + asmcomp/riscv/CSE.ml | 36 ++ + asmcomp/riscv/arch.ml | 87 +++++ + asmcomp/riscv/emit.mlp | 669 +++++++++++++++++++++++++++++++++ + asmcomp/riscv/proc.ml | 336 +++++++++++++++++ + asmcomp/riscv/reload.ml | 16 + + asmcomp/riscv/scheduling.ml | 19 + + asmcomp/riscv/selection.ml | 71 ++++ + configure | Bin 542985 -> 543184 bytes + configure.ac | 11 +- + runtime/caml/stack.h | 5 + + runtime/riscv.S | 427 +++++++++++++++++++++ + testsuite/tools/asmgen_riscv.S | 87 +++++ + 13 files changed, 1762 insertions(+), 3 deletions(-) + create mode 100644 asmcomp/riscv/CSE.ml + create mode 100644 asmcomp/riscv/arch.ml + create mode 100644 asmcomp/riscv/emit.mlp + create mode 100644 asmcomp/riscv/proc.ml + create mode 100644 asmcomp/riscv/reload.ml + create mode 100644 asmcomp/riscv/scheduling.ml + create mode 100644 asmcomp/riscv/selection.ml + create mode 100644 runtime/riscv.S + create mode 100644 testsuite/tools/asmgen_riscv.S + +diff --git a/README.adoc b/README.adoc +index 504c7a708..4dc404da3 100644 +--- a/README.adoc ++++ b/README.adoc +@@ -54,6 +54,7 @@ compiler currently runs on the following platforms: + | ARM 32 bits | Linux | FreeBSD, NetBSD, OpenBSD + | Power 64 bits | Linux | + | Power 32 bits | | Linux ++| RISC-V 64 bits | Linux | + | IBM Z (s390x) | Linux | + |==== + +diff --git a/asmcomp/riscv/CSE.ml b/asmcomp/riscv/CSE.ml +new file mode 100644 +index 000000000..302811a99 +--- /dev/null ++++ b/asmcomp/riscv/CSE.ml +@@ -0,0 +1,36 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2106 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* CSE for the RISC-V *) ++ ++open Arch ++open Mach ++open CSEgen ++ ++class cse = object (_self) ++ ++inherit cse_generic as super ++ ++method! class_of_operation op = ++ match op with ++ | Ispecific(Imultaddf _ | Imultsubf _) -> Op_pure ++ | _ -> super#class_of_operation op ++ ++method! is_cheap_operation op = ++ match op with ++ | Iconst_int n -> n <= 0x7FFn && n >= -0x800n ++ | _ -> false ++ ++end ++ ++let fundecl f = ++ (new cse)#fundecl f +diff --git a/asmcomp/riscv/arch.ml b/asmcomp/riscv/arch.ml +new file mode 100644 +index 000000000..22c807c49 +--- /dev/null ++++ b/asmcomp/riscv/arch.ml +@@ -0,0 +1,87 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Specific operations for the RISC-V processor *) ++ ++open Format ++ ++(* Machine-specific command-line options *) ++ ++let command_line_options = [] ++ ++(* Specific operations *) ++ ++type specific_operation = ++ | Imultaddf of bool (* multiply, optionally negate, and add *) ++ | Imultsubf of bool (* multiply, optionally negate, and subtract *) ++ ++let spacetime_node_hole_pointer_is_live_before = function ++ | Imultaddf _ | Imultsubf _ -> false ++ ++(* Addressing modes *) ++ ++type addressing_mode = ++ | Iindexed of int (* reg + displ *) ++ ++let is_immediate n = ++ (n <= 2047) && (n >= -2048) ++ ++(* Sizes, endianness *) ++ ++let big_endian = false ++ ++let rv64 = ++ match Config.model with "riscv64" -> true | "riscv32" -> false | _ -> assert false ++ ++let size_addr = if rv64 then 8 else 4 ++let size_int = size_addr ++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) ++ ++let num_args_addressing = function ++ | Iindexed _ -> 1 ++ ++(* Printing operations and addressing modes *) ++ ++let print_addressing printreg addr ppf arg = ++ match addr with ++ | Iindexed n -> ++ let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in ++ fprintf ppf "%a%s" printreg arg.(0) idx ++ ++let print_specific_operation printreg op ppf arg = ++ match op with ++ | Imultaddf false -> ++ fprintf ppf "%a *f %a +f %a" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) ++ | Imultaddf true -> ++ fprintf ppf "-f (%a *f %a +f %a)" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) ++ | Imultsubf false -> ++ fprintf ppf "%a *f %a -f %a" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) ++ | Imultsubf true -> ++ fprintf ppf "-f (%a *f %a -f %a)" ++ printreg arg.(0) printreg arg.(1) printreg arg.(2) +diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp +new file mode 100644 +index 000000000..f9e3874d9 +--- /dev/null ++++ b/asmcomp/riscv/emit.mlp +@@ -0,0 +1,669 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Emission of RISC-V assembly code *) ++ ++open Misc ++open Cmm ++open Arch ++open Proc ++open Reg ++open Mach ++open Linearize ++open Emitaux ++ ++(* Layout of the stack. The stack is kept 16-aligned. *) ++ ++let stack_offset = ref 0 ++ ++let frame_size () = ++ let size = ++ !stack_offset + (* Trap frame, outgoing parameters *) ++ size_int * num_stack_slots.(0) + (* Local int variables *) ++ size_float * num_stack_slots.(1) + (* Local float variables *) ++ (if !contains_calls then size_addr else 0) in (* The return address *) ++ Misc.align size 16 ++ ++let slot_offset loc cls = ++ match loc with ++ | Local n -> ++ if cls = 0 ++ then !stack_offset + num_stack_slots.(1) * size_float + n * size_int ++ else !stack_offset + n * size_float ++ | Incoming n -> frame_size() + n ++ | Outgoing n -> n ++ ++(* Output a symbol *) ++ ++let emit_symbol s = ++ Emitaux.emit_symbol '.' s ++ ++let emit_jump op s = ++ if !Clflags.dlcode || !Clflags.pic_code ++ then `{emit_string op} {emit_symbol s}@plt` ++ else `{emit_string op} {emit_symbol s}` ++ ++let emit_call = emit_jump "call" ++let emit_tail = emit_jump "tail" ++ ++(* Output a label *) ++ ++let label_prefix = "L" ++ ++let emit_label lbl = ++ emit_string label_prefix; emit_int lbl ++ ++(* Section switching *) ++ ++let data_space = ++ ".section .data" ++ ++let code_space = ++ ".section .text" ++ ++let rodata_space = ++ ".section .rodata" ++ ++let reg_tmp1 = phys_reg 21 (* used by the assembler *) ++let reg_tmp2 = phys_reg 22 ++let reg_t2 = phys_reg 16 ++(* let reg_fp = phys_reg 23 *) ++let reg_trap = phys_reg 24 ++let reg_alloc_ptr = phys_reg 25 ++let reg_alloc_lim = phys_reg 26 ++ ++(* Names of instructions that differ in 32 and 64-bit modes *) ++ ++let lg = if rv64 then "ld" else "lw" ++let stg = if rv64 then "sd" else "sw" ++let datag = if rv64 then ".quad" else ".long" ++ ++(* Output a pseudo-register *) ++ ++let emit_reg = function ++ | {loc = Reg r} -> emit_string (register_name r) ++ | _ -> fatal_error "Emit.emit_reg" ++ ++(* Adjust sp by the given byte amount *) ++ ++let emit_stack_adjustment = function ++ | 0 -> () ++ | n when is_immediate n -> ++ ` addi sp, sp, {emit_int n}\n` ++ | n -> ++ ` li {emit_reg reg_tmp1}, {emit_int n}\n`; ++ ` add sp, sp, {emit_reg reg_tmp1}\n` ++ ++let reload_ra n = ++ let ofs = n - size_addr in ++ if is_immediate ofs then ++ ` {emit_string lg} ra, {emit_int ofs}(sp)\n` ++ else begin ++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; ++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; ++ ` {emit_string lg} ra, 0({emit_reg reg_tmp1})\n` ++ end ++ ++let store_ra n = ++ let ofs = n - size_addr in ++ if is_immediate ofs then ++ ` {emit_string stg} ra, {emit_int(n - size_addr)}(sp)\n` ++ else begin ++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; ++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; ++ ` {emit_string stg} ra, 0({emit_reg reg_tmp1})\n` ++ end ++ ++let emit_store stg src ofs = ++ if is_immediate ofs then ++ ` {emit_string stg} {emit_reg src}, {emit_int ofs}(sp)\n` ++ else begin ++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; ++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; ++ ` {emit_string stg} {emit_reg src}, 0({emit_reg reg_tmp1})\n` ++ end ++ ++let emit_load lg dst ofs = ++ if is_immediate ofs then ++ ` {emit_string lg} {emit_reg dst}, {emit_int ofs}(sp)\n` ++ else begin ++ ` li {emit_reg reg_tmp1}, {emit_int ofs}\n`; ++ ` add {emit_reg reg_tmp1}, sp, {emit_reg reg_tmp1}\n`; ++ ` {emit_string lg} {emit_reg dst}, 0({emit_reg reg_tmp1})\n` ++ end ++ ++(* Record live pointers at call points *) ++ ++let record_frame_label ?label live raise_ dbg = ++ let lbl = ++ match label with ++ | None -> new_label() ++ | Some label -> label ++ in ++ let live_offset = ref [] in ++ Reg.Set.iter ++ (function ++ {typ = Val; loc = Reg r} -> ++ live_offset := (r lsl 1) + 1 :: !live_offset ++ | {typ = Val; loc = Stack s} as reg -> ++ live_offset := slot_offset s (register_class reg) :: !live_offset ++ | {typ = Addr} as r -> ++ Misc.fatal_error ("bad GC root " ^ Reg.name r) ++ | _ -> () ++ ) ++ live; ++ record_frame_descr ~label:lbl ~frame_size:(frame_size()) ++ ~live_offset:!live_offset ~raise_frame:raise_ dbg; ++ lbl ++ ++let record_frame ?label live raise_ dbg = ++ let lbl = record_frame_label ?label live raise_ dbg in ++ `{emit_label lbl}:\n` ++ ++(* 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}:\n`; ++ ` {emit_call "caml_call_gc"}\n`; ++ `{emit_label gc.gc_frame_lbl}:\n`; ++ ` j {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 ?label dbg = ++ if !Clflags.debug || !bound_error_sites = [] then begin ++ let lbl_bound_error = new_label() in ++ let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in ++ bound_error_sites := ++ { bd_lbl = lbl_bound_error; ++ bd_frame_lbl = lbl_frame } :: !bound_error_sites; ++ lbl_bound_error ++ end else ++ let bd = List.hd !bound_error_sites in ++ bd.bd_lbl ++ ++let emit_call_bound_error bd = ++ `{emit_label bd.bd_lbl}:\n`; ++ ` {emit_call "caml_ml_array_bound_error"}\n`; ++ `{emit_label bd.bd_frame_lbl}:\n` ++ ++(* Record floating-point literals *) ++ ++let float_literals = ref ([] : (int64 * int) list) ++ ++(* Names for various instructions *) ++ ++let name_for_intop = function ++ | Iadd -> "add" ++ | Isub -> "sub" ++ | Imul -> "mul" ++ | Imulh -> "mulh" ++ | Idiv -> "div" ++ | Iand -> "and" ++ | Ior -> "or" ++ | Ixor -> "xor" ++ | Ilsl -> "sll" ++ | Ilsr -> "srl" ++ | Iasr -> "sra" ++ | Imod -> "rem" ++ | _ -> fatal_error "Emit.Intop" ++ ++let name_for_intop_imm = function ++ | Iadd -> "addi" ++ | Iand -> "andi" ++ | Ior -> "ori" ++ | Ixor -> "xori" ++ | Ilsl -> "slli" ++ | Ilsr -> "srli" ++ | Iasr -> "srai" ++ | _ -> fatal_error "Emit.Intop_imm" ++ ++let name_for_floatop1 = function ++ | Inegf -> "fneg.d" ++ | Iabsf -> "fabs.d" ++ | _ -> fatal_error "Emit.Iopf1" ++ ++let name_for_floatop2 = function ++ | Iaddf -> "fadd.d" ++ | Isubf -> "fsub.d" ++ | Imulf -> "fmul.d" ++ | Idivf -> "fdiv.d" ++ | _ -> fatal_error "Emit.Iopf2" ++ ++let name_for_specific = function ++ | Imultaddf false -> "fmadd.d" ++ | Imultaddf true -> "fnmadd.d" ++ | Imultsubf false -> "fmsub.d" ++ | Imultsubf true -> "fnmsub.d" ++ ++(* Name of current function *) ++let function_name = ref "" ++ ++(* Entry point for tail recursive calls *) ++let tailrec_entry_point = ref 0 ++ ++(* Output the assembly code for an instruction *) ++ ++let emit_instr i = ++ emit_debug_info i.dbg; ++ match i.desc with ++ Lend -> () ++ | Lprologue -> ++ assert (Proc.prologue_required ()); ++ let n = frame_size() in ++ emit_stack_adjustment (-n); ++ if !contains_calls then store_ra n ++ | Lop(Imove | Ispill | Ireload) -> ++ let src = i.arg.(0) and dst = i.res.(0) in ++ if src.loc <> dst.loc then begin ++ match (src, dst) with ++ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Reg _} -> ++ ` mv {emit_reg dst}, {emit_reg src}\n` ++ | {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} -> ++ ` fmv.d {emit_reg dst}, {emit_reg src}\n` ++ | {loc = Reg _; typ = (Val | Int | Addr)}, {loc = Stack s} -> ++ let ofs = slot_offset s (register_class dst) in ++ emit_store stg src ofs ++ | {loc = Reg _; typ = Float}, {loc = Stack s} -> ++ let ofs = slot_offset s (register_class dst) in ++ emit_store "fsd" src ofs ++ | {loc = Stack s; typ = (Val | Int | Addr)}, {loc = Reg _} -> ++ let ofs = slot_offset s (register_class src) in ++ emit_load lg dst ofs ++ | {loc = Stack s; typ = Float}, {loc = Reg _} -> ++ let ofs = slot_offset s (register_class src) in ++ emit_load "fld" dst ofs ++ | _ -> ++ fatal_error "Emit: Imove" ++ end ++ | Lop(Iconst_int n) -> ++ ` li {emit_reg i.res.(0)}, {emit_nativeint n}\n` ++ | Lop(Iconst_float f) -> ++ let lbl = new_label() in ++ float_literals := (f, lbl) :: !float_literals; ++ ` fld {emit_reg i.res.(0)}, {emit_label lbl}, {emit_reg reg_tmp1}\n` ++ | Lop(Iconst_symbol s) -> ++ ` la {emit_reg i.res.(0)}, {emit_symbol s}\n` ++ | Lop(Icall_ind {label_after = label}) -> ++ ` jalr {emit_reg i.arg.(0)}\n`; ++ record_frame ~label i.live false i.dbg ++ | Lop(Icall_imm {func; label_after = label}) -> ++ ` {emit_call func}\n`; ++ record_frame ~label i.live false i.dbg ++ | Lop(Itailcall_ind {label_after = _}) -> ++ let n = frame_size() in ++ if !contains_calls then reload_ra n; ++ emit_stack_adjustment n; ++ ` jr {emit_reg i.arg.(0)}\n` ++ | Lop(Itailcall_imm {func; label_after = _}) -> ++ if func = !function_name then begin ++ ` j {emit_label !tailrec_entry_point}\n` ++ end else begin ++ let n = frame_size() in ++ if !contains_calls then reload_ra n; ++ emit_stack_adjustment n; ++ ` {emit_tail func}\n` ++ end ++ | Lop(Iextcall{func; alloc = true; label_after = label}) -> ++ ` la {emit_reg reg_t2}, {emit_symbol func}\n`; ++ ` {emit_call "caml_c_call"}\n`; ++ record_frame ~label i.live false i.dbg ++ | Lop(Iextcall{func; alloc = false; label_after = _}) -> ++ ` {emit_call func}\n` ++ | Lop(Istackoffset n) -> ++ assert (n mod 16 = 0); ++ emit_stack_adjustment (-n); ++ stack_offset := !stack_offset + n ++ | Lop(Iload(Single, Iindexed ofs)) -> ++ ` flw {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n`; ++ ` fcvt.d.s {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` ++ | Lop(Iload(chunk, Iindexed ofs)) -> ++ let instr = ++ match chunk with ++ | Byte_unsigned -> "lbu" ++ | Byte_signed -> "lb" ++ | Sixteen_unsigned -> "lhu" ++ | Sixteen_signed -> "lh" ++ | Thirtytwo_unsigned -> if rv64 then "lwu" else "lw" ++ | Thirtytwo_signed -> "lw" ++ | Word_int | Word_val -> lg ++ | Single -> assert false ++ | Double | Double_u -> "fld" ++ in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg i.arg.(0)})\n` ++ | Lop(Istore(Single, Iindexed ofs, _)) -> ++ ` fmv.x.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}\n`; ++ ` fcvt.s.d {emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}\n`; ++ ` fsw {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n`; ++ ` fmv.d.x {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}\n` ++ | Lop(Istore(chunk, Iindexed ofs, _)) -> ++ let instr = ++ match chunk with ++ | Byte_unsigned | Byte_signed -> "sb" ++ | Sixteen_unsigned | Sixteen_signed -> "sh" ++ | Thirtytwo_unsigned | Thirtytwo_signed -> "sw" ++ | Word_int | Word_val -> stg ++ | Single -> assert false ++ | Double | Double_u -> "fsd" ++ in ++ ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n` ++ | Lop(Ialloc {bytes = n; label_after_call_gc = label; _}) -> ++ let lbl_frame_lbl = record_frame_label ?label i.live false i.dbg in ++ let lbl_redo = new_label () in ++ let lbl_call_gc = new_label () in ++ `{emit_label lbl_redo}:\n`; ++ ` addi {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, -{emit_int n}\n`; ++ ` addi {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`; ++ ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_lim}, {emit_label lbl_call_gc}\n`; ++ call_gc_sites := ++ { gc_lbl = lbl_call_gc; ++ gc_return_lbl = lbl_redo; ++ gc_frame_lbl = lbl_frame_lbl } :: !call_gc_sites ++ | Lop(Iintop(Icomp cmp)) -> ++ begin match cmp with ++ | Isigned Clt -> ++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Isigned Cge -> ++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; ++ | Isigned Cgt -> ++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` ++ | Isigned Cle -> ++ ` slt {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`; ++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; ++ | Isigned Ceq | Iunsigned Ceq -> ++ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` seqz {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` ++ | Isigned Cne | Iunsigned Cne -> ++ ` sub {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` snez {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n` ++ | Iunsigned Clt -> ++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Iunsigned Cge -> ++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; ++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; ++ | Iunsigned Cgt -> ++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` ++ | Iunsigned Cle -> ++ ` sltu {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`; ++ ` xori {emit_reg i.res.(0)}, {emit_reg i.res.(0)}, 1\n`; ++ end ++ | Lop(Iintop (Icheckbound {label_after_error = label; _})) -> ++ let lbl = bound_error_label ?label i.dbg in ++ ` bleu {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n` ++ | Lop(Iintop op) -> ++ let instr = name_for_intop op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Lop(Iintop_imm(Isub, n)) -> ++ ` addi {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int(-n)}\n` ++ | Lop(Iintop_imm(Icomp _, _)) -> ++ fatal_error "Emit.emit_instr (Iintop_imm (Icomp _, _))" ++ | Lop(Iintop_imm(Icheckbound {label_after_error = label; _}, n)) -> ++ let lbl = bound_error_label ?label i.dbg in ++ ` li {emit_reg reg_tmp1}, {emit_int n}\n`; ++ ` bleu {emit_reg i.arg.(0)}, {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ | Lop(Iintop_imm(op, n)) -> ++ let instr = name_for_intop_imm op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n` ++ | Lop(Inegf | Iabsf as op) -> ++ let instr = name_for_floatop1 op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` ++ | Lop(Iaddf | Isubf | Imulf | Idivf as op) -> ++ let instr = name_for_floatop2 op in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | Lop(Ifloatofint) -> ++ let name = if rv64 then "fcvt.d.l" else "fcvt.d.w" in ++ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n` ++ | Lop(Iintoffloat) -> ++ let name = if rv64 then "fcvt.l.d" else "fcvt.w.d" in ++ ` {emit_string name} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, rtz\n` ++ | Lop(Ispecific sop) -> ++ let instr = name_for_specific sop in ++ ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n` ++ | Lop (Iname_for_debugger _) -> ++ () ++ | Lreloadretaddr -> ++ let n = frame_size () in ++ reload_ra n ++ | Lreturn -> ++ let n = frame_size() in ++ emit_stack_adjustment n; ++ ` ret\n` ++ | Llabel lbl -> ++ `{emit_label lbl}:\n` ++ | Lbranch lbl -> ++ ` j {emit_label lbl}\n` ++ | Lcondbranch(tst, lbl) -> ++ begin match tst with ++ | Itruetest -> ++ ` bnez {emit_reg i.arg.(0)}, {emit_label lbl}\n` ++ | Ifalsetest -> ++ ` beqz {emit_reg i.arg.(0)}, {emit_label lbl}\n` ++ | Iinttest cmp -> ++ let name = match cmp with ++ | Iunsigned Ceq | Isigned Ceq -> "beq" ++ | Iunsigned Cne | Isigned Cne -> "bne" ++ | Iunsigned Cle -> "bleu" | Isigned Cle -> "ble" ++ | Iunsigned Cge -> "bgeu" | Isigned Cge -> "bge" ++ | Iunsigned Clt -> "bltu" | Isigned Clt -> "blt" ++ | Iunsigned Cgt -> "bgtu" | Isigned Cgt -> "bgt" ++ in ++ ` {emit_string name} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n` ++ | Iinttest_imm _ -> ++ fatal_error "Emit.emit_instr (Iinttest_imm _)" ++ | Ifloattest cmp -> ++ let branch = ++ match cmp with ++ | CFneq | CFnlt | CFngt | CFnle | CFnge -> "beqz" ++ | CFeq | CFlt | CFgt | CFle | CFge -> "bnez" ++ in ++ begin match cmp with ++ | CFeq | CFneq -> ` feq.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | CFlt | CFnlt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | CFgt | CFngt -> ` flt.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` ++ | CFle | CFnle -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` ++ | CFge | CFnge -> ` fle.d {emit_reg reg_tmp1}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n` ++ end; ++ ` {emit_string branch} {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ | Ioddtest -> ++ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`; ++ ` bnez {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ | Ieventest -> ++ ` andi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, 1\n`; ++ ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ end ++ | Lcondbranch3(lbl0, lbl1, lbl2) -> ++ ` addi {emit_reg reg_tmp1}, {emit_reg i.arg.(0)}, -1\n`; ++ begin match lbl0 with ++ | None -> () ++ | Some lbl -> ` bltz {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ end; ++ begin match lbl1 with ++ | None -> () ++ | Some lbl -> ` beqz {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ end; ++ begin match lbl2 with ++ | None -> () ++ | Some lbl -> ` bgtz {emit_reg reg_tmp1}, {emit_label lbl}\n` ++ end ++ | Lswitch jumptbl -> (* FIXME FIXME ? *) ++ let lbl = new_label() in ++ ` la {emit_reg reg_tmp1}, {emit_label lbl}\n`; ++ ` slli {emit_reg reg_tmp2}, {emit_reg i.arg.(0)}, 2\n`; ++ ` add {emit_reg reg_tmp1}, {emit_reg reg_tmp1}, {emit_reg reg_tmp2}\n`; ++ ` jr {emit_reg reg_tmp1}\n`; ++ `{emit_label lbl}:\n`; ++ for i = 0 to Array.length jumptbl - 1 do ++ ` j {emit_label jumptbl.(i)}\n` ++ done ++ | Lentertrap -> ++ () ++ | Lpushtrap {lbl_handler} -> ++ ` la {emit_reg reg_tmp1}, {emit_label lbl_handler}\n`; ++ ` addi sp, sp, -16\n`; ++ stack_offset := !stack_offset + 16; ++ ` {emit_string stg} {emit_reg reg_tmp1}, {emit_int size_addr}(sp)\n`; ++ ` {emit_string stg} {emit_reg reg_trap}, 0(sp)\n`; ++ ` mv {emit_reg reg_trap}, sp\n` ++ | Lpoptrap -> ++ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`; ++ ` addi sp, sp, 16\n`; ++ stack_offset := !stack_offset - 16 ++ | Lraise k -> ++ begin match !Clflags.debug, k with ++ | true, Cmm.Raise_withtrace -> ++ ` {emit_call "caml_raise_exn"}\n`; ++ record_frame Reg.Set.empty true i.dbg ++ | false, _ ++ | true, Cmm.Raise_notrace -> ++ ` mv sp, {emit_reg reg_trap}\n`; ++ ` {emit_string lg} {emit_reg reg_tmp1}, {emit_int size_addr}(sp)\n`; ++ ` {emit_string lg} {emit_reg reg_trap}, 0(sp)\n`; ++ ` addi sp, sp, 16\n`; ++ ` jalr {emit_reg reg_tmp1}\n` ++ end ++ ++(* Emit a sequence of instructions *) ++ ++let rec emit_all = function ++ | {desc = Lend} -> () | i -> emit_instr i; emit_all i.next ++ ++(* Emission of a function declaration *) ++ ++let fundecl fundecl = ++ function_name := fundecl.fun_name; ++ tailrec_entry_point := fundecl.fun_tailrec_entry_point_label; ++ stack_offset := 0; ++ call_gc_sites := []; ++ bound_error_sites := []; ++ float_literals := []; ++ ` .globl {emit_symbol fundecl.fun_name}\n`; ++ ` .type {emit_symbol fundecl.fun_name}, @function\n`; ++ ` {emit_string code_space}\n`; ++ ` .align 2\n`; ++ `{emit_symbol fundecl.fun_name}:\n`; ++ emit_debug_info fundecl.fun_dbg; ++ emit_all fundecl.fun_body; ++ List.iter emit_call_gc !call_gc_sites; ++ List.iter emit_call_bound_error !bound_error_sites; ++ ` .size {emit_symbol fundecl.fun_name}, .-{emit_symbol fundecl.fun_name}\n`; ++ (* Emit the float literals *) ++ if !float_literals <> [] then begin ++ ` {emit_string rodata_space}\n`; ++ ` .align 3\n`; ++ List.iter ++ (fun (f, lbl) -> ++ `{emit_label lbl}:\n`; ++ if rv64 ++ then emit_float64_directive ".quad" f ++ else emit_float64_split_directive ".long" f) ++ !float_literals; ++ end ++ ++(* Emission of data *) ++ ++let declare_global_data s = ++ ` .globl {emit_symbol s}\n`; ++ ` .type {emit_symbol s}, @object\n` ++ ++let emit_item = function ++ | Cglobal_symbol s -> ++ declare_global_data s ++ | Cdefine_symbol s -> ++ `{emit_symbol s}:\n`; ++ | Cint8 n -> ++ ` .byte {emit_int n}\n` ++ | Cint16 n -> ++ ` .short {emit_int n}\n` ++ | Cint32 n -> ++ ` .long {emit_nativeint n}\n` ++ | Cint n -> ++ ` {emit_string datag} {emit_nativeint n}\n` ++ | Csingle f -> ++ emit_float32_directive ".long" (Int32.bits_of_float f) ++ | Cdouble f -> ++ if rv64 ++ then emit_float64_directive ".quad" (Int64.bits_of_float f) ++ else emit_float64_split_directive ".long" (Int64.bits_of_float f) ++ | Csymbol_address s -> ++ ` {emit_string datag} {emit_symbol s}\n` ++ | Cstring s -> ++ emit_bytes_directive " .byte " s ++ | Cskip n -> ++ if n > 0 then ` .space {emit_int n}\n` ++ | Calign n -> ++ ` .align {emit_int (Misc.log2 n)}\n` ++ ++let data l = ++ ` {emit_string data_space}\n`; ++ List.iter emit_item l ++ ++(* Beginning / end of an assembly file *) ++ ++let begin_assembly() = ++ if !Clflags.dlcode || !Clflags.pic_code then ` .option pic\n`; ++ ` .file \"\"\n`; (* PR#7073 *) ++ reset_debug_info (); ++ (* Emit the beginning of the segments *) ++ let lbl_begin = Compilenv.make_symbol (Some "data_begin") in ++ ` {emit_string data_space}\n`; ++ declare_global_data lbl_begin; ++ `{emit_symbol lbl_begin}:\n`; ++ let lbl_begin = Compilenv.make_symbol (Some "code_begin") in ++ ` {emit_string code_space}\n`; ++ declare_global_data lbl_begin; ++ `{emit_symbol lbl_begin}:\n` ++ ++let end_assembly() = ++ ` {emit_string code_space}\n`; ++ let lbl_end = Compilenv.make_symbol (Some "code_end") in ++ declare_global_data lbl_end; ++ `{emit_symbol lbl_end}:\n`; ++ ` .long 0\n`; ++ ` {emit_string data_space}\n`; ++ let lbl_end = Compilenv.make_symbol (Some "data_end") in ++ declare_global_data lbl_end; ++ ` {emit_string datag} 0\n`; (* PR#6329 *) ++ `{emit_symbol lbl_end}:\n`; ++ ` {emit_string datag} 0\n`; ++ (* Emit the frame descriptors *) ++ ` {emit_string rodata_space}\n`; ++ let lbl = Compilenv.make_symbol (Some "frametable") in ++ declare_global_data lbl; ++ `{emit_symbol lbl}:\n`; ++ emit_frames ++ { efa_code_label = (fun l -> ` {emit_string datag} {emit_label l}\n`); ++ efa_data_label = (fun l -> ` {emit_string datag} {emit_label l}\n`); ++ efa_16 = (fun n -> ` .short {emit_int n}\n`); ++ efa_32 = (fun n -> ` .long {emit_int32 n}\n`); ++ efa_word = (fun n -> ` {emit_string datag} {emit_int n}\n`); ++ efa_align = (fun n -> ` .align {emit_int (Misc.log2 n)}\n`); ++ efa_label_rel = (fun lbl ofs -> ++ ` .long ({emit_label lbl} - .) + {emit_int32 ofs}\n`); ++ efa_def_label = (fun l -> `{emit_label l}:\n`); ++ efa_string = (fun s -> emit_bytes_directive " .byte " (s ^ "\000")) ++ } +diff --git a/asmcomp/riscv/proc.ml b/asmcomp/riscv/proc.ml +new file mode 100644 +index 000000000..0981fae73 +--- /dev/null ++++ b/asmcomp/riscv/proc.ml +@@ -0,0 +1,336 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Description of the RISC-V *) ++ ++open Misc ++open Cmm ++open Reg ++open Arch ++open Mach ++ ++(* Instruction selection *) ++ ++let word_addressed = false ++ ++(* Registers available for register allocation *) ++ ++(* Integer register map: ++ zero always zero ++ ra return address ++ sp, gp, tp stack pointer, global pointer, thread pointer (preserved by C) ++ a0 - a7 0 - 7 arguments/results ++ s2 - s9 8 - 15 arguments/results (preserved by C) ++ t2 - t6 16 - 20 temporary ++ t0 21 temporary (used by assembler) ++ t1 22 temporary (reserved for code gen) ++ s0 23 frame pointer (preserved by C) ++ s1 24 trap pointer (preserved by C) ++ s10 25 allocation pointer (preserved by C) ++ s11 26 allocation limit (preserved by C) ++ Floating-point register map: ++ ft0 - ft7 100 - 107 temporary ++ fs0 - fs1 108 - 109 general purpose (preserved by C) ++ fa0 - fa7 110 - 117 arguments/results ++ fs2 - fs9 118 - 125 arguments/results (preserved by C) ++ fs10 - fs11 126 - 127 general purpose (preserved by C) ++ ft8 - ft11 128 - 131 temporary ++*) ++ ++let int_reg_name = ++ [| "a0"; "a1"; "a2"; "a3"; "a4"; "a5"; "a6"; "a7"; ++ "s2"; "s3"; "s4"; "s5"; "s6"; "s7"; "s8"; "s9"; ++ "t2"; "t3"; "t4"; "t5"; "t6"; ++ "t0"; "t1"; ++ "s0"; "s1"; "s10"; "s11" |] ++ ++let float_reg_name = ++ [| "ft0"; "ft1"; "ft2"; "ft3"; "ft4"; "ft5"; "ft6"; "ft7"; ++ "fs0"; "fs1"; ++ "fa0"; "fa1"; "fa2"; "fa3"; "fa4"; "fa5"; "fa6"; "fa7"; ++ "fs2"; "fs3"; "fs4"; "fs5"; "fs6"; "fs7"; "fs8"; "fs9"; "fs10"; "fs11"; ++ "ft8"; "ft9"; "ft10"; "ft11" |] ++ ++let num_register_classes = 2 ++ ++let register_class r = ++ match r.typ with ++ | Val | Int | Addr -> 0 ++ | Float -> 1 ++ ++let num_available_registers = [| 21; 32 |] ++ ++let first_available_register = [| 0; 100 |] ++ ++let register_name r = ++ if r < 100 then int_reg_name.(r) else float_reg_name.(r - 100) ++ ++let rotate_registers = true ++ ++(* Representation of hard registers by pseudo-registers *) ++ ++let hard_int_reg = ++ let v = Array.make 27 Reg.dummy in ++ for i = 0 to 26 do ++ v.(i) <- Reg.at_location Int (Reg i) ++ done; ++ v ++ ++let hard_float_reg = ++ let v = Array.make 32 Reg.dummy in ++ for i = 0 to 31 do ++ v.(i) <- Reg.at_location Float (Reg(100 + i)) ++ done; ++ v ++ ++let all_phys_regs = ++ Array.append hard_int_reg hard_float_reg ++ ++let phys_reg n = ++ if n < 100 then hard_int_reg.(n) else hard_float_reg.(n - 100) ++ ++let stack_slot slot ty = ++ Reg.at_location ty (Stack slot) ++ ++(* Calling conventions *) ++ ++let calling_conventions ++ first_int last_int first_float last_float make_stack arg = ++ let loc = Array.make (Array.length arg) Reg.dummy in ++ let int = ref first_int in ++ let float = ref first_float in ++ let ofs = ref 0 in ++ for i = 0 to Array.length arg - 1 do ++ match arg.(i).typ with ++ | Val | Int | Addr as ty -> ++ if !int <= last_int then begin ++ loc.(i) <- phys_reg !int; ++ incr int ++ end else begin ++ loc.(i) <- stack_slot (make_stack !ofs) ty; ++ ofs := !ofs + size_int ++ end ++ | Float -> ++ if !float <= last_float then begin ++ loc.(i) <- phys_reg !float; ++ incr float ++ end else begin ++ loc.(i) <- stack_slot (make_stack !ofs) Float; ++ ofs := !ofs + size_float ++ end ++ done; ++ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *) ++ ++let incoming ofs = Incoming ofs ++let outgoing ofs = Outgoing ofs ++let not_supported _ = fatal_error "Proc.loc_results: cannot call" ++ ++let max_arguments_for_tailcalls = 16 ++ ++let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *) ++ ++(* OCaml calling convention: ++ first integer args in a0 .. a7, s2 .. s9 ++ first float args in fa0 .. fa7, fs2 .. fs9 ++ remaining args on stack. ++ Return values in a0 .. a7, s2 .. s9 or fa0 .. fa7, fs2 .. fs9. *) ++ ++let single_regs arg = Array.map (fun arg -> [| arg |]) arg ++let ensure_single_regs res = ++ Array.map (function ++ | [| res |] -> res ++ | _ -> failwith "proc.ensure_single_regs" ++ ) res ++ ++let loc_arguments arg = ++ calling_conventions 0 15 110 125 outgoing arg ++ ++let loc_parameters arg = ++ let (loc, _ofs) = ++ calling_conventions 0 15 110 125 incoming arg ++ in ++ loc ++ ++let loc_results res = ++ let (loc, _ofs) = ++ calling_conventions 0 15 110 125 not_supported res ++ in ++ loc ++ ++(* C calling convention: ++ first integer args in a0 .. a7 ++ first float args in fa0 .. fa7 ++ remaining args on stack. ++ Return values in a0 .. a1 or fa0 .. fa1. *) ++ ++let external_calling_conventions ++ first_int last_int first_float last_float make_stack arg = ++ let loc = Array.make (Array.length arg) [| Reg.dummy |] in ++ let int = ref first_int in ++ let float = ref first_float in ++ let ofs = ref 0 in ++ for i = 0 to Array.length arg - 1 do ++ match arg.(i) with ++ | [| arg |] -> ++ begin match arg.typ with ++ | Val | Int | Addr as ty -> ++ if !int <= last_int then begin ++ loc.(i) <- [| phys_reg !int |]; ++ incr int; ++ incr float; ++ end else begin ++ loc.(i) <- [| stack_slot (make_stack !ofs) ty |]; ++ ofs := !ofs + size_int ++ end ++ | Float -> ++ if !float <= last_float then begin ++ loc.(i) <- [| phys_reg !float |]; ++ incr float; ++ incr int; ++ end else begin ++ loc.(i) <- [| stack_slot (make_stack !ofs) Float |]; ++ ofs := !ofs + size_float ++ end ++ end ++ | [| arg1; arg2 |] -> ++ (* Passing of 64-bit quantities to external functions on 32-bit ++ platform. *) ++ assert (size_int = 4); ++ begin match arg1.typ, arg2.typ with ++ | Int, Int -> ++ int := Misc.align !int 2; ++ if !int <= last_int - 1 then begin ++ let reg_lower = phys_reg !int in ++ let reg_upper = phys_reg (!int + 1) in ++ loc.(i) <- [| reg_lower; reg_upper |]; ++ int := !int + 2 ++ end else begin ++ let size_int64 = 8 in ++ ofs := Misc.align !ofs size_int64; ++ let ofs_lower = !ofs in ++ let ofs_upper = !ofs + size_int in ++ let stack_lower = stack_slot (make_stack ofs_lower) Int in ++ let stack_upper = stack_slot (make_stack ofs_upper) Int in ++ loc.(i) <- [| stack_lower; stack_upper |]; ++ ofs := !ofs + size_int64 ++ end ++ | _ -> ++ let f = function Int -> "I" | Addr -> "A" | Val -> "V" | Float -> "F" in ++ fatal_error (Printf.sprintf "Proc.calling_conventions: bad register \ ++ type(s) for multi-register argument: %s, %s" ++ (f arg1.typ) (f arg2.typ)) ++ end ++ | _ -> ++ fatal_error "Proc.calling_conventions: bad number of register for \ ++ multi-register argument" ++ done; ++ (loc, Misc.align !ofs 16) (* Keep stack 16-aligned. *) ++ ++let loc_external_arguments arg = ++ external_calling_conventions 0 7 110 117 outgoing arg ++ ++let loc_external_results res = ++ let (loc, _ofs) = ++ external_calling_conventions 0 1 110 111 not_supported (single_regs res) ++ in ++ ensure_single_regs loc ++ ++(* Exceptions are in GPR 3 *) ++ ++let loc_exn_bucket = phys_reg 0 ++ ++(* Volatile registers: none *) ++ ++let regs_are_volatile _ = false ++ ++(* Registers destroyed by operations *) ++ ++let destroyed_at_c_call = ++ Array.of_list(List.map phys_reg ++ [0; 1; 2; 3; 4; 5; 6; 7; 16; 17; 18; 19; 20; (* 21; 22; *) ++ 100; 101; 102; 103; 104; 105; 106; 107; 110; 111; 112; 113; 114; 115; 116; ++ 117; 128; 129; 130; 131]) ++ ++let destroyed_at_oper = function ++ | Iop(Icall_ind _ | Icall_imm _ | Iextcall{alloc = true; _}) -> all_phys_regs ++ | Iop(Iextcall{alloc = false; _}) -> destroyed_at_c_call ++ | _ -> [||] ++ ++let destroyed_at_raise = all_phys_regs ++ ++let destroyed_at_reloadretaddr = [| |] (* CHECK *) ++ ++(* Maximal register pressure *) ++ ++let safe_register_pressure = function ++ | Iextcall _ -> 15 ++ | _ -> 21 ++ ++let max_register_pressure = function ++ | Iextcall _ -> [| 15; 18 |] ++ | _ -> [| 21; 30 |] ++ ++(* Pure operations (without any side effect besides updating their result ++ registers). *) ++ ++let op_is_pure = function ++ | Icall_ind _ | Icall_imm _ | Itailcall_ind _ | Itailcall_imm _ ++ | Iextcall _ | Istackoffset _ | Istore _ | Ialloc _ ++ | Iintop(Icheckbound _) | Iintop_imm(Icheckbound _, _) -> false ++ | Ispecific(Imultaddf _ | Imultsubf _) -> true ++ | _ -> true ++ ++(* Layout of the stack *) ++ ++let num_stack_slots = [| 0; 0 |] ++let contains_calls = ref false ++ ++let frame_required () = ++ !contains_calls || num_stack_slots.(0) > 0 || num_stack_slots.(1) > 0 ++ ++let prologue_required () = ++ frame_required () ++ ++(* See ++ https://github.com/riscv/riscv-elf-psabi-doc/blob/master/riscv-elf.md *) ++ ++let int_dwarf_reg_numbers = ++ [| 10; 11; 12; 13; 14; 15; 16; 17; ++ 18; 19; 20; 21; 22; 23; 24; 25; ++ 7; 29; 29; 30; 31; ++ 5; 6; 8; 9; 26; 27; ++ |] ++ ++let float_dwarf_reg_numbers = ++ [| 32; 33; 34; 35; 36; 37; 38; 39; ++ 40; 41; ++ 42; 43; 44; 45; 46; 47; 48; 49; ++ 50; 51; 52; 53; 54; 55; 56; 57; ++ 58; 59; ++ 60; 61; 62; 63; ++ |] ++ ++let dwarf_register_numbers ~reg_class = ++ match reg_class with ++ | 0 -> int_dwarf_reg_numbers ++ | 1 -> float_dwarf_reg_numbers ++ | _ -> Misc.fatal_errorf "Bad register class %d" reg_class ++ ++let stack_ptr_dwarf_register_number = 2 ++ ++(* Calling the assembler *) ++ ++let assemble_file infile outfile = ++ Ccomp.command ++ (Config.asm ^ " -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile) ++ ++let init () = () +diff --git a/asmcomp/riscv/reload.ml b/asmcomp/riscv/reload.ml +new file mode 100644 +index 000000000..85b970342 +--- /dev/null ++++ b/asmcomp/riscv/reload.ml +@@ -0,0 +1,16 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Reloading for the RISC-V *) ++ ++let fundecl f = ++ (new Reloadgen.reload_generic)#fundecl f +diff --git a/asmcomp/riscv/scheduling.ml b/asmcomp/riscv/scheduling.ml +new file mode 100644 +index 000000000..e436be1cc +--- /dev/null ++++ b/asmcomp/riscv/scheduling.ml +@@ -0,0 +1,19 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Instruction scheduling for the RISC-V *) ++ ++let _ = let module M = Schedgen in () (* to create a dependency *) ++ ++(* Scheduling is turned off. *) ++ ++let fundecl f = f +diff --git a/asmcomp/riscv/selection.ml b/asmcomp/riscv/selection.ml +new file mode 100644 +index 000000000..62fccb648 +--- /dev/null ++++ b/asmcomp/riscv/selection.ml +@@ -0,0 +1,71 @@ ++(***********************************************************************) ++(* *) ++(* OCaml *) ++(* *) ++(* Nicolas Ojeda Bar *) ++(* *) ++(* Copyright 2016 Institut National de Recherche en Informatique et *) ++(* en Automatique. All rights reserved. This file is distributed *) ++(* under the terms of the Q Public License version 1.0. *) ++(* *) ++(***********************************************************************) ++ ++(* Instruction selection for the RISC-V processor *) ++ ++open Cmm ++open Arch ++open Mach ++ ++(* Instruction selection *) ++ ++class selector = object (self) ++ ++inherit Selectgen.selector_generic as super ++ ++method is_immediate n = is_immediate n ++ ++method select_addressing _ = function ++ | Cop(Cadda, [arg; Cconst_int (n, _)], _) when self#is_immediate n -> ++ (Iindexed n, arg) ++ | Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int (n, _)], _)], dbg) when self#is_immediate n -> ++ (Iindexed n, Cop(Caddi, [arg1; arg2], dbg)) ++ | arg -> ++ (Iindexed 0, arg) ++ ++method! select_operation op args dbg = ++ match (op, args) with ++ (* RISC-V does not support immediate operands for multiply high *) ++ | (Cmulhi, _) -> (Iintop Imulh, args) ++ (* Recognize (neg-)mult-add and (neg-)mult-sub instructions *) ++ | (Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3]) ++ | (Caddf, [arg3; Cop(Cmulf, [arg1; arg2], _)]) -> ++ (Ispecific (Imultaddf false), [arg1; arg2; arg3]) ++ | (Csubf, [Cop(Cmulf, [arg1; arg2], _); arg3]) -> ++ (Ispecific (Imultsubf false), [arg1; arg2; arg3]) ++ | (Cnegf, [Cop(Csubf, [Cop(Cmulf, [arg1; arg2], _); arg3], _)]) -> ++ (Ispecific (Imultsubf true), [arg1; arg2; arg3]) ++ | (Cnegf, [Cop(Caddf, [Cop(Cmulf, [arg1; arg2], _); arg3], _)]) -> ++ (Ispecific (Imultaddf true), [arg1; arg2; arg3]) ++ (* RISC-V does not support immediate operands for comparison operators *) ++ | (Ccmpi comp, args) -> (Iintop(Icomp (Isigned comp)), args) ++ | (Ccmpa comp, args) -> (Iintop(Icomp (Iunsigned comp)), args) ++ | (Cmuli, _) -> (Iintop Imul, args) ++ | _ -> ++ super#select_operation op args dbg ++ ++(* Instruction selection for conditionals *) ++ ++method! select_condition = function ++ Cop(Ccmpi cmp, args, _) -> ++ (Iinttest(Isigned cmp), Ctuple args) ++ | Cop(Ccmpa cmp, args, _) -> ++ (Iinttest(Iunsigned cmp), Ctuple args) ++ | Cop(Ccmpf cmp, args, _) -> ++ (Ifloattest cmp, Ctuple args) ++ | Cop(Cand, [arg; Cconst_int (1, _)], _) -> ++ (Ioddtest, arg) ++ | arg -> ++ (Itruetest, arg) ++end ++ ++let fundecl f = (new selector)#emit_fundecl f +diff --git a/configure b/configure +index c364be4e3a365e01c667023ea23238037446a3c3..75f1d15cb6847544bdf00c5fd8d12ce958072e21 100755 +GIT binary patch +delta 168 +zcmeC2qnZ?OvTGQXWV%3~J?D->52m!#&} +m=49rTR!pz&Ws}`*@R#+WI9m-^c{{%-8xXT^=NIMpWefm-I6Vgd + +delta 67 +zcmcaGS+R4HVnYjK3sVbo3(FQ(q4(40y<`>J9{!&7H7_IAbVhe}>Fw|SvOW@@t|-E$ +WI9*SajjjE^C */ ++/* */ ++/* Copyright 2017 Institut National de Recherche en Informatique et */ ++/* en Automatique. All rights reserved. This file is distributed */ ++/* under the terms of the GNU Library General Public License, with */ ++/* the special exception on linking described in file ../LICENSE. */ ++/* */ ++/***********************************************************************/ ++ ++/* Asm part of the runtime system, RISC-V processor, 64-bit mode */ ++/* Must be preprocessed by cpp */ ++ ++#define TRAP_PTR s1 ++#define ALLOC_PTR s10 ++#define ALLOC_LIMIT s11 ++#define TMP0 t0 ++#define TMP1 t1 ++#define ARG t2 ++ ++#if defined(MODEL_riscv64) ++#define store sd ++#define load ld ++#define WSZ 8 ++#else ++#define store sw ++#define load lw ++#define WSZ 4 ++#endif ++ ++#if defined(__PIC__) ++ .option pic ++#define PLT(r) r@plt ++#else ++ .option nopic ++#define PLT(r) r ++#endif ++ ++ .section .text ++/* Invoke the garbage collector. */ ++ ++ .globl caml_system__code_begin ++caml_system__code_begin: ++ ++ .align 2 ++ .globl caml_call_gc ++ .type caml_call_gc, @function ++caml_call_gc: ++ /* Record return address */ ++ store ra, caml_last_return_address, TMP0 ++ /* Record lowest stack address */ ++ mv TMP1, sp ++ store sp, caml_bottom_of_stack, TMP0 ++.Lcaml_call_gc: ++ /* Set up stack space, saving return address */ ++ /* (1 reg for RA, 1 reg for FP, 21 allocatable int regs, 20 caller-save float regs) * 8 */ ++ /* + 1 for alignment */ ++ addi sp, sp, -0x160 ++ mv s0, sp ++ store ra, 0x8(sp) ++ store s0, 0x0(sp) ++ /* Save allocatable integer registers on the stack, ++ in the order given in proc.ml */ ++ store a0, 0x10(sp) ++ store a1, 0x18(sp) ++ store a2, 0x20(sp) ++ store a3, 0x28(sp) ++ store a4, 0x30(sp) ++ store a5, 0x38(sp) ++ store a6, 0x40(sp) ++ store a7, 0x48(sp) ++ store s2, 0x50(sp) ++ store s3, 0x58(sp) ++ store s4, 0x60(sp) ++ store s5, 0x68(sp) ++ store s6, 0x70(sp) ++ store s7, 0x78(sp) ++ store s8, 0x80(sp) ++ store s9, 0x88(sp) ++ store t2, 0x90(sp) ++ store t3, 0x98(sp) ++ store t4, 0xa0(sp) ++ store t5, 0xa8(sp) ++ store t6, 0xb0(sp) ++ /* Save caller-save floating-point registers on the stack ++ (callee-saves are preserved by caml_garbage_collection) */ ++ fsd ft0, 0xb8(sp) ++ fsd ft1, 0xc0(sp) ++ fsd ft2, 0xc8(sp) ++ fsd ft3, 0xd0(sp) ++ fsd ft4, 0xd8(sp) ++ fsd ft5, 0xe0(sp) ++ fsd ft6, 0xe8(sp) ++ fsd ft7, 0xf0(sp) ++ fsd fa0, 0xf8(sp) ++ fsd fa1, 0x100(sp) ++ fsd fa2, 0x108(sp) ++ fsd fa3, 0x110(sp) ++ fsd fa4, 0x118(sp) ++ fsd fa5, 0x120(sp) ++ fsd fa6, 0x128(sp) ++ fsd fa7, 0x130(sp) ++ fsd ft8, 0x138(sp) ++ fsd ft9, 0x140(sp) ++ fsd ft9, 0x148(sp) ++ fsd ft10, 0x150(sp) ++ fsd ft11, 0x158(sp) ++ /* Store pointer to saved integer registers in caml_gc_regs */ ++ addi TMP1, sp, 16 ++ store TMP1, caml_gc_regs, TMP0 ++ /* Save current allocation pointer for debugging purposes */ ++ store ALLOC_PTR, caml_young_ptr, TMP0 ++ /* Save trap pointer in case an exception is raised during GC */ ++ store TRAP_PTR, caml_exception_pointer, TMP0 ++ /* Call the garbage collector */ ++ call PLT(caml_garbage_collection) ++ /* Restore registers */ ++ load a0, 0x10(sp) ++ load a1, 0x18(sp) ++ load a2, 0x20(sp) ++ load a3, 0x28(sp) ++ load a4, 0x30(sp) ++ load a5, 0x38(sp) ++ load a6, 0x40(sp) ++ load a7, 0x48(sp) ++ load s2, 0x50(sp) ++ load s3, 0x58(sp) ++ load s4, 0x60(sp) ++ load s5, 0x68(sp) ++ load s6, 0x70(sp) ++ load s7, 0x78(sp) ++ load s8, 0x80(sp) ++ load s9, 0x88(sp) ++ load t2, 0x90(sp) ++ load t3, 0x98(sp) ++ load t4, 0xa0(sp) ++ load t5, 0xa8(sp) ++ load t6, 0xb0(sp) ++ fld ft0, 0xb8(sp) ++ fld ft1, 0xc0(sp) ++ fld ft2, 0xc8(sp) ++ fld ft3, 0xd0(sp) ++ fld ft4, 0xd8(sp) ++ fld ft5, 0xe0(sp) ++ fld ft6, 0xe8(sp) ++ fld ft7, 0xf0(sp) ++ fld fa0, 0xf8(sp) ++ fld fa1, 0x100(sp) ++ fld fa2, 0x108(sp) ++ fld fa3, 0x110(sp) ++ fld fa4, 0x118(sp) ++ fld fa5, 0x120(sp) ++ fld fa6, 0x128(sp) ++ fld fa7, 0x130(sp) ++ fld ft8, 0x138(sp) ++ fld ft9, 0x140(sp) ++ fld ft9, 0x148(sp) ++ fld ft10, 0x150(sp) ++ fld ft11, 0x158(sp) ++ /* Reload new allocation pointer and allocation limit */ ++ load ALLOC_PTR, caml_young_ptr ++ load ALLOC_LIMIT, caml_young_limit ++ /* Free stack space and return to caller */ ++ load ra, 0x8(sp) ++ load s0, 0x0(sp) ++ addi sp, sp, 0x160 ++ ret ++ .size caml_call_gc, .-caml_call_gc ++ ++/* Call a C function from OCaml */ ++/* Function to call is in ARG */ ++ ++ .align 2 ++ .globl caml_c_call ++ .type caml_c_call, @function ++caml_c_call: ++ /* Preserve return address in callee-save register s2 */ ++ mv s2, ra ++ /* Record lowest stack address and return address */ ++ store ra, caml_last_return_address, TMP0 ++ store sp, caml_bottom_of_stack, TMP0 ++ /* Make the exception handler alloc ptr available to the C code */ ++ store ALLOC_PTR, caml_young_ptr, TMP0 ++ store TRAP_PTR, caml_exception_pointer, TMP0 ++ /* Call the function */ ++ jalr ARG ++ /* Reload alloc ptr and alloc limit */ ++ load ALLOC_PTR, caml_young_ptr ++ load ALLOC_LIMIT, caml_young_limit ++ /* Return */ ++ jr s2 ++ .size caml_c_call, .-caml_c_call ++ ++/* Raise an exception from OCaml */ ++ .align 2 ++ .globl caml_raise_exn ++ .type caml_raise_exn, @function ++caml_raise_exn: ++ /* Test if backtrace is active */ ++ load TMP1, caml_backtrace_active ++ bnez TMP1, 2f ++1: /* Cut stack at current trap handler */ ++ mv sp, TRAP_PTR ++ /* Pop previous handler and jump to it */ ++ load TMP1, 8(sp) ++ load TRAP_PTR, 0(sp) ++ addi sp, sp, 16 ++ jr TMP1 ++2: /* Preserve exception bucket in callee-save register s2 */ ++ mv s2, a0 ++ /* Stash the backtrace */ ++ mv a1, ra ++ mv a2, sp ++ mv a3, TRAP_PTR ++ call PLT(caml_stash_backtrace) ++ /* Restore exception bucket and raise */ ++ mv a0, s2 ++ j 1b ++ .size caml_raise_exn, .-caml_raise_exn ++ ++ .globl caml_reraise_exn ++ .type caml_reraise_exn, @function ++ ++/* Raise an exception from C */ ++ ++ .align 2 ++ .globl caml_raise_exception ++ .type caml_raise_exception, @function ++caml_raise_exception: ++ load TRAP_PTR, caml_exception_pointer ++ load ALLOC_PTR, caml_young_ptr ++ load ALLOC_LIMIT, caml_young_limit ++ load TMP1, caml_backtrace_active ++ bnez TMP1, 2f ++1: /* Cut stack at current trap handler */ ++ mv sp, TRAP_PTR ++ load TMP1, 8(sp) ++ load TRAP_PTR, 0(sp) ++ addi sp, sp, 16 ++ jr TMP1 ++2: /* Preserve exception bucket in callee-save register s2 */ ++ mv s2, a0 ++ load a1, caml_last_return_address ++ load a2, caml_bottom_of_stack ++ mv a3, TRAP_PTR ++ call PLT(caml_stash_backtrace) ++ mv a0, s2 ++ j 1b ++ .size caml_raise_exception, .-caml_raise_exception ++ ++/* Start the OCaml program */ ++ ++ .align 2 ++ .globl caml_start_program ++ .type caml_start_program, @function ++caml_start_program: ++ ++ la ARG, caml_program ++ /* Code shared with caml_callback* */ ++ /* Address of OCaml code to call is in ARG */ ++ /* Arguments to the OCaml code are in a0 ... a7 */ ++.Ljump_to_caml: ++ /* Set up stack frame and save callee-save registers */ ++ addi sp, sp, -0xd0 ++ store ra, 0xc0(sp) ++ store s0, 0x0(sp) ++ store s1, 0x8(sp) ++ store s2, 0x10(sp) ++ store s3, 0x18(sp) ++ store s4, 0x20(sp) ++ store s5, 0x28(sp) ++ store s6, 0x30(sp) ++ store s7, 0x38(sp) ++ store s8, 0x40(sp) ++ store s9, 0x48(sp) ++ store s10, 0x50(sp) ++ store s11, 0x58(sp) ++ fsd fs0, 0x60(sp) ++ fsd fs1, 0x68(sp) ++ fsd fs2, 0x70(sp) ++ fsd fs3, 0x78(sp) ++ fsd fs4, 0x80(sp) ++ fsd fs5, 0x88(sp) ++ fsd fs6, 0x90(sp) ++ fsd fs7, 0x98(sp) ++ fsd fs8, 0xa0(sp) ++ fsd fs9, 0xa8(sp) ++ fsd fs10, 0xb0(sp) ++ fsd fs11, 0xb8(sp) ++ addi sp, sp, -32 ++ /* Setup a callback link on the stack */ ++ load TMP1, caml_bottom_of_stack ++ store TMP1, 0(sp) ++ load TMP1, caml_last_return_address ++ store TMP1, 8(sp) ++ load TMP1, caml_gc_regs ++ store TMP1, 16(sp) ++ /* set up a trap frame */ ++ addi sp, sp, -16 ++ load TMP1, caml_exception_pointer ++ store TMP1, 0(sp) ++ lla TMP0, .Ltrap_handler ++ store TMP0, 8(sp) ++ mv TRAP_PTR, sp ++ load ALLOC_PTR, caml_young_ptr ++ load ALLOC_LIMIT, caml_young_limit ++ store x0, caml_last_return_address, TMP0 ++ jalr ARG ++.Lcaml_retaddr: /* pop trap frame, restoring caml_exception_pointer */ ++ load TMP1, 0(sp) ++ store TMP1, caml_exception_pointer, TMP0 ++ addi sp, sp, 16 ++.Lreturn_result: /* pop callback link, restoring global variables */ ++ load TMP1, 0(sp) ++ store TMP1, caml_bottom_of_stack, TMP0 ++ load TMP1, 8(sp) ++ store TMP1, caml_last_return_address, TMP0 ++ load TMP1, 16(sp) ++ store TMP1, caml_gc_regs, TMP0 ++ addi sp, sp, 32 ++ /* Update allocation pointer */ ++ store ALLOC_PTR, caml_young_ptr, TMP0 ++ /* reload callee-save registers and return */ ++ load ra, 0xc0(sp) ++ load s0, 0x0(sp) ++ load s1, 0x8(sp) ++ load s2, 0x10(sp) ++ load s3, 0x18(sp) ++ load s4, 0x20(sp) ++ load s5, 0x28(sp) ++ load s6, 0x30(sp) ++ load s7, 0x38(sp) ++ load s8, 0x40(sp) ++ load s9, 0x48(sp) ++ load s10, 0x50(sp) ++ load s11, 0x58(sp) ++ fld fs0, 0x60(sp) ++ fld fs1, 0x68(sp) ++ fld fs2, 0x70(sp) ++ fld fs3, 0x78(sp) ++ fld fs4, 0x80(sp) ++ fld fs5, 0x88(sp) ++ fld fs6, 0x90(sp) ++ fld fs7, 0x98(sp) ++ fld fs8, 0xa0(sp) ++ fld fs9, 0xa8(sp) ++ fld fs10, 0xb0(sp) ++ fld fs11, 0xb8(sp) ++ addi sp, sp, 0xd0 ++ ret ++.Ltrap_handler: ++ store TRAP_PTR, caml_exception_pointer, TMP0 ++ ori a0, a0, 2 ++ j .Lreturn_result ++ .size caml_start_program, .-caml_start_program ++ ++/* Callback from C to OCaml */ ++ ++ .align 2 ++ .globl caml_callback_exn ++ .type caml_callback_exn, @function ++caml_callback_exn: ++ /* Initial shuffling of arguments (a0 = closure, a1 = first arg) */ ++ mv TMP1, a0 ++ mv a0, a1 /* a0 = first arg */ ++ mv a1, TMP1 /* a1 = closure environment */ ++ load ARG, 0(TMP1) /* code pointer */ ++ j .Ljump_to_caml ++ .size caml_callback_exn, .-caml_callback_exn ++ ++ .align 2 ++ .globl caml_callback2_exn ++ .type caml_callback2_exn, @function ++caml_callback2_exn: ++ /* Initial shuffling of arguments (a0 = closure, a1 = arg1, a2 = arg2) */ ++ mv TMP1, a0 ++ mv a0, a1 ++ mv a1, a2 ++ mv a2, TMP1 ++ la ARG, caml_apply2 ++ j .Ljump_to_caml ++ .size caml_callback2_exn, .-caml_callback2_exn ++ ++ .align 2 ++ .globl caml_callback3_exn ++ .type caml_callback3_exn, @function ++caml_callback3_exn: ++ /* Initial shuffling of argumnets */ ++ /* (a0 = closure, a1 = arg1, a2 = arg2, a3 = arg3) */ ++ mv TMP1, a0 ++ mv a0, a1 ++ mv a1, a2 ++ mv a2, a3 ++ mv a3, TMP1 ++ la ARG, caml_apply3 ++ j .Ljump_to_caml ++ .size caml_callback3_exn, .-caml_callback3_exn ++ ++ .align 2 ++ .globl caml_ml_array_bound_error ++ .type caml_ml_array_bound_error, @function ++caml_ml_array_bound_error: ++ /* Load address of [caml_array_bound_error] in ARG */ ++ la ARG, caml_array_bound_error ++ /* Call that function */ ++ tail caml_c_call ++ .size caml_ml_array_bound_error, .-caml_ml_array_bound_error ++ ++ .globl caml_system__code_end ++caml_system__code_end: ++ ++/* GC roots for callback */ ++ ++ .section .data ++ .align 3 ++ .globl caml_system__frametable ++ .type caml_system__frametable, @object ++caml_system__frametable: ++ .quad 1 /* one descriptor */ ++ .quad .Lcaml_retaddr /* return address into callback */ ++ .short -1 /* negative frame size => use callback link */ ++ .short 0 /* no roots */ ++ .align 3 ++ .size caml_system__frametable, .-caml_system__frametable +diff --git a/testsuite/tools/asmgen_riscv.S b/testsuite/tools/asmgen_riscv.S +new file mode 100644 +index 000000000..8b34a40f8 +--- /dev/null ++++ b/testsuite/tools/asmgen_riscv.S +@@ -0,0 +1,87 @@ ++/***********************************************************************/ ++/* */ ++/* OCaml */ ++/* */ ++/* Nicolas Ojeda Bar */ ++/* */ ++/* Copyright 2019 Institut National de Recherche en Informatique et */ ++/* en Automatique. All rights reserved. This file is distributed */ ++/* under the terms of the GNU Library General Public License, with */ ++/* the special exception on linking described in file ../LICENSE. */ ++/* */ ++/***********************************************************************/ ++ ++#define STORE sd ++#define LOAD ld ++ ++ .globl call_gen_code ++ .align 2 ++call_gen_code: ++ /* Set up stack frame and save callee-save registers */ ++ ADDI sp, sp, -208 ++ STORE ra, 192(sp) ++ STORE s0, 0(sp) ++ STORE s1, 8(sp) ++ STORE s2, 16(sp) ++ STORE s3, 24(sp) ++ STORE s4, 32(sp) ++ STORE s5, 40(sp) ++ STORE s6, 48(sp) ++ STORE s7, 56(sp) ++ STORE s8, 64(sp) ++ STORE s9, 72(sp) ++ STORE s10, 80(sp) ++ STORE s11, 88(sp) ++ fsd fs0, 96(sp) ++ fsd fs1, 104(sp) ++ fsd fs2, 112(sp) ++ fsd fs3, 120(sp) ++ fsd fs4, 128(sp) ++ fsd fs5, 136(sp) ++ fsd fs6, 144(sp) ++ fsd fs7, 152(sp) ++ fsd fs8, 160(sp) ++ fsd fs9, 168(sp) ++ fsd fs10, 176(sp) ++ fsd fs11, 184(sp) ++ /* Shuffle arguments */ ++ mv t0, a0 ++ mv a0, a1 ++ mv a1, a2 ++ mv a2, a3 ++ mv a3, a4 ++ /* Call generated asm */ ++ jalr t0 ++ /* Reload callee-save registers and return address */ ++ LOAD ra, 192(sp) ++ LOAD s0, 0(sp) ++ LOAD s1, 8(sp) ++ LOAD s2, 16(sp) ++ LOAD s3, 24(sp) ++ LOAD s4, 32(sp) ++ LOAD s5, 40(sp) ++ LOAD s6, 48(sp) ++ LOAD s7, 56(sp) ++ LOAD s8, 64(sp) ++ LOAD s9, 72(sp) ++ LOAD s10, 80(sp) ++ LOAD s11, 88(sp) ++ fld fs0, 96(sp) ++ fld fs1, 104(sp) ++ fld fs2, 112(sp) ++ fld fs3, 120(sp) ++ fld fs4, 128(sp) ++ fld fs5, 136(sp) ++ fld fs6, 144(sp) ++ fld fs7, 152(sp) ++ fld fs8, 160(sp) ++ fld fs9, 168(sp) ++ fld fs10, 176(sp) ++ fld fs11, 184(sp) ++ addi sp, sp, 208 ++ ret ++ ++ .globl caml_c_call ++ .align 2 ++caml_c_call: ++ jr t2 +-- +2.23.0 + diff --git a/ocaml.spec b/ocaml.spec index bb793d0..d994957 100644 --- a/ocaml.spec +++ b/ocaml.spec @@ -30,7 +30,7 @@ #global rcver +rc2 Name: ocaml -Version: 4.08.1 +Version: 4.09.0 Release: 1%{?dist} Summary: OCaml compiler and programming environment @@ -39,7 +39,7 @@ License: QPL and (LGPLv2+ with exceptions) URL: http://www.ocaml.org -Source0: http://caml.inria.fr/pub/distrib/ocaml-4.08/ocaml-%{version}%{rcver}.tar.xz +Source0: http://caml.inria.fr/pub/distrib/ocaml-4.09/ocaml-%{version}%{rcver}.tar.xz # IMPORTANT NOTE: # @@ -50,21 +50,29 @@ Source0: http://caml.inria.fr/pub/distrib/ocaml-4.08/ocaml-%{version}%{rc # # https://pagure.io/fedora-ocaml # -# Current branch: fedora-32-4.08.1 +# Current branch: fedora-32-4.09.0 # # ALTERNATIVELY add a patch to the end of the list (leaving the # existing patches unchanged) adding a comment to note that it should # be incorporated into the git repo at a later time. # +# Upstream patches after 4.09.0 was released. +Patch0001: 0001-increment-version-number-after-tagging-4.09.0.patch +Patch0002: 0002-mark-the-release-in-the-Changes.patch +Patch0003: 0003-Merge-pull-request-8954-from-Armael-fix-toplevel-sub.patch +Patch0004: 0004-Merge-pull-request-8979-from-gasche-fix-Makefile.men.patch +Patch0005: 0005-Run-whole-of-gen_primitives.sh-with-LC_ALL-C.patch +Patch0006: 0006-Merge-pull-request-8988-from-Octachron-fix_ocamlnat.patch +Patch0007: 0007-Fix-failure-to-install-tools-links.patch +Patch0008: 0008-Merge-pull-request-8996-from-dra27-win-reconfigure.patch # Fedora-specific downstream patches. -Patch0001: 0001-Don-t-add-rpaths-to-libraries.patch -Patch0002: 0002-configure-Allow-user-defined-C-compiler-flags.patch -Patch0003: 0003-configure-Remove-incorrect-assumption-about-cross-co.patch +Patch0009: 0009-Don-t-add-rpaths-to-libraries.patch +Patch0010: 0010-configure-Allow-user-defined-C-compiler-flags.patch +Patch0011: 0011-configure-Remove-incorrect-assumption-about-cross-co.patch # Out of tree patch for RISC-V support. # https://github.com/nojb/riscv-ocaml -Patch0004: 0004-Add-RISC-V-backend.patch -Patch0005: 0005-riscv-Emit-debug-info.patch +Patch0012: 0012-Add-riscv64-backend.patch BuildRequires: gcc BuildRequires: autoconf @@ -381,6 +389,9 @@ find $RPM_BUILD_ROOT \( -name '*.cmt' -o -name '*.cmti' \) -a -delete %changelog +* Thu Dec 05 2019 Richard W.M. Jones - 4.09.0-1 +- OCaml 4.09.0 final. + * Fri Aug 16 2019 Richard W.M. Jones - 4.08.1-1 - OCaml 4.08.1 final. diff --git a/sources b/sources index af4a53c..79a0e77 100644 --- a/sources +++ b/sources @@ -1 +1 @@ -SHA512 (ocaml-4.08.1.tar.xz) = ebcc065c4cc4bf16256c6dad6795d9660d355c5facbe432591811dc4aa02af6498899219ec4e786358dffcfc38c68f5af2d1c3787d418a78732ec37e84a28cd4 +SHA512 (ocaml-4.09.0.tar.xz) = 5cd745802ee53ab85ee676a20fbb28985ba68965df1d7242de5763d982b0a744951da742615fe478c4d3c98b34531632e3a71de89da6c717ccd90cc01e6fff26