Remove SPARC backend

master
Mark Shinwell 2017-04-10 09:18:13 +01:00
parent 80e7529be5
commit 3efe66e043
25 changed files with 12 additions and 1858 deletions

View File

@ -20,6 +20,9 @@ Working version
bundles.
(whitequark)
* GPR#659: Remove support for SPARC native code generation
(Mark Shinwell)
### Standard library:
- PR#1771, PR#7309, GPR#1026: Add update to maps. Allows to update a

View File

@ -183,10 +183,6 @@ On a 64-bit POWER architecture host running Linux, OCaml only operates in a
./configure -cc "acc -fast" -libs "-lucb"
* For Sun Solaris on Sparc 64bit, to compile natively (32bit only)
./configure -cc "gcc -m32" -as "as -32" -aspp "gcc -m32 -c"
* For AIX 4.3 with the IBM compiler `xlc`:
./configure -cc "xlc_r -D_AIX43 -Wl,-bexpall,-brtl -qmaxmem=8192"

View File

@ -54,7 +54,7 @@ include stdlib/StdlibModules
CAMLC=$(CAMLRUN) boot/ocamlc -g -nostdlib -I boot -use-prims byterun/primitives
CAMLOPT=$(CAMLRUN) ./ocamlopt -g -nostdlib -I stdlib -I otherlibs/dynlink
ARCHES=amd64 i386 arm arm64 power sparc s390x
ARCHES=amd64 i386 arm arm64 power s390x
INCLUDES=-I utils -I parsing -I typing -I bytecomp -I middle_end \
-I middle_end/base_types -I asmcomp -I driver -I toplevel

View File

@ -33,7 +33,6 @@ AMD64:: FreeBSD, OpenBSD, NetBSD
IA32 (Pentium):: NetBSD, OpenBSD, Solaris 9
PowerPC:: NetBSD
ARM:: NetBSD
SPARC:: Solaris, Linux, NetBSD
Other operating systems for the processors above have not been tested, but
the compiler may work under other operating systems with little work.

View File

@ -1,33 +0,0 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Gallium, INRIA Rocquencourt *)
(* *)
(* Copyright 2014 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* CSE for Sparc *)
open Mach
open CSEgen
class cse = object
inherit cse_generic (* as super *)
method! is_cheap_operation op =
match op with
| Iconst_int n -> n <= 4095n && n >= -4096n
| _ -> false
end
let fundecl f =
(new cse)#fundecl f

View File

@ -1,17 +0,0 @@
# Supported platforms
SPARC v8 and up, in 32-bit mode.
Operating systems: Solaris, Linux
(abandoned since major Linux distributions no longer support SPARC).
Status of this port: nearly abandoned
(no hardware or virtual machine available for testing).
# Reference documents
* Instruction set architecture:
_The SPARC Architecture Manual_ version 8.
* ELF application binary interface:
_System V Application Binary Interface,
SPARC Processor Supplement_

View File

@ -1,83 +0,0 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Specific operations for the Sparc processor *)
open Format
(* SPARC V8 adds multiply and divide.
SPARC V9 adds double precision float operations, conditional
move, and more instructions that are only useful in 64 bit mode.
Sun calls 32 bit V9 "V8+". *)
type arch_version = SPARC_V7 | SPARC_V8 | SPARC_V9
let arch_version = ref SPARC_V7
let command_line_options =
[ "-march=v8", Arg.Unit (fun () -> arch_version := SPARC_V8),
" Generate code for SPARC V8 processors";
"-march=v9", Arg.Unit (fun () -> arch_version := SPARC_V9),
" Generate code for SPARC V9 processors" ]
type specific_operation = unit (* None worth mentioning *)
let spacetime_node_hole_pointer_is_live_before _specific_op = false
(* Addressing modes *)
type addressing_mode =
Ibased of string * int (* symbol + displ *)
| Iindexed of int (* reg + displ *)
(* Sizes, endianness *)
let big_endian = true
let size_addr = 4
let size_int = 4
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
Ibased(s, n) -> Ibased(s, n + delta)
| Iindexed n -> Iindexed(n + delta)
let num_args_addressing = function
Ibased _ -> 0
| Iindexed _ -> 1
(* Printing operations and addressing modes *)
let print_addressing printreg addr ppf arg =
match addr with
| Ibased(s, n) ->
let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
fprintf ppf "\"%s\"%s" s idx
| 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 =
Misc.fatal_error "Arch_sparc.print_specific_operation"

View File

@ -1,771 +0,0 @@
#2 "asmcomp/sparc/emit.mlp"
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Emission of Sparc assembly code *)
open Misc
open Cmm
open Arch
open Proc
open Reg
open Mach
open Linearize
open Emitaux
(* Solaris vs. the other ports *)
let solaris = Config.system = "solaris"
(* Tradeoff between code size and code speed *)
let fastcode_flag = ref true
(* Layout of the stack *)
(* Always keep the stack 8-aligned.
Always leave 96 bytes at the bottom of the stack *)
let stack_offset = ref 0
let frame_size () =
let size =
!stack_offset +
4 * num_stack_slots.(0) + 8 * num_stack_slots.(1) +
(if !contains_calls then 4 else 0) in
Misc.align size 8
let slot_offset loc cl =
match loc with
Incoming n -> frame_size() + n + 96
| Local n ->
if cl = 0
then !stack_offset + num_stack_slots.(1) * 8 + n * 4 + 96
else !stack_offset + n * 8 + 96
| Outgoing n -> n + 96
(* Return the other register in a register pair *)
let next_in_pair = function
{loc = Reg r; typ = (Int | Addr | Val)} -> phys_reg (r + 1)
| {loc = Reg r; typ = Float} -> phys_reg (r + 16)
| _ -> fatal_error "Emit.next_in_pair"
(* Symbols are prefixed with _ under SunOS *)
let symbol_prefix =
if Config.system = "sunos" then "_" else ""
let emit_symbol s =
if String.length s >= 1 && s.[0] = '.'
then emit_string s
else begin emit_string symbol_prefix; Emitaux.emit_symbol '$' s end
let emit_size lbl =
if Config.system = "solaris" then
` .size {emit_symbol lbl},.-{emit_symbol lbl}\n`
let rodata () =
if Config.system = "solaris" (* || Config.system = "linux" *)
(* || Config.system = "gnu" *) then
` .section \".rodata\"\n`
else
` .data\n`
(* Check if an integer or native integer is an immediate operand *)
let is_immediate n =
n <= 4095 && n >= -4096
let is_native_immediate n =
n <= Nativeint.of_int 4095 && n >= Nativeint.of_int (-4096)
(* Output a label *)
let label_prefix =
if Config.system = "sunos" then "L" else ".L"
let emit_label lbl =
emit_string label_prefix; emit_int lbl
(* Output a pseudo-register *)
let emit_reg r =
match r.loc with
Reg r -> emit_string (register_name r)
| _ -> fatal_error "Emit.emit_reg"
(* Output a stack reference *)
let emit_stack r =
match r.loc with
Stack s ->
let ofs = slot_offset s (register_class r) in `[%sp + {emit_int ofs}]`
| _ -> fatal_error "Emit.emit_stack"
(* Output a load *)
let emit_load instr addr arg dst =
match addr with
Ibased(s, 0) ->
` sethi %hi({emit_symbol s}), %g1\n`;
` {emit_string instr} [%g1 + %lo({emit_symbol s})], {emit_reg dst}\n`
| Ibased(s, ofs) ->
` sethi %hi({emit_symbol s} + {emit_int ofs}), %g1\n`;
` {emit_string instr} [%g1 + %lo({emit_symbol s} + {emit_int ofs})], {emit_reg dst}\n`
| Iindexed ofs ->
if is_immediate ofs then
` {emit_string instr} [{emit_reg arg.(0)} + {emit_int ofs}], {emit_reg dst}\n`
else begin
` sethi %hi({emit_int ofs}), %g1\n`;
` or %g1, %lo({emit_int ofs}), %g1\n`;
` {emit_string instr} [{emit_reg arg.(0)} + %g1], {emit_reg dst}\n`
end
(* Output a store *)
let emit_store instr addr arg src =
match addr with
Ibased(s, 0) ->
` sethi %hi({emit_symbol s}), %g1\n`;
` {emit_string instr} {emit_reg src}, [%g1 + %lo({emit_symbol s})]\n`
| Ibased(s, ofs) ->
` sethi %hi({emit_symbol s} + {emit_int ofs}), %g1\n`;
` {emit_string instr} {emit_reg src}, [%g1 + %lo({emit_symbol s} + {emit_int ofs})]\n`
| Iindexed ofs ->
if is_immediate ofs then
` {emit_string instr} {emit_reg src}, [{emit_reg arg.(1)} + {emit_int ofs}]\n`
else begin
` sethi %hi({emit_int ofs}), %g1\n`;
` or %g1, %lo({emit_int ofs}), %g1\n`;
` {emit_string instr} {emit_reg src}, [{emit_reg arg.(1)} + %g1]\n`
end
(* Record live pointers at call points *)
type frame_descr =
{ fd_lbl: int; (* Return address *)
fd_frame_size: int; (* Size of stack frame *)
fd_live_offset: int list } (* Offsets/regs of live addresses *)
let frame_descriptors = ref([] : frame_descr list)
let record_frame ?label live =
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;
live_offset := List.sort_uniq (-) !live_offset;
frame_descriptors :=
{ fd_lbl = lbl;
fd_frame_size = frame_size();
fd_live_offset = !live_offset } :: !frame_descriptors;
`{emit_label lbl}:`
let emit_frame fd =
` .word {emit_label fd.fd_lbl}\n`;
` .half {emit_int fd.fd_frame_size}\n`;
` .half {emit_int (List.length fd.fd_live_offset)}\n`;
List.iter
(fun n ->
` .half {emit_int n}\n`)
fd.fd_live_offset;
` .align 4\n`
(* Record floating-point constants *)
let float_constants = ref ([] : (int * int64) list)
let emit_float_constant (lbl, cst) =
rodata ();
` .align 8\n`;
`{emit_label lbl}:`;
emit_float64_split_directive ".word" cst
(* Emission of the profiling prelude *)
let emit_profile () =
begin match Config.system with
"solaris" ->
let lbl = new_label() in
` .section \".bss\"\n`;
`{emit_label lbl}: .skip 4\n`;
` .text\n`;
` save %sp,-96,%sp\n`;
` sethi %hi({emit_label lbl}),%o0\n`;
` call _mcount\n`;
` or %o0,%lo({emit_label lbl}),%o0\n`;
` restore\n`
| _ -> ()
end
(* Names of various instructions *)
let name_for_int_operation = function
Iadd -> "add"
| Isub -> "sub"
| Iand -> "and"
| Ior -> "or"
| Ixor -> "xor"
| Ilsl -> "sll"
| Ilsr -> "srl"
| Iasr -> "sra"
| Imul -> "smul"
| _ -> Misc.fatal_error "Emit.name_for_int_operation"
let name_for_float_operation = function
Inegf -> if !arch_version = SPARC_V9 then "fnegd" else "fnegs"
| Iabsf -> if !arch_version = SPARC_V9 then "fabsd" else "fabss"
| Iaddf -> "faddd"
| Isubf -> "fsubd"
| Imulf -> "fmuld"
| Idivf -> "fdivd"
| _ -> Misc.fatal_error "Emit.name_for_float_operation"
let name_for_int_movcc = function
Isigned Ceq -> "e" | Isigned Cne -> "ne"
| Isigned Cle -> "le" | Isigned Cgt -> "g"
| Isigned Clt -> "l" | Isigned Cge -> "ge"
| Iunsigned Ceq -> "e" | Iunsigned Cne -> "ne"
| Iunsigned Cle -> "leu" | Iunsigned Cgt -> "gu"
| Iunsigned Clt -> "lu" | Iunsigned Cge -> "geu"
let name_for_int_comparison = function
Isigned Ceq -> "be" | Isigned Cne -> "bne"
| Isigned Cle -> "ble" | Isigned Cgt -> "bg"
| Isigned Clt -> "bl" | Isigned Cge -> "bge"
| Iunsigned Ceq -> "be" | Iunsigned Cne -> "bne"
| Iunsigned Cle -> "bleu" | Iunsigned Cgt -> "bgu"
| Iunsigned Clt -> "blu" | Iunsigned Cge -> "bgeu"
let name_for_float_comparison cmp neg =
match cmp with
Ceq -> if neg then "fbne" else "fbe"
| Cne -> if neg then "fbe" else "fbne"
| Cle -> if neg then "fbug" else "fble"
| Cgt -> if neg then "fbule" else "fbg"
| Clt -> if neg then "fbuge" else "fbl"
| Cge -> if neg then "fbul" else "fbge"
(* Output the assembly code for an instruction *)
let function_name = ref ""
let tailrec_entry_point = ref 0
let range_check_trap = ref 0
let rec emit_instr i dslot =
match i.desc with
Lend -> ()
| Lop(Imove | Ispill | Ireload) ->
let src = i.arg.(0) and dst = i.res.(0) in
begin match (src, dst) with
{loc = Reg _; typ = (Int | Addr | Val)}, {loc = Reg _} ->
` mov {emit_reg src}, {emit_reg dst}\n`
| {loc = Reg _; typ = Float}, {loc = Reg _; typ = Float} ->
if !arch_version = SPARC_V9 then
` fmovd {emit_reg src}, {emit_reg dst}\n`
else begin
` fmovs {emit_reg src}, {emit_reg dst}\n`;
` fmovs {emit_reg(next_in_pair src)}, {emit_reg(next_in_pair dst)}\n`
end
| {loc = Reg _; typ = Float}, {loc = Reg _; typ = (Int | Addr | Val)} ->
(* This happens when calling C functions and passing a float arg
in %o0...%o5 *)
` sub %sp, 8, %sp\n`;
` std {emit_reg src}, [%sp + 96]\n`;
` ld [%sp + 96], {emit_reg dst}\n`;
let dst2 = i.res.(1) in
begin match dst2 with
| {loc = Reg _; typ = Int} ->
` ld [%sp + 100], {emit_reg dst2}\n`;
| {loc = Stack _; typ = Int} ->
` ld [%sp + 100], %g1\n`;
` st %g1, {emit_stack dst2}\n`;
| _ ->
fatal_error "Emit: Imove Float [| _; _ |]"
end;
` add %sp, 8, %sp\n`
| {loc = Reg _; typ = (Int | Addr | Val)}, {loc = Stack _} ->
` st {emit_reg src}, {emit_stack dst}\n`
| {loc = Reg _; typ = Float}, {loc = Stack _} ->
` std {emit_reg src}, {emit_stack dst}\n`
| {loc = Stack _; typ = (Int | Addr | Val)}, {loc = Reg _} ->
` ld {emit_stack src}, {emit_reg dst}\n`
| {loc = Stack _; typ = Float}, {loc = Reg _} ->
` ldd {emit_stack src}, {emit_reg dst}\n`
| (_, _) ->
fatal_error "Emit: Imove"
end
| Lop(Iconst_int n) ->
if is_native_immediate n then
` mov {emit_nativeint n}, {emit_reg i.res.(0)}\n`
else begin
` sethi %hi({emit_nativeint n}), %g1\n`;
` or %g1, %lo({emit_nativeint n}), {emit_reg i.res.(0)}\n`
end
| Lop(Iconst_float f) ->
(* On UltraSPARC, the fzero instruction could be used to set a
floating point register pair to zero. *)
let lbl = new_label() in
float_constants := (lbl, f) :: !float_constants;
` sethi %hi({emit_label lbl}), %g1\n`;
` ldd [%g1 + %lo({emit_label lbl})], {emit_reg i.res.(0)}\n`
| Lop(Iconst_symbol s) ->
` sethi %hi({emit_symbol s}), %g1\n`;
` or %g1, %lo({emit_symbol s}), {emit_reg i.res.(0)}\n`
| Lop(Icall_ind { label_after; }) ->
`{record_frame i.live ~label:label_after} call {emit_reg i.arg.(0)}\n`;
fill_delay_slot dslot
| Lop(Icall_imm { func; label_after; }) ->
`{record_frame i.live ~label:label_after} call {emit_symbol func}\n`;
fill_delay_slot dslot
| Lop(Itailcall_ind { label_after = _; }) ->
let n = frame_size() in
if !contains_calls then
` ld [%sp + {emit_int(n - 4 + 96)}], %o7\n`;
` jmp {emit_reg i.arg.(0)}\n`;
` add %sp, {emit_int n}, %sp\n` (* in delay slot *)
| Lop(Itailcall_imm { func; label_after = _; }) ->
let n = frame_size() in
if func = !function_name then begin
` b {emit_label !tailrec_entry_point}\n`;
fill_delay_slot dslot
end else begin
if !contains_calls then
` ld [%sp + {emit_int(n - 4 + 96)}], %o7\n`;
` sethi %hi({emit_symbol func}), %g1\n`;
` jmp %g1 + %lo({emit_symbol func})\n`;
` add %sp, {emit_int n}, %sp\n` (* in delay slot *)
end
| Lop(Iextcall { func; alloc; label_after; }) ->
if alloc then begin
` sethi %hi({emit_symbol func}), %g2\n`;
`{record_frame i.live ~label:label_after} call {emit_symbol "caml_c_call"}\n`;
` or %g2, %lo({emit_symbol func}), %g2\n` (* in delay slot *)
end else begin
` call {emit_symbol func}\n`;
fill_delay_slot dslot
end
| Lop(Istackoffset n) ->
` add %sp, {emit_int (-n)}, %sp\n`;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
begin match chunk with
Double_u ->
emit_load "ld" addr i.arg dest;
emit_load "ld" (offset_addressing addr 4) i.arg (next_in_pair dest)
| Single ->
emit_load "ld" addr i.arg dest;
` fstod {emit_reg dest}, {emit_reg dest}\n`
| _ ->
let loadinstr =
match chunk with
Byte_unsigned -> "ldub"
| Byte_signed -> "ldsb"
| Sixteen_unsigned -> "lduh"
| Sixteen_signed -> "ldsh"
| Double -> "ldd"
| _ -> "ld" in
emit_load loadinstr addr i.arg dest
end
| Lop(Istore(chunk, addr, _)) ->
let src = i.arg.(0) in
begin match chunk with
Double_u ->
emit_store "st" addr i.arg src;
emit_store "st" (offset_addressing addr 4) i.arg (next_in_pair src)
| Single ->
` fdtos {emit_reg src}, %f30\n`;
emit_store "st" addr i.arg (phys_reg 115) (* %f30 *)
| _ ->
let storeinstr =
match chunk with
| Byte_unsigned | Byte_signed -> "stb"
| Sixteen_unsigned | Sixteen_signed -> "sth"
| Double -> "std"
| _ -> "st" in
emit_store storeinstr addr i.arg src
end
| Lop(Ialloc { words = n; label_after_call_gc; }) ->
if !fastcode_flag then begin
let lbl_cont = new_label() in
if solaris then begin
` sub %l6, {emit_int n}, %l6\n`;
` cmp %l6, %l7\n`
end else begin
` ld [%l7], %g1\n`;
` sub %l6, {emit_int n}, %l6\n`;
` cmp %l6, %g1\n`
end;
` bgeu {emit_label lbl_cont}\n`;
` add %l6, 4, {emit_reg i.res.(0)}\n`; (* in delay slot *)
`{record_frame i.live ?label:label_after_call_gc} call {emit_symbol "caml_call_gc"}\n`;
` mov {emit_int n}, %g2\n`; (* in delay slot *)
` add %l6, 4, {emit_reg i.res.(0)}\n`;
`{emit_label lbl_cont}:\n`
end else begin
`{record_frame i.live} call {emit_symbol "caml_allocN"}\n`;
` mov {emit_int n}, %g2\n`; (* in delay slot *)
` add %l6, 4, {emit_reg i.res.(0)}\n`
end
| Lop(Iintop(Icomp cmp)) ->
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
if !arch_version = SPARC_V9 then begin
let comp = name_for_int_movcc cmp in
` mov 0, {emit_reg i.res.(0)}\n`;
` mov{emit_string comp} %icc, 1, {emit_reg i.res.(0)}\n`
end
else begin
let comp = name_for_int_comparison cmp
and lbl = new_label() in
` {emit_string comp},a {emit_label lbl}\n`;
` mov 1, {emit_reg i.res.(0)}\n`;
` mov 0, {emit_reg i.res.(0)}\n`;
`{emit_label lbl}:\n`
end
| Lop(Iintop (Icheckbound _)) ->
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
if solaris then
` tleu 5\n` (* 5 = ST_RANGE_CHECK *)
else begin
if !range_check_trap = 0 then range_check_trap := new_label();
` bleu {emit_label !range_check_trap}\n`;
` nop\n` (* delay slot *)
end
| Lop(Iintop Idiv) ->
` sra {emit_reg i.arg.(0)}, 31, %g1\n`;
` wr %g1, %y\n`;
` sdiv {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
| Lop(Iintop Imulh) ->
` smul {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, %g1\n`;
` rd %y, {emit_reg i.res.(0)}\n`
| Lop(Iintop op) ->
let instr = name_for_int_operation op in
` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
| Lop(Iintop_imm(Ilsl, 1)) ->
(* UltraSPARC has two add units but only one shifter. *)
` add {emit_reg i.arg.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`
| Lop(Iintop_imm(Icomp cmp, n)) ->
` cmp {emit_reg i.arg.(0)}, {emit_int n}\n`;
if !arch_version = SPARC_V9 then begin
let comp = name_for_int_movcc cmp in
` mov 0, {emit_reg i.res.(0)}\n`;
` mov{emit_string comp} %icc, 1, {emit_reg i.res.(0)}\n`
end else begin
let comp = name_for_int_comparison cmp
and lbl = new_label() in
` {emit_string comp},a {emit_label lbl}\n`;
` mov 1, {emit_reg i.res.(0)}\n`;
` mov 0, {emit_reg i.res.(0)}\n`;
`{emit_label lbl}:\n`
end
| Lop(Iintop_imm(Icheckbound _, n)) ->
` cmp {emit_reg i.arg.(0)}, {emit_int n}\n`;
if solaris then
` tleu 5\n` (* 5 = ST_RANGE_CHECK *)
else begin
if !range_check_trap = 0 then range_check_trap := new_label();
` bleu {emit_label !range_check_trap}\n`;
` nop\n` (* delay slot *)
end
| Lop(Iintop_imm(Imulh, n)) ->
` smul {emit_reg i.arg.(0)}, {emit_int n}, %g1\n`;
` rd %y, {emit_reg i.res.(0)}\n`
| Lop(Iintop_imm(op, n)) ->
let instr = name_for_int_operation op in
` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n`
| Lop(Inegf | Iabsf as op) ->
let instr = name_for_float_operation op in
` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`;
if !arch_version <> SPARC_V9 then
` fmovs {emit_reg(next_in_pair i.arg.(0))}, {emit_reg(next_in_pair i.res.(0))}\n`
| Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
let instr = name_for_float_operation op in
` {emit_string instr} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
| Lop(Ifloatofint) ->
` sub %sp, 8, %sp\n`;
` st {emit_reg i.arg.(0)}, [%sp + 96]\n`;
` ld [%sp + 96], %f30\n`;
` add %sp, 8, %sp\n`;
` fitod %f30, {emit_reg i.res.(0)}\n`
| Lop(Iintoffloat) ->
` fdtoi {emit_reg i.arg.(0)}, %f30\n`;
` sub %sp, 8, %sp\n`;
` st %f30, [%sp + 96]\n`;
` ld [%sp + 96], {emit_reg i.res.(0)}\n`;
` add %sp, 8, %sp\n`
| Lop(Ispecific _) ->
assert false
| Lreloadretaddr ->
let n = frame_size() in
` ld [%sp + {emit_int(n - 4 + 96)}], %o7\n`
| Lreturn ->
let n = frame_size() in
` retl\n`;
if n = 0 then
` nop\n`
else
` add %sp, {emit_int n}, %sp\n`
| Llabel lbl ->
`{emit_label lbl}:\n`
| Lbranch lbl ->
` b {emit_label lbl}\n`;
fill_delay_slot dslot
| Lcondbranch(tst, lbl) ->
begin match tst with
Itruetest ->
` tst {emit_reg i.arg.(0)}\n`;
` bne {emit_label lbl}\n`
| Ifalsetest ->
` tst {emit_reg i.arg.(0)}\n`;
` be {emit_label lbl}\n`
| Iinttest cmp ->
let comp = name_for_int_comparison cmp in
` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` {emit_string comp} {emit_label lbl}\n`
| Iinttest_imm(cmp, n) ->
let comp = name_for_int_comparison cmp in
` cmp {emit_reg i.arg.(0)}, {emit_int n}\n`;
` {emit_string comp} {emit_label lbl}\n`
| Ifloattest(cmp, neg) ->
let comp = name_for_float_comparison cmp neg in
` fcmpd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` nop\n`;
` {emit_string comp} {emit_label lbl}\n`
| Ioddtest ->
` andcc {emit_reg i.arg.(0)}, 1, %g0\n`;
` bne {emit_label lbl}\n`
| Ieventest ->
` andcc {emit_reg i.arg.(0)}, 1, %g0\n`;
` be {emit_label lbl}\n`
end;
fill_delay_slot dslot
| Lcondbranch3(lbl0, lbl1, lbl2) ->
` cmp {emit_reg i.arg.(0)}, 1\n`;
begin match lbl0 with
None -> ()
| Some lbl -> ` bl {emit_label lbl}\n nop\n`
end;
begin match lbl1 with
None -> ()
| Some lbl -> ` be {emit_label lbl}\n nop\n`
end;
begin match lbl2 with
None -> ()
| Some lbl -> ` bg {emit_label lbl}\n nop\n`
end
| Lswitch jumptbl ->
let lbl_jumptbl = new_label() in
` sethi %hi({emit_label lbl_jumptbl}), %g1\n`;
` or %g1, %lo({emit_label lbl_jumptbl}), %g1\n`;
` sll {emit_reg i.arg.(0)}, 2, %g2\n`;
` ld [%g1 + %g2], %g1\n`;
` jmp %g1\n`; (* poor scheduling *)
` nop\n`;
`{emit_label lbl_jumptbl}:`;
for i = 0 to Array.length jumptbl - 1 do
` .word {emit_label jumptbl.(i)}\n`
done
| Lsetuptrap lbl ->
` call {emit_label lbl}\n`;
` sub %sp, 8, %sp\n` (* in delay slot *)
| Lpushtrap ->
stack_offset := !stack_offset + 8;
` st %o7, [%sp + 96]\n`;
` st %l5, [%sp + 100]\n`;
` mov %sp, %l5\n`
| Lpoptrap ->
` ld [%sp + 100], %l5\n`;
` add %sp, 8, %sp\n`;
stack_offset := !stack_offset - 8
| Lraise _ ->
` ld [%l5 + 96], %g1\n`;
` mov %l5, %sp\n`;
` ld [%sp + 100], %l5\n`;
` jmp %g1 + 8\n`;
` add %sp, 8, %sp\n`
and fill_delay_slot = function
None -> ` nop\n`
| Some i -> emit_instr i None
(* Checks if a pseudo-instruction expands to exactly one machine instruction
that does not branch. *)
let is_one_instr_op = function
Imulh | Idiv | Imod | Icomp _ | Icheckbound _ -> false
| _ -> true
let is_one_instr i =
match i.desc with
Lop op ->
begin match op with
Imove | Ispill | Ireload ->
i.arg.(0).typ <> Float && i.res.(0).typ <> Float
| Iconst_int n -> is_native_immediate n
| Istackoffset _ -> true
| Iload(_, Iindexed n) -> i.res.(0).typ <> Float && is_immediate n
| Istore(_, Iindexed n, _) -> i.arg.(0).typ <> Float && is_immediate n
| Iintop(op) -> is_one_instr_op op
| Iintop_imm(op, _) -> is_one_instr_op op
| Iaddf | Isubf | Imulf | Idivf -> true
| Iabsf | Inegf -> !arch_version = SPARC_V9
| _ -> false
end
| _ -> false
let no_interference res arg =
try
for i = 0 to Array.length arg - 1 do
for j = 0 to Array.length res - 1 do
if arg.(i).loc = res.(j).loc then raise Exit
done
done;
true
with Exit ->
false
(* Emit a sequence of instructions, trying to fill delay slots for branches *)
let rec emit_all i =
match i with
{desc = Lend} -> ()
| {next = {desc = Lop(Icall_imm _)
| Lop(Iextcall { alloc = false; }) | Lbranch _}}
when is_one_instr i ->
emit_instr i.next (Some i);
emit_all i.next.next
| {next = {desc = Lop(Itailcall_imm { func; _ })}}
when func = !function_name && is_one_instr i ->
emit_instr i.next (Some i);
emit_all i.next.next
| {next = {desc = Lop(Icall_ind _)}}
when is_one_instr i && no_interference i.res i.next.arg ->
emit_instr i.next (Some i);
emit_all i.next.next
| {next = {desc = Lcondbranch(_, _)}}
when is_one_instr i && no_interference i.res i.next.arg ->
emit_instr i.next (Some i);
emit_all i.next.next
| _ ->
emit_instr i None;
emit_all i.next
(* Emission of a function declaration *)
let fundecl fundecl =
function_name := fundecl.fun_name;
fastcode_flag := fundecl.fun_fast;
tailrec_entry_point := new_label();
range_check_trap := 0;
stack_offset := 0;
float_constants := [];
` .text\n`;
` .align 4\n`;
` .global {emit_symbol fundecl.fun_name}\n`;
if Config.system = "solaris" then
` .type {emit_symbol fundecl.fun_name},#function\n`;
`{emit_symbol fundecl.fun_name}:\n`;
if !Clflags.gprofile then emit_profile();
let n = frame_size() in
if n > 0 then
` sub %sp, {emit_int n}, %sp\n`;
if !contains_calls then
` st %o7, [%sp + {emit_int(n - 4 + 96)}]\n`;
`{emit_label !tailrec_entry_point}:\n`;
emit_all fundecl.fun_body;
if !range_check_trap > 0 then begin
`{emit_label !range_check_trap}:\n`;
` call {emit_symbol "caml_ml_array_bound_error"}\n`;
` nop\n`
end;
emit_size fundecl.fun_name;
List.iter emit_float_constant !float_constants
(* Emission of data *)
let emit_item = function
Cglobal_symbol s ->
` .global {emit_symbol s}\n`;
| Cdefine_symbol s ->
`{emit_symbol s}:\n`
| Cint8 n ->
` .byte {emit_int n}\n`
| Cint16 n ->
` .half {emit_int n}\n`
| Cint32 n ->
` .word {emit_nativeint n}\n`
| Cint n ->
` .word {emit_nativeint n}\n`
| Csingle f ->
emit_float32_directive ".word" (Int32.bits_of_float f)
| Cdouble f ->
emit_float64_split_directive ".word" (Int64.bits_of_float f)
| Csymbol_address s ->
` .word {emit_symbol s}\n`
| Cstring s ->
emit_string_directive " .ascii " s
| Cskip n ->
if n > 0 then ` .skip {emit_int n}\n`
| Calign n ->
` .align {emit_int n}\n`
let data l =
` .data\n`;
List.iter emit_item l
(* Beginning / end of an assembly file *)
let begin_assembly() =
let lbl_begin = Compilenv.make_symbol (Some "data_begin") in
` .data\n`;
` .global {emit_symbol lbl_begin}\n`;
`{emit_symbol lbl_begin}:\n`;
let lbl_begin = Compilenv.make_symbol (Some "code_begin") in
` .text\n`;
` .global {emit_symbol lbl_begin}\n`;
`{emit_symbol lbl_begin}:\n`
let end_assembly() =
` .text\n`;
let lbl_end = Compilenv.make_symbol (Some "code_end") in
` .global {emit_symbol lbl_end}\n`;
`{emit_symbol lbl_end}:\n`;
` .data\n`;
let lbl_end = Compilenv.make_symbol (Some "data_end") in
` .global {emit_symbol lbl_end}\n`;
`{emit_symbol lbl_end}:\n`;
` .word 0\n`;
let lbl = Compilenv.make_symbol (Some "frametable") in
rodata ();
` .global {emit_symbol lbl}\n`;
if Config.system = "solaris" then
` .type {emit_symbol lbl},#object\n`;
`{emit_symbol lbl}:\n`;
` .word {emit_int (List.length !frame_descriptors)}\n`;
List.iter emit_frame !frame_descriptors;
emit_size lbl;
frame_descriptors := []

View File

@ -1,251 +0,0 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Description of the Sparc processor *)
open Misc
open Cmm
open Reg
open Arch
open Mach
(* Instruction selection *)
let word_addressed = false
(* Registers available for register allocation *)
(* Register map:
%o0 - %o5 0 - 5 function results, C functions args / res
%i0 - %i5 6 - 11 function arguments, preserved by C
%l0 - %l4 12 - 16 general purpose, preserved by C
%g3 - %g4 17 - 18 general purpose, not preserved by C
%l5 exception pointer
%l6 allocation pointer
%l7 address of allocation limit
%g0 always zero
%g1 - %g2 temporaries
%g5 - %g7 reserved for system libraries
%f0 - %f10 100 - 105 function arguments and results
%f12 - %f28 106 - 114 general purpose
%f30 temporary *)
let int_reg_name = [|
(* 0-5 *) "%o0"; "%o1"; "%o2"; "%o3"; "%o4"; "%o5";
(* 6-11 *) "%i0"; "%i1"; "%i2"; "%i3"; "%i4"; "%i5";
(* 12-16 *) "%l0"; "%l1"; "%l2"; "%l3"; "%l4";
(* 17-18 *) "%g3"; "%g4"
|]
let float_reg_name = [|
(* 100-105 *) "%f0"; "%f2"; "%f4"; "%f6"; "%f8"; "%f10";
(* 106-109 *) "%f12"; "%f14"; "%f16"; "%f18";
(* 110-114 *) "%f20"; "%f22"; "%f24"; "%f26"; "%f28";
(* 115 *) "%f30";
(* Odd parts of register pairs *)
(* 116-121 *) "%f1"; "%f3"; "%f5"; "%f7"; "%f9"; "%f11";
(* 122-125 *) "%f13"; "%f15"; "%f17"; "%f19";
(* 126-130 *) "%f21"; "%f23"; "%f25"; "%f27"; "%f29";
(* 131 *) "%f31"
|]
let num_register_classes = 2
let register_class r =
match r.typ with
| Val | Int | Addr -> 0
| Float -> 1
let num_available_registers = [| 19; 15 |]
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 19 Reg.dummy in
for i = 0 to 18 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 (Array.sub hard_float_reg 0 15)
(* No need to include the odd parts of float register pairs,
nor the temporary register %f30 *)
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)
let loc_spacetime_node_hole = Reg.dummy (* Spacetime unsupported *)
(* 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 8) (* Keep stack 8-aligned *)
let incoming ofs = Incoming ofs
let outgoing ofs = Outgoing ofs
let not_supported _ofs = fatal_error "Proc.loc_results: cannot call"
let max_arguments_for_tailcalls = 10
let loc_arguments arg =
calling_conventions 6 15 100 105 outgoing arg
let loc_parameters arg =
let (loc, _ofs) = calling_conventions 6 15 100 105 incoming arg in loc
let loc_results res =
let (loc, _ofs) = calling_conventions 0 5 100 105 not_supported res in loc
(* On the Sparc, all arguments to C functions, even floating-point arguments,
are passed in %o0..%o5, then on the stack *)
let loc_external_arguments arg =
let loc = Array.make (Array.length arg) [| |] in
let reg = ref 0 (* %o0 *) in
let ofs = ref (-4) in (* start at sp + 92 = sp + 96 - 4 *)
let next_loc typ =
if !reg <= 5 (* %o5 *) then begin
assert (size_component typ = size_int);
let loc = phys_reg !reg in
incr reg;
loc
end else begin
let loc = stack_slot (outgoing !ofs) typ in
ofs := !ofs + size_component typ;
loc
end
in
for i = 0 to Array.length arg - 1 do
match arg.(i) with
| [| { typ = (Val | Int | Addr as typ) } |] ->
loc.(i) <- [| next_loc typ |]
| [| { typ = Float } |] ->
if !reg <= 5 then begin
let loc1 = next_loc Int in
let loc2 = next_loc Int in
loc.(i) <- [| loc1; loc2 |]
end else
loc.(i) <- [| next_loc Float |]
| [| { typ = Int }; { typ = Int } |] ->
(* int64 unboxed *)
let loc1 = next_loc Int in
let loc2 = next_loc Int in
loc.(i) <- [| loc1; loc2 |]
| _ ->
fatal_error "Proc.loc_external_arguments: cannot call"
done;
(* Keep stack 8-aligned *)
(loc, Misc.align (!ofs + 4) 8)
let loc_external_results res =
let (loc, _ofs) = calling_conventions 0 1 100 100 not_supported res in loc
let loc_exn_bucket = phys_reg 0 (* $o0 *)
(* Volatile registers: none *)
let regs_are_volatile _rs = false
(* Registers destroyed by operations *)
let destroyed_at_c_call = (* %l0-%l4, %i0-%i5 preserved *)
Array.of_list(List.map phys_reg
[0; 1; 2; 3; 4; 5; 17; 18;
100; 101; 102; 103; 104; 105; 106; 107;
108; 109; 110; 111; 112; 113; 114])
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
(* Maximal register pressure *)
let safe_register_pressure = function
Iextcall _ -> 0
| _ -> 15
let max_register_pressure = function
Iextcall _ -> [| 11; 0 |]
| _ -> [| 19; 15 |]
(* 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
| _ -> true
(* Layout of the stack *)
let num_stack_slots = [| 0; 0 |]
let contains_calls = ref false
(* Calling the assembler and the archiver *)
let assemble_file infile outfile =
let asflags = begin match !arch_version with
SPARC_V7 -> " -o "
| SPARC_V8 -> " -xarch=v8 -o "
| SPARC_V9 -> " -xarch=v8plus -o "
end in
Ccomp.command (Config.asm ^ asflags ^
Filename.quote outfile ^ " " ^ Filename.quote infile)
let init () = ()

View File

@ -1,19 +0,0 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Reloading for the Sparc *)
let fundecl f =
(new Reloadgen.reload_generic)#fundecl f

View File

@ -1,63 +0,0 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
open Cmm
open Mach
(* Instruction scheduling for the Sparc *)
class scheduler = object
inherit Schedgen.scheduler_generic
(* Latencies (in cycles). *)
(* UltraSPARC issues two integer operations, plus a single load or store,
per cycle. At most one of the integer instructions may be a shift.
Most integer operations have one cycle latency. Unsigned loads take
two cycles. Signed loads take three cycles. Conditional moves have
two cycle latency and may not issue in the same cycle as any other
instruction. Floating point issue rules are complicated, but in
general independent add and multiply can dual issue with four cycle
latency. *)
method oper_latency = function
Ireload -> 2
| Iload((Byte_signed|Sixteen_signed|Thirtytwo_signed), _) -> 3
| Iload(_, _) -> 2
| Iconst_float _ -> 2 (* turned into a load *)
| Inegf | Iabsf | Iaddf | Isubf | Imulf -> 4
| Idivf -> 15
| _ -> 1
(* Issue cycles. Rough approximations. *)
method oper_issue_cycles = function
Iconst_float _ -> 2
| Iconst_symbol _ -> 2
| Ialloc _ -> 6
| Iintop(Icomp _) -> 4
| Iintop(Icheckbound _) -> 2
| Iintop_imm(Icomp _, _) -> 4
| Iintop_imm(Icheckbound _, _) -> 2
| Inegf -> 2
| Iabsf -> 2
| Ifloatofint -> 6
| Iintoffloat -> 6
| _ -> 1
end
let fundecl f = (new scheduler)#schedule_fundecl f

View File

@ -1,80 +0,0 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1997 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(* Instruction selection for the Sparc processor *)
open Cmm
open Reg
open Arch
open Mach
class selector = object (self)
inherit Selectgen.selector_generic as super
method is_immediate n = (n <= 4095) && (n >= -4096)
method select_addressing _chunk = function
Cconst_symbol s ->
(Ibased(s, 0), Ctuple [])
| Cop((Caddv | Cadda), [Cconst_symbol s; Cconst_int n], _) ->
(Ibased(s, n), Ctuple [])
| Cop((Caddv | Cadda), [arg; Cconst_int n], _) ->
(Iindexed n, arg)
| Cop((Caddv | Cadda as op),
[arg1; Cop(Caddi, [arg2; Cconst_int n], _)], dbg) ->
(Iindexed n, Cop(op, [arg1; arg2], dbg))
| arg ->
(Iindexed 0, arg)
method private iextcall (func, alloc) =
Iextcall { func; alloc; label_after = Cmm.new_label (); }
method! select_operation op args dbg =
match (op, args) with
(* For SPARC V7 multiplication, division and modulus are turned into
calls to C library routines.
For SPARC V8 and V9, use hardware multiplication and division,
but C library routine for modulus. *)
(Cmuli, _) when !arch_version = SPARC_V7 ->
(self#iextcall(".umul", false), args)
| (Cdivi, _) when !arch_version = SPARC_V7 ->
(self#iextcall(".div", false), args)
| (Cmodi, _) ->
(self#iextcall(".rem", false), args)
| _ ->
super#select_operation op args dbg
(* Override insert_move_args to deal correctly with floating-point
arguments being passed into pairs of integer registers. *)
method! insert_move_args arg loc stacksize =
if stacksize <> 0 then self#insert (Iop(Istackoffset stacksize)) [||] [||];
let locpos = ref 0 in
for i = 0 to Array.length arg - 1 do
let src = arg.(i) in
let dst = loc.(!locpos) in
match (src, dst) with
({typ = Float}, {typ = Int}) ->
let dst2 = loc.(!locpos + 1) in
self#insert (Iop Imove) [|src|] [|dst; dst2|];
locpos := !locpos + 2
| (_, _) ->
self#insert_move src dst;
incr locpos
done
end
let fundecl f = (new selector)#emit_fundecl f

View File

@ -158,21 +158,9 @@ int caml_set_signal_action(int signo, int action)
/* Machine- and OS-dependent handling of bound check trap */
#if defined(TARGET_power) \
|| defined(TARGET_s390x) \
|| (defined(TARGET_sparc) && defined(SYS_solaris))
|| defined(TARGET_s390x)
DECLARE_SIGNAL_HANDLER(trap_handler)
{
#if defined(SYS_solaris)
if (info->si_code != ILL_ILLTRP) {
/* Deactivate our exception handler and return. */
struct sigaction act;
act.sa_handler = SIG_DFL;
act.sa_flags = 0;
sigemptyset(&act.sa_mask);
sigaction(sig, &act, NULL);
return;
}
#endif
#if defined(SYS_rhapsody)
/* Unblock SIGTRAP */
{ sigset_t mask;
@ -262,14 +250,6 @@ DECLARE_SIGNAL_HANDLER(segv_handler)
void caml_init_signals(void)
{
/* Bound-check trap handling */
#if defined(TARGET_sparc) && defined(SYS_solaris)
{ struct sigaction act;
sigemptyset(&act.sa_mask);
SET_SIGACT(act, trap_handler);
act.sa_flags |= SA_NODEFER;
sigaction(SIGILL, &act, NULL);
}
#endif
#if defined(TARGET_power)
{ struct sigaction act;

View File

@ -339,29 +339,6 @@
#define CONTEXT_YOUNG_PTR (context->sc_frame.fixreg[31])
#define CONTEXT_SP (context->sc_frame.fixreg[1])
/****************** SPARC, Solaris */
#elif defined(TARGET_sparc) && defined(SYS_solaris)
#include <ucontext.h>
#define DECLARE_SIGNAL_HANDLER(name) \
static void name(int sig, siginfo_t * info, ucontext_t * context)
#define SET_SIGACT(sigact,name) \
sigact.sa_sigaction = (void (*)(int,siginfo_t *,void *)) (name); \
sigact.sa_flags = SA_SIGINFO
typedef long context_reg;
#define CONTEXT_PC (context->uc_mcontext.gregs[REG_PC])
/* Local register number N is saved on the stack N words
after the stack pointer */
#define CONTEXT_SP (context->uc_mcontext.gregs[REG_SP])
#define SPARC_L_REG(n) ((long *)(context->uc_mcontext.gregs[REG_SP]))[n]
#define CONTEXT_EXCEPTION_POINTER (SPARC_L_REG(5))
#define CONTEXT_YOUNG_LIMIT (SPARC_L_REG(7))
#define CONTEXT_YOUNG_PTR (SPARC_L_REG(6))
/******************** Default */
#else

View File

@ -1,360 +0,0 @@
/**************************************************************************/
/* */
/* OCaml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 1996 Institut National de Recherche en Informatique et */
/* en Automatique. */
/* */
/* All rights reserved. This file is distributed under the terms of */
/* the GNU Lesser General Public License version 2.1, with the */
/* special exception on linking described in the file LICENSE. */
/* */
/**************************************************************************/
/* Asm part of the runtime system for the Sparc processor. */
/* Must be preprocessed by cpp */
#ifndef SYS_solaris
#define INDIRECT_LIMIT
#endif
#define Exn_ptr %l5
#define Alloc_ptr %l6
#define Alloc_limit %l7
#define Load(symb,reg) sethi %hi(symb), %g1; ld [%g1 + %lo(symb)], reg
#define Store(reg,symb) sethi %hi(symb), %g1; st reg, [%g1 + %lo(symb)]
#define Address(symb,reg) sethi %hi(symb), reg; or reg, %lo(symb), reg
/* Allocation functions */
.text
.global caml_system__code_begin
caml_system__code_begin:
.global caml_allocN
.global caml_call_gc
/* Required size in %g2 */
caml_allocN:
#ifdef INDIRECT_LIMIT
ld [Alloc_limit], %g1
sub Alloc_ptr, %g2, Alloc_ptr
cmp Alloc_ptr, %g1
#else
sub Alloc_ptr, %g2, Alloc_ptr
cmp Alloc_ptr, Alloc_limit
#endif
/*blu,pt %icc, caml_call_gc*/
blu caml_call_gc
nop
retl
nop
/* Required size in %g2 */
caml_call_gc:
/* Save exception pointer if GC raises */
Store(Exn_ptr, caml_exception_pointer)
/* Save current allocation pointer for debugging purposes */
Store(Alloc_ptr, caml_young_ptr)
/* Record lowest stack address */
Store(%sp, caml_bottom_of_stack)
/* Record last return address */
Store(%o7, caml_last_return_address)
/* Allocate space on stack for caml_context structure and float regs */
sub %sp, 20*4 + 15*8, %sp
/* Save int regs on stack and save it into caml_gc_regs */
L100: add %sp, 96 + 15*8, %g1
st %o0, [%g1]
st %o1, [%g1 + 0x4]
st %o2, [%g1 + 0x8]
st %o3, [%g1 + 0xc]
st %o4, [%g1 + 0x10]
st %o5, [%g1 + 0x14]
st %i0, [%g1 + 0x18]
st %i1, [%g1 + 0x1c]
st %i2, [%g1 + 0x20]
st %i3, [%g1 + 0x24]
st %i4, [%g1 + 0x28]
st %i5, [%g1 + 0x2c]
st %l0, [%g1 + 0x30]
st %l1, [%g1 + 0x34]
st %l2, [%g1 + 0x38]
st %l3, [%g1 + 0x3c]
st %l4, [%g1 + 0x40]
st %g3, [%g1 + 0x44]
st %g4, [%g1 + 0x48]
st %g2, [%g1 + 0x4C] /* Save required size */
mov %g1, %g2
Store(%g2, caml_gc_regs)
/* Save the floating-point registers */
add %sp, 96, %g1
std %f0, [%g1]
std %f2, [%g1 + 0x8]
std %f4, [%g1 + 0x10]
std %f6, [%g1 + 0x18]
std %f8, [%g1 + 0x20]
std %f10, [%g1 + 0x28]
std %f12, [%g1 + 0x30]
std %f14, [%g1 + 0x38]
std %f16, [%g1 + 0x40]
std %f18, [%g1 + 0x48]
std %f20, [%g1 + 0x50]
std %f22, [%g1 + 0x58]
std %f24, [%g1 + 0x60]
std %f26, [%g1 + 0x68]
std %f28, [%g1 + 0x70]
/* Call the garbage collector */
call caml_garbage_collection
nop
/* Restore all regs used by the code generator */
add %sp, 96 + 15*8, %g1
ld [%g1], %o0
ld [%g1 + 0x4], %o1
ld [%g1 + 0x8], %o2
ld [%g1 + 0xc], %o3
ld [%g1 + 0x10], %o4
ld [%g1 + 0x14], %o5
ld [%g1 + 0x18], %i0
ld [%g1 + 0x1c], %i1
ld [%g1 + 0x20], %i2
ld [%g1 + 0x24], %i3
ld [%g1 + 0x28], %i4
ld [%g1 + 0x2c], %i5
ld [%g1 + 0x30], %l0
ld [%g1 + 0x34], %l1
ld [%g1 + 0x38], %l2
ld [%g1 + 0x3c], %l3
ld [%g1 + 0x40], %l4
ld [%g1 + 0x44], %g3
ld [%g1 + 0x48], %g4
ld [%g1 + 0x4C], %g2 /* Recover desired size */
add %sp, 96, %g1
ldd [%g1], %f0
ldd [%g1 + 0x8], %f2
ldd [%g1 + 0x10], %f4
ldd [%g1 + 0x18], %f6
ldd [%g1 + 0x20], %f8
ldd [%g1 + 0x28], %f10
ldd [%g1 + 0x30], %f12
ldd [%g1 + 0x38], %f14
ldd [%g1 + 0x40], %f16
ldd [%g1 + 0x48], %f18
ldd [%g1 + 0x50], %f20
ldd [%g1 + 0x58], %f22
ldd [%g1 + 0x60], %f24
ldd [%g1 + 0x68], %f26
ldd [%g1 + 0x70], %f28
/* Reload alloc ptr */
Load(caml_young_ptr, Alloc_ptr)
/* Allocate space for block */
#ifdef INDIRECT_LIMIT
ld [Alloc_limit], %g1
sub Alloc_ptr, %g2, Alloc_ptr
cmp Alloc_ptr, %g1 /* Check that we have enough free space */
#else
Load(caml_young_limit,Alloc_limit)
sub Alloc_ptr, %g2, Alloc_ptr
cmp Alloc_ptr, Alloc_limit
#endif
blu L100 /* If not, call GC again */
nop
/* Return to caller */
Load(caml_last_return_address, %o7)
retl
add %sp, 20*4 + 15*8, %sp /* in delay slot */
/* Call a C function from Ocaml */
.global caml_c_call
/* Function to call is in %g2 */
caml_c_call:
/* Record lowest stack address and return address */
Store(%sp, caml_bottom_of_stack)
Store(%o7, caml_last_return_address)
/* Save the exception handler and alloc pointer */
Store(Exn_ptr, caml_exception_pointer)
sethi %hi(caml_young_ptr), %g1
/* Call the C function */
call %g2
st Alloc_ptr, [%g1 + %lo(caml_young_ptr)] /* in delay slot */
/* Reload return address */
Load(caml_last_return_address, %o7)
/* Reload alloc pointer */
sethi %hi(caml_young_ptr), %g1
/* Return to caller */
retl
ld [%g1 + %lo(caml_young_ptr)], Alloc_ptr /* in delay slot */
/* Start the Ocaml program */
.global caml_start_program
caml_start_program:
/* Save all callee-save registers */
save %sp, -96, %sp
/* Address of code to call */
Address(caml_program, %l2)
/* Code shared with caml_callback* */
L108:
/* Set up a callback link on the stack. */
sub %sp, 16, %sp
Load(caml_bottom_of_stack, %l0)
Load(caml_last_return_address, %l1)
Load(caml_gc_regs, %l3)
st %l0, [%sp + 96]
st %l1, [%sp + 100]
/* Set up a trap frame to catch exceptions escaping the Ocaml code */
call L111
st %l3, [%sp + 104]
b L110
nop
L111: sub %sp, 8, %sp
Load(caml_exception_pointer, Exn_ptr)
st %o7, [%sp + 96]
st Exn_ptr, [%sp + 100]
mov %sp, Exn_ptr
/* Reload allocation pointers */
Load(caml_young_ptr, Alloc_ptr)
#ifdef INDIRECT_LIMIT
Address(caml_young_limit, Alloc_limit)
#else
Load(caml_young_limit, Alloc_limit)
#endif
/* Call the Ocaml code */
L109: call %l2
nop
/* Pop trap frame and restore caml_exception_pointer */
ld [%sp + 100], Exn_ptr
add %sp, 8, %sp
Store(Exn_ptr, caml_exception_pointer)
/* Pop callback link, restoring the global variables */
L112: ld [%sp + 96], %l0
ld [%sp + 100], %l1
ld [%sp + 104], %l2
Store(%l0, caml_bottom_of_stack)
Store(%l1, caml_last_return_address)
Store(%l2, caml_gc_regs)
add %sp, 16, %sp
/* Save allocation pointer */
Store(Alloc_ptr, caml_young_ptr)
/* Reload callee-save registers and return */
ret
restore %o0, 0, %o0 /* copy %o0 in this window to caller's %o0 */
L110:
/* The trap handler */
Store(Exn_ptr, caml_exception_pointer)
/* Encode exception bucket as an exception result */
b L112
or %o0, 2, %o0
/* Raise an exception from C */
.global caml_raise_exception
caml_raise_exception:
/* Save exception bucket in a register outside the reg windows */
mov %o0, %g2
/* Load exception pointer in a register outside the reg windows */
Load(caml_exception_pointer, %g3)
/* Pop some frames until the trap pointer is in the current frame. */
cmp %g3, %fp
blt L107 /* if Exn_ptr < %fp, over */
nop
L106: restore
cmp %fp, %g3 /* if %fp <= Exn_ptr, loop */
ble L106
nop
L107:
/* Reload allocation registers */
Load(caml_young_ptr, Alloc_ptr)
#ifdef INDIRECT_LIMIT
Address(caml_young_limit, Alloc_limit)
#else
Load(caml_young_limit, Alloc_limit)
#endif
/* Branch to exception handler */
mov %g3, %sp
ld [%sp + 96], %g1
ld [%sp + 100], Exn_ptr
add %sp, 8, %sp
jmp %g1 + 8
/* Restore bucket, in delay slot */
mov %g2, %o0
/* Callbacks C -> ML */
.global caml_callback_exn
caml_callback_exn:
/* Save callee-save registers and return address */
save %sp, -96, %sp
/* Initial shuffling of arguments */
mov %i0, %g1
mov %i1, %i0 /* first arg */
mov %g1, %i1 /* environment */
b L108
ld [%g1], %l2 /* code pointer */
.global caml_callback2_exn
caml_callback2_exn:
/* Save callee-save registers and return address */
save %sp, -104, %sp
/* Initial shuffling of arguments */
mov %i0, %g1
mov %i1, %i0 /* first arg */
mov %i2, %i1 /* second arg */
mov %g1, %i2 /* environment */
sethi %hi(caml_apply2), %l2
b L108
or %l2, %lo(caml_apply2), %l2
.global caml_callback3_exn
caml_callback3_exn:
/* Save callee-save registers and return address */
save %sp, -104, %sp
/* Initial shuffling of arguments */
mov %i0, %g1
mov %i1, %i0 /* first arg */
mov %i2, %i1 /* second arg */
mov %i3, %i2 /* third arg */
mov %g1, %i3 /* environment */
sethi %hi(caml_apply3), %l2
b L108
or %l2, %lo(caml_apply3), %l2
#ifndef SYS_solaris
/* Glue code to call [caml_array_bound_error] */
.global caml_ml_array_bound_error
caml_ml_array_bound_error:
Address(caml_array_bound_error, %g2)
b caml_c_call
nop
#endif
.global caml_system__code_end
caml_system__code_end:
#ifdef SYS_solaris
.section ".rodata"
#else
.data
#endif
.global caml_system__frametable
.align 4 /* required for gas? */
caml_system__frametable:
.word 1 /* one descriptor */
.word L109 /* return address into callback */
.half -1 /* negative frame size => use callback link */
.half 0 /* no roots */
#ifdef SYS_solaris
.type caml_allocN, #function
.type caml_call_gc, #function
.type caml_c_call, #function
.type caml_start_program, #function
.type caml_raise_exception, #function
.type caml_system__frametable, #object
#endif

View File

@ -22,11 +22,6 @@
/* Macros to access the stack frame */
#ifdef TARGET_sparc
#define Saved_return_address(sp) *((intnat *)((sp) + 92))
#define Callback_link(sp) ((struct caml_context *)((sp) + 104))
#endif
#ifdef TARGET_i386
#define Saved_return_address(sp) *((intnat *)((sp) - 4))
#ifndef SYS_win32

View File

@ -107,13 +107,11 @@ RANLIBCMD=ranlib
### Currently supported:
###
### i386 Intel Pentium PCs under Linux, *BSD*, NextStep
### sparc Sun Sparcstation under SunOS 4.1 or Solaris 2
### power Macintosh under Mac OS X and Linux
### arm ARM under Linux
###
### Set ARCH=none if your machine is not supported
#ARCH=i386
#ARCH=sparc
#ARCH=power
#ARCH=arm
#ARCH=none
@ -159,7 +157,7 @@ RANLIBCMD=ranlib
#ASPPPROFFLAGS=-DPROFILING
### Whether profiling with gprof is supported
# If yes: (e.g. x86/Linux, Sparc/Solaris):
# If yes: (e.g. x86/Linux):
#PROFILING=true
# If no:
#PROFILING=false
@ -189,7 +187,6 @@ OTHERLIBRARIES=unix str num threads graph dynlink bigarray
# ia32 (Intel x86)
# amd64 (AMD Opteron, Athlon64)
# ppc (Power PC)
# sparc
# If you don't know, leave BNG_ARCH=generic, which selects a portable
# C implementation of these routines.
BNG_ARCH=generic

24
configure vendored
View File

@ -658,9 +658,9 @@ esac
# Determine alignment constraints
case "$target" in
sparc*-*-*|hppa*-*-*|arm*-*-*|mips*-*-*)
hppa*-*-*|arm*-*-*|mips*-*-*)
# On Sparc V9 with certain versions of gcc, determination of double
# alignment is not reliable (PR#1521), hence force it.
# alignment is not reliable (PR#1521), hence we used to force it.
# Same goes for hppa.
# PR#5088 suggests same problem on ARM.
# PR#5280 reports same problem on MIPS.
@ -696,7 +696,7 @@ esac
case "$target" in
# PR#5088: autodetection is unreliable on ARM. PR#5280: also on MIPS.
sparc*-*-*|hppa*-*-*|arm*-*-*|mips*-*-*)
hppa*-*-*|arm*-*-*|mips*-*-*)
if test $2 = 8; then
inf "64-bit integers can be word-aligned."
echo "#undef ARCH_ALIGN_INT64" >> m.h
@ -845,7 +845,6 @@ if $with_sharedlibs; then
x86_64-*-darwin*) natdynlink=true;;
s390x*-*-linux*) natdynlink=true;;
powerpc*-*-linux*) natdynlink=true;;
sparc*-*-linux*) natdynlink=true;;
i686-*-kfreebsd*) natdynlink=true;;
x86_64-*-kfreebsd*) natdynlink=true;;
x86_64-*-dragonfly*) natdynlink=true;;
@ -878,10 +877,6 @@ model=default
system=unknown
case "$target" in
sparc*-*-solaris2.*) arch=sparc; system=solaris;;
sparc*-*-*bsd*) arch=sparc; system=bsd;;
sparc*-*-linux*) arch=sparc; system=linux;;
sparc*-*-gnu*) arch=sparc; system=gnu;;
i[3456]86-*-linux*) arch=i386; system=linux_`sh ./runtest elf.c`;;
i[3456]86-*-*bsd*) arch=i386; system=bsd_`sh ./runtest elf.c`;;
i[3456]86-*-solaris*) if $arch64; then
@ -937,7 +932,7 @@ esac
# Sometimes, it's 32-bit mode that is not supported (PR#6722).
case "$arch64,$arch,$model" in
true,sparc,*|true,power,ppc|false,amd64,*)
true,power,ppc|false,amd64,*)
arch=none; model=default; system=unknown;;
esac
@ -981,18 +976,13 @@ case "$arch,$system" in
fi;;
s390x,elf) as="${TOOLPREF}as -m 64 -march=$model"
aspp="${TOOLPREF}gcc -c -Wa,-march=$model";;
sparc,solaris) as="${TOOLPREF}as"
case "$cc" in
*gcc*) aspp="${TOOLPREF}gcc -c";;
*) aspp="${TOOLPREF}as -P";;
esac;;
arm,freebsd) as="${TOOLPREF}cc -c"
aspp="${TOOLPREF}cc -c";;
*,dragonfly) as="${TOOLPREF}as"
aspp="${TOOLPREF}cc -c";;
*,freebsd) as="${TOOLPREF}as"
aspp="${TOOLPREF}cc -c";;
amd64,*|arm,*|arm64,*|i386,*|power,bsd*|sparc,*)
amd64,*|arm,*|arm64,*|i386,*|power,bsd*,*)
as="${TOOLPREF}as"
case "$ccfamily" in
clang-*)
@ -1014,10 +1004,6 @@ case "$arch,$system" in
i386,bsd_elf) profiling='true';;
amd64,macosx) profiling='true';;
i386,macosx) profiling='true';;
sparc,bsd) profiling='true';;
sparc,solaris)
profiling='true'
case "$cc" in gcc*) ;; *) cc_profile='-xpg';; esac;;
amd64,linux) profiling='true';;
amd64,openbsd) profiling='true';;
amd64,freebsd) profiling='true';;

View File

@ -717,18 +717,6 @@ Generate position-independent machine code. This is the default.
.B \-fno\-PIC
Generate position-dependent machine code.
.SH OPTIONS FOR THE SPARC ARCHITECTURE
The Sparc code generator supports the following additional options:
.TP
.B \-march=v8
Generate SPARC version 8 code.
.TP
.B \-march=v9
Generate SPARC version 9 code.
.P
The default is to generate code for SPARC version 7, which runs on all
SPARC processors.
.SH OPTIONS FOR THE ARM ARCHITECTURE
The ARM code generator supports the following additional options:
.TP

View File

@ -126,15 +126,6 @@ the default.
\item["-fno-PIC"] Generate position-dependent machine code.
\end{options}
\paragraph{Options for the Sparc architecture}
The Sparc code generator supports the following additional options:
\begin{options}
\item["-march=v8"] Generate SPARC version 8 code.
\item["-march=v9"] Generate SPARC version 9 code.
\end{options}
The default is to generate code for SPARC version 7, which runs on all
SPARC processors.
\paragraph{Contextual control of command-line options}
The compiler command line can be modified ``from the outside''

View File

@ -6,7 +6,6 @@ bng_arm64.$(O): bng_arm64.c
bng_digit.$(O): bng_digit.c
bng_ia32.$(O): bng_ia32.c
bng_ppc.$(O): bng_ppc.c
bng_sparc.$(O): bng_sparc.c
nat_stubs.$(O): nat_stubs.c ../../byterun/caml/alloc.h \
../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \

View File

@ -28,7 +28,7 @@ clean::
rm -f *~
bng.$(O): bng.h bng_digit.c \
bng_amd64.c bng_ia32.c bng_ppc.c bng_sparc.c
bng_amd64.c bng_ia32.c bng_ppc.c
.PHONY: depend
depend:

View File

@ -51,5 +51,4 @@ Here are the processors for which such optimizations are available:
AMD64 (Opteron) (carry, dwmult, dwdiv)
PowerPC (carry, dwmult)
Alpha (dwmult)
SPARC (carry, dwmult, dwdiv)
MIPS (dwmult)

View File

@ -23,8 +23,6 @@
#include "bng_amd64.c"
#elif defined(BNG_ARCH_ppc)
#include "bng_ppc.c"
#elif defined (BNG_ARCH_sparc)
#include "bng_sparc.c"
#elif defined (BNG_ARCH_arm64)
#include "bng_arm64.c"
#endif

View File

@ -1,77 +0,0 @@
/**************************************************************************/
/* */
/* OCaml */
/* */
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
/* */
/* Copyright 2003 Institut National de Recherche en Informatique et */
/* en Automatique. */
/* */
/* All rights reserved. This file is distributed under the terms of */
/* the GNU Lesser General Public License version 2.1, with the */
/* special exception on linking described in the file LICENSE. */
/* */
/**************************************************************************/
/* Code specific to the SPARC (V8 and above) architecture. */
#define BngAdd2(res,carryout,arg1,arg2) \
asm("addcc %2, %3, %0 \n\t" \
"addx %%g0, 0, %1" \
: "=r" (res), "=r" (carryout) \
: "r" (arg1), "r" (arg2) \
: "cc")
#define BngAdd2Carry(res,carryout,arg1,arg2,carryin) \
asm("subcc %%g0, %4, %%g0 \n\t" \
"addxcc %2, %3, %0 \n\t" \
"addx %%g0, 0, %1" \
: "=r" (res), "=r" (carryout) \
: "r" (arg1), "r" (arg2), "r" (carryin) \
: "cc")
#define BngAdd3(res,carryaccu,arg1,arg2,arg3) \
asm("addcc %2, %3, %0 \n\t" \
"addx %1, 0, %1 \n\t" \
"addcc %0, %4, %0 \n\t" \
"addx %1, 0, %1" \
: "=r" (res), "=r" (carryaccu) \
: "r" (arg1), "r" (arg2), "r" (arg3), "1" (carryaccu) \
: "cc")
#define BngSub2(res,carryout,arg1,arg2) \
asm("subcc %2, %3, %0 \n\t" \
"addx %%g0, 0, %1" \
: "=r" (res), "=r" (carryout) \
: "r" (arg1), "r" (arg2) \
: "cc")
#define BngSub2Carry(res,carryout,arg1,arg2,carryin) \
asm("subcc %%g0, %4, %%g0 \n\t" \
"subxcc %2, %3, %0 \n\t" \
"addx %%g0, 0, %1" \
: "=r" (res), "=r" (carryout) \
: "r" (arg1), "r" (arg2), "r" (carryin) \
: "cc")
#define BngSub3(res,carryaccu,arg1,arg2,arg3) \
asm("subcc %2, %3, %0 \n\t" \
"addx %1, 0, %1 \n\t" \
"subcc %0, %4, %0 \n\t" \
"addx %1, 0, %1" \
: "=r" (res), "=r" (carryaccu) \
: "r" (arg1), "r" (arg2), "r" (arg3), "1" (carryaccu) \
: "cc")
#define BngMult(resh,resl,arg1,arg2) \
asm("umul %2, %3, %0 \n\t" \
"rd %%y, %1" \
: "=r" (resl), "=r" (resh) \
: "r" (arg1), "r" (arg2))
#define BngDiv(quo,rem,nh,nl,d) \
asm("wr %1, %%y \n\t" \
"udiv %2, %3, %0" \
: "=r" (quo) \
: "r" (nh), "r" (nl), "r" (d)); \
rem = nl - d * quo