Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

enhancement: SPARC code generation improvements #3717

Closed
vicuna opened this issue Sep 19, 2002 · 1 comment
Closed

enhancement: SPARC code generation improvements #3717

vicuna opened this issue Sep 19, 2002 · 1 comment
Labels
feature-wish

Comments

@vicuna
Copy link

vicuna commented Sep 19, 2002

Original bug ID: 1396
Reporter: administrator
Status: closed
Resolution: fixed
Priority: normal
Severity: feature
Category: ~DO NOT USE (was: OCaml general)

Bug description

Enclosed are my SPARC code generation changes.

Code may be generated for different SPARC versions -- old SPARC,
SPARC V8, SPARC V9. The target must be selected at compile time.
This is suboptimal but I didn't see any trivial way to pass flags
from the command line to the code generator.

List of changes:

proc.ml: Update latencies for UltraSPARC. Pass appropriate -xarch=
flag to assembler.

emit.mlp: On Solaris, emit .type and .size directives, put frame table
and floating point constants in read-only data section, and support
profiling.

emit.mlp: For SPARC V9, use new double precision floating point
instructions (fabsd, fmovd, fnegd) and conditional move, and omit
the nop after a floating point comparison.

For SPARC V8 and V9, use hardware multiply and divide.

Emit add src,src,dst instead of sll src,1,dst because the former is
faster on UltraSPARC.

If a function does not allocate any stack space, change add %sp,0,%sp
in the epilogue to a nop.

On Solaris, store the allocation limit in a register (instead of
storing the address in a register).

Support reg+reg addressing mode.

emit.mlp and sparc.S: Avoid ldd and std instructions on UltraSPARC.

*** asmcomp/sparc/proc.ml.orig Mon Jul 22 12:37:55 2002
--- asmcomp/sparc/proc.ml Thu Sep 19 16:08:45 2002

*** 198,215 ****
Iextcall(_, _) -> [| 11; 0 |]
| _ -> [| 19; 15 |]

! (* Latencies (in cycles). Wild guesses. *)

let need_scheduling = true

let oper_latency = function
Ireload -> 3
| Iload(_, _) -> 3
| Iconst_float _ -> 3 (* turned into a load *)
! | Iaddf | Isubf -> 3
! | Imulf -> 5
| Idivf -> 15
! | _ -> 1

(* Layout of the stack *)

--- 198,224 ----
Iextcall(_, _) -> [| 11; 0 |]
| _ -> [| 19; 15 |]

! (* Latencies (in cycles). *)

let need_scheduling = true

  • (* UltraSPARC issues two integer operations, plus a single load or store,
  • per cycle. At most one of the ingteger 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. *)
    let oper_latency = function
    Ireload -> 3
  • | Iload((Byte_signed|Sixteen_signed|Thirtytwo_signed), ) -> 4
    | Iload(    , _) -> 3
    | Iconst_float _ -> 3 (* turned into a load *)
    ! | Ispecific _ -> 4
    ! | Inegf | Iabsf | Iaddf | Isubf | Imulf -> 4
    | Idivf -> 15
    ! | _ -> 2

(* Layout of the stack *)

*** 219,225 ****
(* Calling the assembler and the archiver *)

let assemble_file infile outfile =
! Ccomp.command ("as -o " ^ Filename.quote outfile ^ " " ^ Filename.quote infile)

open Clflags;;
open Config;;
--- 228,239 ----
(* Calling the assembler and the archiver *)

let assemble_file infile outfile =
! let asprefix = begin match !arch_version with
! SPARC_V7 -> "as -o "
! | SPARC_V8 -> "as -xarch=v8 -o "
! | SPARC_V9 -> "as -xarch=v8plus -o "
! end in
! Ccomp.command (asprefix ^ Filename.quote outfile ^ " " ^ Filename.quote infile)

open Clflags;;
open Config;;
*** asmcomp/sparc/emit.mlp.orig Mon Jul 22 12:37:55 2002
--- asmcomp/sparc/emit.mlp Thu Sep 19 16:18:09 2002

*** 68,73 ****
--- 68,83 ----
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" *) then

  • `	.section \".rodata\"\n`

  • else

  • `	.data\n`

  • (* Check if an integer or native integer is an immediate operand *)

    let is_immediate n =

*** 117,122 ****
--- 127,137 ----
or %g1, %lo({emit_int ofs}), %g1\n;
{emit_string instr} [{emit_reg arg.(0)} + %g1], {emit_reg dst}\n
end

  • | Iindexed2 0 ->

  •   `	{emit_string instr}	[{emit_reg arg.(0)} + {emit_reg arg.(1)}], {emit_reg dst}\n`

  • | Iindexed2 n ->

  •   `	add	{emit_reg arg.(0)}, {emit_reg arg.(1)}, %g1\n`;

  •   `	{emit_string instr}	[%g1 + {emit_int n}], {emit_reg dst}\n`

    (* Output a store *)

*** 136,142 ****
--- 151,163 ----
or %g1, %lo({emit_int ofs}), %g1\n;
{emit_string instr} {emit_reg src}, [{emit_reg arg.(1)} + %g1]\n
end

  • | Iindexed2 0 ->

  •   `       {emit_string instr}	{emit_reg src}, [{emit_reg arg.(0)} + {emit_reg arg.(1)}]\n`

  • | Iindexed2 n ->

  •   `       add     {emit_reg arg.(0)}, {emit_reg arg.(1)}, %g1\n`;

  •   `       {emit_string instr}	{emit_reg src}, [%g1 + {emit_int n}]\n`

  • (* Record live pointers at call points *)

    type frame_descr =

*** 179,188 ****
let float_constants = ref ([] : (int * string) list)

let emit_float_constant (lbl, cst) =
! .data\n;
.align 8\n;
{emit_label lbl}: .double 0r{emit_string cst}\n

(* Names of various instructions *)

let name_for_int_operation = function
--- 200,225 ----
let float_constants = ref ([] : (int * string) list)

let emit_float_constant (lbl, cst) =
! rodata ();
.align 8\n;
{emit_label lbl}: .double 0r{emit_string cst}\n

  • (* 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

*** 194,204 ****
| Ilsl -> "sll"
| Ilsr -> "srl"
| Iasr -> "sra"
| _ -> Misc.fatal_error "Emit.name_for_int_operation"

let name_for_float_operation = function
! Inegf -> "fnegs"
! | Iabsf -> "fabss"
| Iaddf -> "faddd"
| Isubf -> "fsubd"
| Imulf -> "fmuld"
--- 231,242 ----
| 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 "fnegs" else "fnegd"
! | Iabsf -> if !arch_version != SPARC_V9 then "fabss" else "fabsd"
| Iaddf -> "faddd"
| Isubf -> "fsubd"
| Imulf -> "fmuld"

*** 205,210 ****
--- 243,256 ----
| 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"

*** 236,249 ****
{loc = Reg rs; typ = (Int | Addr)}, {loc = Reg rd} ->
mov {emit_reg src}, {emit_reg dst}\n
| {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = Float} ->
! fmovs {emit_reg src}, {emit_reg dst}\n;
! fmovs {emit_reg(next_in_pair src)}, {emit_reg(next_in_pair dst)}\n
| {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = (Int | Addr)} ->
(* 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;
! if rd land 1 = 0 then
ldd [%sp + 96], {emit_reg dst}\n
else begin
ld [%sp + 96], {emit_reg dst}\n;
--- 282,299 ----
{loc = Reg rs; typ = (Int | Addr)}, {loc = Reg rd} ->
mov {emit_reg src}, {emit_reg dst}\n
| {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = Float} ->
! if !arch_version != SPARC_V9 then begin
! fmovs {emit_reg src}, {emit_reg dst}\n;
! fmovs {emit_reg(next_in_pair src)}, {emit_reg(next_in_pair dst)}\n
! end
! else
! fmovd {emit_reg src}, {emit_reg dst}\n
| {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = (Int | Addr)} ->
( 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;
! if !arch_version != SPARC_V9 && rd land 1 = 0 then
ldd [%sp + 96], {emit_reg dst}\n
else begin
ld [%sp + 96], {emit_reg dst}\n;

*** 269,274 ****
--- 319,326 ----
or %g1, %lo({emit_nativeint n}), {emit_reg i.res.(0)}\n
end
| Lop(Iconst_float s) ->

  •     (* 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, s) :: !float_constants;
    `	sethi	%hi({emit_label lbl}), %g1\n`;

*** 352,361 ****
end
| Lop(Ialloc n) ->
if !fastcode_flag then begin
! let lbl_cont = new_label() in
! ld [%l7], %g1\n;
sub %l6, {emit_int n}, %l6\n;
! cmp %l6, %g1\n;
bgeu {emit_label lbl_cont}\n;
add %l6, 4, {emit_reg i.res.(0)}\n; (* in delay slot )
{record_frame i.live} call {emit_symbol "caml_call_gc"}\n;
--- 404,418 ----
end
| Lop(Ialloc n) ->
if !fastcode_flag then begin
! let lbl_cont = new_label()
! and indirect = Config.system <> "solaris" in
! if indirect then
! ld [%l7], %g1\n;
sub %l6, {emit_int n}, %l6\n;
! if indirect then
! cmp %l6, %g1\n
! else
! cmp %l6, %l7\n;
bgeu {emit_label lbl_cont}\n;
add %l6, 4, {emit_reg i.res.(0)}\n; ( in delay slot *)
{record_frame i.live} call {emit_symbol "caml_call_gc"}\n;

*** 368,396 ****
add %l6, 4, {emit_reg i.res.(0)}\n
end
| Lop(Iintop(Icomp cmp)) ->

  •     let comp = name_for_int_comparison cmp in
    `	cmp	{emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;

! let 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
| Lop(Iintop Icheckbound) ->
cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n;
tleu 5\n (* 5 = ST_RANGE_CHECK )
| 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(Idiv, n)) -> ( n is a power of 2 )
let l = Misc.log2 n in
! let lbl = new_label() in
! cmp {emit_reg i.arg.(0)}, 0\n;
! bge {emit_label lbl}\n;
! mov {emit_reg i.arg.(0)}, %g1\n; ( in delay slot )
! add %g1, {emit_int (n-1)}, %g1\n;
! {emit_label lbl}:\n;
! sra %g1, {emit_int l}, {emit_reg i.res.(0)}\n
| Lop(Iintop_imm(Imod, n)) -> ( n is a power of 2 )
let lbl = new_label() in
tst {emit_reg i.arg.(0)}\n;
bge {emit_label lbl}\n;
--- 425,484 ----
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;
tleu 5\n ( 5 = ST_RANGE_CHECK *)

  •   (*

  • | Lop(Iintop Imod) ->

  •     `	sra	{emit_reg i.arg.(0)}, 0, %g1\n`;

  •     `	sra	{emit_reg i.arg.(1)}, 0, %g2\n`;

  •     `	sdivx	%g1, %g2, %g1\n`;

  •     `	smul	%g1, %g2, %g1\n`;

  •     `	sub	{emit_reg i.arg.(0)}, %g1, {emit_reg i.res.(0)}\n`

  •   *)

  • | 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 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(Idiv, n)) ->       (* n is a power of 2 *)
    let l = Misc.log2 n in

! if n = 1 lsl l then begin
! let lbl = new_label() in
! cmp {emit_reg i.arg.(0)}, 0\n;
! bge {emit_label lbl}\n;
! mov {emit_reg i.arg.(0)}, %g1\n; (* in delay slot )
! add %g1, {emit_int (n-1)}, %g1\n;
! {emit_label lbl}:\n;
! sra %g1, {emit_int l}, {emit_reg i.res.(0)}\n
! end
! else begin ( Not a power of 2 )
! sra {emit_reg i.arg.(0)}, 31, %g1\n;
! wr %g1, %y\n;
! sdiv {emit_reg i.arg.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n
! end
| Lop(Iintop_imm(Imod, n)) -> ( n is a power of 2 *)

  •     let log = Misc.log2 n in

  •    	if n != 1 lsl log then Misc.fatal_error "Imod operand" else
    let lbl = new_label() in
    `	tst	{emit_reg i.arg.(0)}\n`;
    `	bge	{emit_label lbl}\n`;

*** 399,412 ****
nop\n;
sub {emit_reg i.res.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n;
{emit_label lbl}:\n
| Lop(Iintop_imm(Icomp cmp, n)) ->

  •     let comp = name_for_int_comparison cmp in
    `	cmp	{emit_reg i.arg.(0)}, {emit_int n}\n`;

! let 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
| Lop(Iintop_imm(Icheckbound, n)) ->
cmp {emit_reg i.arg.(0)}, {emit_int n}\n;
tleu 5\n (* 5 = ST_RANGE_CHECK *)
--- 487,514 ----
nop\n;
sub {emit_reg i.res.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n;
{emit_label lbl}:\n

  • (* begin
  •       `	sra	{emit_reg i.arg.(0)}, 0, %g1\n`;

  •       `	sdivx	%g1, {emit_int n}, %g1\n`;

  •       `	smul	%g1, {emit_int n}, %g1\n`;

  •       `	sub	{emit_reg i.arg.(0)}, %g1, {emit_reg i.res.(0)}\n`

  •     end
  • )
    | 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} %xcc, 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;
    tleu 5\n (     5 = ST_RANGE_CHECK *)

*** 416,422 ****
| 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;
! 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
--- 518,525 ----
| 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

*** 432,439 ****
st %f30, [%sp + 96]\n;
ld [%sp + 96], {emit_reg i.res.(0)}\n;
add %sp, 8, %sp\n
! | Lop(Ispecific sop) ->
! fatal_error "Emit: specific"
| Lreloadretaddr ->
let n = frame_size() in
ld [%sp + {emit_int(n - 4 + 96)}], %o7\n
--- 535,550 ----
st %f30, [%sp + 96]\n;
ld [%sp + 96], {emit_reg i.res.(0)}\n;
add %sp, 8, %sp\n
! | Lop(Ispecific(Icmov(cmp, n1, n2))) ->
! let suffix = name_for_int_movcc (Isigned cmp) in
! cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n;
! mov {emit_int n1}, {emit_reg i.res.(0)}\n;
! mov{emit_string suffix} %icc, {emit_int n2}, {emit_reg i.res.(0)}\n;
! | Lop(Ispecific(Icmov_imm(cmp, op2, n1, n2))) ->
! let suffix = name_for_int_movcc (Isigned cmp) in
! cmp {emit_reg i.arg.(0)}, {emit_int op2}\n;
! mov {emit_int n1}, {emit_reg i.res.(0)}\n;
! mov{emit_string suffix} %icc, {emit_int n2}, {emit_reg i.res.(0)}\n;
| Lreloadretaddr ->
let n = frame_size() in
ld [%sp + {emit_int(n - 4 + 96)}], %o7\n

*** 440,446 ****
| Lreturn ->
let n = frame_size() in
retl\n;
! add %sp, {emit_int n}, %sp\n
| Llabel lbl ->
{emit_label lbl}:\n
| Lbranch lbl ->
--- 551,560 ----
| 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 ->

*** 465,471 ****
| 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;
--- 579,586 ----
| Ifloattest(cmp, neg) ->
let comp = name_for_float_comparison cmp neg in
fcmpd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n;
! if !arch_version = SPARC_V9 then
! nop\n;
{emit_string comp} {emit_label lbl}\n
| Ioddtest ->
andcc {emit_reg i.arg.(0)}, 1, %g0\n;

*** 544,549 ****
--- 659,665 ----
| 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

*** 595,601 ****
--- 711,720 ----
.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;

*** 603,608 ****
--- 722,728 ----
st %o7, [%sp + {emit_int(n - 4 + 96)}]\n;
{emit_label !tailrec_entry_point}:\n;
emit_all fundecl.fun_body;

  • emit_size fundecl.fun_name;
    List.iter emit_float_constant !float_constants

(* Emission of data *)

*** 674,681 ****
--- 794,805 ----
{emit_symbol lbl_end}:\n;
.word 0\n;
let lbl = Compilenv.current_unit_name() ^ "__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 := []
    *** asmcomp/sparc/arch.ml.orig Mon Jul 22 12:37:54 2002
    --- asmcomp/sparc/arch.ml Tue Sep 10 10:23:13 2002

*** 17,29 ****
open Misc
open Format

! type specific_operation = unit (* None worth mentioning *)

(* Addressing modes *)

type addressing_mode =
Ibased of string * int (* symbol + displ )
| Iindexed of int ( reg + displ *)

(* Sizes, endianness *)

--- 17,41 ----
open Misc
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_V9

  • (* V9 conditional move *)

  • type specific_operation =

  • Icmov of Cmm.comparison * int * int

  • | Icmov_imm of Cmm.comparison * int * int * int

  • (* Addressing modes *)

    type addressing_mode =
    Ibased of string * int (* symbol + displ )
    | Iindexed of int (     reg + displ *)

  • | Iindexed2 of int

(* Sizes, endianness *)

*** 41,50 ****
--- 53,65 ----
match addr with
Ibased(s, n) -> Ibased(s, n + delta)
| Iindexed n -> Iindexed(n + delta)

  • | Iindexed2 0 -> Iindexed2(delta)
  • | Iindexed2 n -> Misc.fatal_error "Arch_sparc.offset_addressing"

let num_args_addressing = function
Ibased(s, n) -> 0
| Iindexed n -> 1

  • | Iindexed2 _ -> 2

(* Printing operations and addressing modes *)

*** 56,61 ****
--- 71,80 ----
| Iindexed n ->
let idx = if n <> 0 then Printf.sprintf " + %i" n else "" in
fprintf ppf "%a%s" printreg arg.(0) idx

  • | Iindexed2 0 ->

  •   fprintf ppf "%a + %a" printreg arg.(0) printreg arg.(1)

  • | Iindexed2 _ ->

  •   Misc.fatal_error "Arch_sparc.offset_addressing"

    let print_specific_operation printreg op ppf arg =
    Misc.fatal_error "Arch_sparc.print_specific_operation"
    *** asmcomp/sparc/selection.ml.orig Thu Dec 28 08:03:03 2000
    --- asmcomp/sparc/selection.ml Sun Sep 15 09:57:48 2002

*** 35,63 ****
(Iindexed n, arg)
| Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) ->
(Iindexed n, Cop(Cadda, [arg1; arg2]))
| arg ->
(Iindexed 0, arg)

method select_operation op args =
! match (op, args) with
! (* Multiplication, division and modulus are turned into
calls to C library routines, except if the dividend is a power of 2. *)
! (Cmuli, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) ->
(Iintop_imm(Ilsl, Misc.log2 n), [arg])
! | (Cmuli, [Cconst_int n; arg]) when n = 1 lsl (Misc.log2 n) ->
(Iintop_imm(Ilsl, Misc.log2 n), [arg])
! | (Cmuli, _) ->
(Iextcall(".umul", false), args)
! | (Cdivi, [arg; Cconst_int n])
when self#is_immediate n && n = 1 lsl (Misc.log2 n) ->
(Iintop_imm(Idiv, n), [arg])
! | (Cdivi, _) ->
(Iextcall(".div", false), args)
! | (Cmodi, [arg; Cconst_int n])
when self#is_immediate n && n = 1 lsl (Misc.log2 n) ->
(Iintop_imm(Imod, n), [arg])
! | (Cmodi, _) ->
(Iextcall(".rem", false), args)
| _ ->
super#select_operation op args

--- 35,80 ----
(Iindexed n, arg)
| Cop(Cadda, [arg1; Cop(Caddi, [arg2; Cconst_int n])]) ->
(Iindexed n, Cop(Cadda, [arg1; arg2]))

  • | Cop(Cadda, [arg1; arg2]) ->

  •   (Iindexed2 0, Ctuple[arg1; arg2])

    | arg ->
    (Iindexed 0, arg)

    method select_operation op args =
    ! match (!arch_version, op, args) with
    ! (* For SPARC V7 multiplication, division and modulus are turned into
    calls to C library routines, except if the dividend is a power of 2. )
    ! (SPARC_V7, Cmuli, [arg; Cconst_int n]) when n = 1 lsl (Misc.log2 n) ->
    (Iintop_imm(Ilsl, Misc.log2 n), [arg])
    ! | (SPARC_V7, Cmuli, [Cconst_int n; arg]) when n = 1 lsl (Misc.log2 n) ->
    (Iintop_imm(Ilsl, Misc.log2 n), [arg])
    ! | (SPARC_V7, Cmuli, ) ->
    (Iextcall(".umul", false), args)
    ! | (    , Cdivi, [arg; Cconst_int n])
    when self#is_immediate n && n = 1 lsl (Misc.log2 n) ->
    (Iintop_imm(Idiv, n), [arg])
    ! | (SPARC_V7, Cdivi, ) ->
    (Iextcall(".div", false), args)
    ! | (    , Cmodi, [arg; Cconst_int n])
    when self#is_immediate n && n = 1 lsl (Misc.log2 n) ->
    (Iintop_imm(Imod, n), [arg])
    ! (     Remainder on SPARC is slow and requires 5-7 instructions to calculate.
    ! It is not worth generating inline code. *)
    ! | (_, Cmodi, _) ->
    (Iextcall(".rem", false), args)

  • (* Combine conditional move with arithmetic. *)

  • | (SPARC_V9, Caddi, [Cop(Clsl, [Cop(Ccmpi(c),[op1;Cconst_int op2]); Cconst_int n1]); Cconst_int n2])

  • when self#is_immediate op2 && self#is_immediate ((1 lsl n1) + n2) ->

  •   (Ispecific(Icmov_imm(c, op2, n2, (1 lsl n1) + n2)), [op1])

  • | (SPARC_V9, Caddi, [Cop(Clsl, [Cop(Ccmpi(c),oplist); Cconst_int n1]); Cconst_int n2])

  • when self#is_immediate ((1 lsl n1) + n2) ->

  •   (Ispecific(Icmov(c, n2, (1 lsl n1) + n2)), oplist)

  • | (SPARC_V9, Clsl, [Cop(Ccmpi(c),[op1;Cconst_int op2]); Cconst_int n])

  • when self#is_immediate op2 && self#is_immediate (1 lsl n) ->

  •   (Ispecific(Icmov_imm(c, op2, 0, 1 lsl n)), [op1])

  • | (SPARC_V9, Clsl, [Cop(Ccmpi(c),el); Cconst_int n])

  • when self#is_immediate (1 lsl n) ->

  •   (Ispecific(Icmov(c, 0, 1 lsl n)), el)

    | _ ->
    super#select_operation op args

*** asmrun/sparc.S.orig Fri Feb 8 11:55:33 2002
--- asmrun/sparc.S Thu Sep 19 16:00:43 2002

*** 72,77 ****
--- 72,88 ----

#endif

  • #ifdef SYS_solaris
  • #define FUNCTION(sym) .type sym,#function
  • #define OBJECT(sym) .type sym,#object
  • #else
  • #define INDIRECT_LIMIT
  • #define FUNCTION(sym) /**/
  • #define OBJECT(sym) /**/
  • #endif
  • /* Optimize code for UltraSPARC instead of older systems. See below. */
  • #define ULTRASPARC
  • #define Exn_ptr %l5
    #define Alloc_ptr %l6
    #define Alloc_limit %l7

*** 85,96 ****
--- 96,115 ----
.text
.global Caml_alloc
.global Caml_call_gc

  •     FUNCTION(Caml_alloc)

  •     FUNCTION(Caml_call_gc)

    /* Required size in %g2 */
    Caml_alloc:

  • #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

*** 112,117 ****
--- 131,156 ----
sub %sp, 204 + 158, %sp
/* Save int regs on stack and save it into caml_gc_regs /
L100: add %sp, 96 + 158, %g2

  • /* SPARC V9 deprecates the ldd and std instructions, and UltraSPARC

  •    goes to some effort to make them slow.  */
  • #ifdef ULTRASPARC
  •     st      %o0, [%g2]

  •     st      %o1, [%g2 + 0x4]

  •     st      %o2, [%g2 + 0x8]

  •     st      %o3, [%g2 + 0xc]

  •     st      %o4, [%g2 + 0x10]

  •     st      %o5, [%g2 + 0x14]

  •     st      %i0, [%g2 + 0x18]

  •     st      %i1, [%g2 + 0x1c]

  •     st      %i2, [%g2 + 0x20]

  •     st      %i3, [%g2 + 0x24]

  •     st      %i4, [%g2 + 0x28]

  •     st      %i5, [%g2 + 0x2c]

  •     st      %l0, [%g2 + 0x30]

  •     st      %l1, [%g2 + 0x34]

  •     st      %l2, [%g2 + 0x38]

  •     st      %l3, [%g2 + 0x3c]
  • #else
    std %o0, [%g2]
    std %o2, [%g2 + 0x8]
    std %o4, [%g2 + 0x10]

*** 120,125 ****
--- 159,165 ----
std %i4, [%g2 + 0x28]
std %l0, [%g2 + 0x30]
std %l2, [%g2 + 0x38]

  • #endif
    st %l4, [%g2 + 0x40]
    st %g3, [%g2 + 0x44]
    st %g4, [%g2 + 0x48]

*** 146,151 ****
--- 186,209 ----
nop
/* Restore all regs used by the code generator /
add %sp, 96 + 158, %g2

  • #ifdef ULTRASPARC
  •     ld      [%g2], %o0

  •     ld      [%g2 + 0x4], %o1

  •     ld      [%g2 + 0x8], %o2

  •     ld      [%g2 + 0xc], %o3

  •     ld      [%g2 + 0x10], %o4

  •     ld      [%g2 + 0x14], %o5

  •     ld      [%g2 + 0x18], %i0

  •     ld      [%g2 + 0x1c], %i1

  •     ld      [%g2 + 0x20], %i2

  •     ld      [%g2 + 0x24], %i3

  •     ld      [%g2 + 0x28], %i4

  •     ld      [%g2 + 0x2c], %i5

  •     ld      [%g2 + 0x30], %l0

  •     ld      [%g2 + 0x34], %l1

  •     ld      [%g2 + 0x38], %l2

  •     ld      [%g2 + 0x3c], %l3
  • #else
    ldd [%g2], %o0
    ldd [%g2 + 0x8], %o2
    ldd [%g2 + 0x10], %o4

*** 154,159 ****
--- 212,218 ----
ldd [%g2 + 0x28], %i4
ldd [%g2 + 0x30], %l0
ldd [%g2 + 0x38], %l2

  • #endif
    ld [%g2 + 0x40], %l4
    ld [%g2 + 0x44], %g3
    ld [%g2 + 0x48], %g4

*** 177,185 ****
--- 236,250 ----
Load(Young_ptr, Alloc_ptr)
/* Allocate space for block */
Load(Caml_required_size, %g2)

  • #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(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 */

*** 190,195 ****
--- 255,261 ----
/* Call a C function from Caml */

      .global Caml_c_call

  •     FUNCTION(caml_c_call)
    /* Function to call is in %g2 /
    Caml_c_call:
    /     Record lowest stack address and return address */

*** 212,217 ****
--- 278,284 ----
/* Start the Caml program */

      .global Caml_start_program

  •     FUNCTION(Caml_start_program)
    Caml_start_program:
    /* Save all callee-save registers */
    save %sp, -96, %sp

*** 225,235 ****
Load(Caml_bottom_of_stack, %l0)
Load(Caml_last_return_address, %l1)
Load(Caml_gc_regs, %l3)
! std %l0, [%sp + 96]
! st %l3, [%sp + 104]
/* Set up a trap frame to catch exceptions escaping the Caml code /
call L111
! nop
b L110
nop
L111: sub %sp, 8, %sp
--- 292,302 ----
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 Caml code */
call L111
! st %l3, [%sp + 104]
b L110
nop
L111: sub %sp, 8, %sp

*** 239,245 ****
--- 306,316 ----
mov %sp, Exn_ptr
/* Reload allocation pointers */
Load(Young_ptr, Alloc_ptr)

  • #ifdef INDIRECT_LIMIT
    Address(Young_limit, Alloc_limit)
  • #else
  •     Load(Young_limit, Alloc_limit)
  • #endif
    /* Call the Caml code */
    L109: call %l2
    nop

*** 248,254 ****
add %sp, 8, %sp
Store(Exn_ptr, Caml_exception_pointer)
/* Pop callback link, restoring the global variables /
! L112: ldd [%sp + 96], %l0
ld [%sp + 104], %l2
Store(%l0, Caml_bottom_of_stack)
Store(%l1, Caml_last_return_address)
--- 319,326 ----
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)

*** 256,277 ****
add %sp, 16, %sp
/* Save allocation pointer */
Store(Alloc_ptr, Young_ptr)

  • /* Move result where the C function expects it */

  •     mov     %o0, %i0        /* %i0 will become %o0 after restore */
/* Reload callee-save registers and return */
    ret

! restore
L110:
/* The trap handler /
Store(Exn_ptr, Caml_exception_pointer)
/ Encode exception bucket as an exception result */

  •     or      %o0, 2, %o0
    b       L112

! nop

/* Raise an exception from C */

      .global Raise_caml_exception

Raise_caml_exception:
/* Save exception bucket in a register outside the reg windows /
mov %o0, %g2
--- 328,347 ----
add %sp, 16, %sp
/ Save allocation pointer /
Store(Alloc_ptr, 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 Raise_caml_exception

  •     FUNCTION(Raise_caml_exception)
    Raise_caml_exception:
    /* Save exception bucket in a register outside the reg windows */
    mov %o0, %g2

*** 288,294 ****
--- 358,368 ----
L107:
/* Reload allocation registers */
Load(Young_ptr, Alloc_ptr)

  • #ifdef INDIRECT_LIMIT
    Address(Young_limit, Alloc_limit)
  • #else
  •     Load(Young_limit, Alloc_limit)
  • #endif
    /* Branch to exception handler */
    mov %g3, %sp
    ld [%sp + 96], %g1

*** 338,345 ****
--- 412,424 ----
b L108
or %l2, %lo(Caml_apply3), %l2

  • #ifdef SYS_solaris
  •     .section ".rodata"
  • #else
    .data
  • #endif
    .global System_frametable
  •     OBJECT(System_frametable)
    System_frametable:
    .word 1 /* one descriptor /
    .word L109 /     return address into callback */
    *** asmrun/signals.c.orig Mon May 6 08:02:26 2002
    --- asmrun/signals.c Sun Sep 1 13:17:19 2002

*** 32,37 ****
--- 32,39 ----
#include <sys/resource.h>
#endif

  • extern void array_bound_error(void), division_by_zero_error(void);
  • #ifdef _WIN32
    typedef void (*sighandler)(int sig);
    extern sighandler win32_signal(int sig, sighandler action);

*** 57,62 ****
--- 59,69 ----
#endif
#endif

  • #if defined(TARGET_sparc) && defined(SYS_solaris)
  • #define CONTEXT_GPR(ctx, regno) \
  • (ctx)->uc_mcontext.gregs[regno]
  • #endif
  • volatile int async_signal_mode = 0;
    volatile int pending_signal = 0;
    volatile int force_major_slice = 0;

*** 154,159 ****
--- 161,184 ----
async_signal_mode = 0;
}

  • #ifdef POSIX_SIGNALS
  • static void reraise(int sig, int now)
  • {
  • struct sigaction sa;
  • sa.sa_handler = 0;
  • sa.sa_flags = 0;
  • sigemptyset(&sa.sa_mask);
  • sigaction(sig, &sa, 0);
  • /* If the signal was sent using kill() (si_code == 0) or will
  •  not recur then raise it here.  Otherwise return.  The

  •  offending instruction will be reexecuted and the signal

  •  will recur.  */
  • if (now == 1)
  • raise(sig);
  • return;
  • }
  • #endif
  • #if defined(TARGET_alpha) || defined(TARGET_mips)
    void handle_signal(int sig, int code, struct sigcontext * context)
    #elif defined(TARGET_power) && defined(SYS_aix)

*** 162,167 ****
--- 187,194 ----
void handle_signal(int sig, struct sigcontext * context)
#elif defined(TARGET_power) && defined(SYS_rhapsody)
void handle_signal(int sig, int code, struct sigcontext * context)

  • #elif defined(TARGET_sparc) && defined(SYS_solaris)
  • void handle_signal(int sig, int code, void * context)
    #else
    void handle_signal(int sig)
    #endif

*** 205,210 ****
--- 232,242 ----
/* Cached in register 30 */
CONTEXT_GPR(context, 30) = (unsigned long) young_limit;
#endif

  • #if defined(TARGET_sparc) && defined(SYS_solaris)
  •   /* Cached in register l7, which is saved on the stack 7 words
  • after the unbiased stack pointer. */
  •   ((long *)(CONTEXT_GPR((ucontext_t *)context, REG_SP) + 2047))[7] = (long)young_limit;
  • #endif
    }
    }
    }

*** 326,332 ****
--- 358,368 ----
#ifdef POSIX_SIGNALS
sigact.sa_handler = act;
sigemptyset(&sigact.sa_mask);

  • #ifdef SYS_solaris
  • sigact.sa_flags = SA_SIGINFO;
  • #else
    sigact.sa_flags = 0;
  • #endif
    if (sigaction(sig, &sigact, &oldsigact) == -1) sys_error(NO_ARG);
    oldact = oldsigact.sa_handler;
    #else

*** 375,397 ****
}
#endif

#if defined(TARGET_sparc) && defined(SYS_solaris)
static void trap_handler(int sig, siginfo_t * info, void * arg)
{
ucontext_t * context;
! int * sp;

! if (info->si_code != ILL_ILLTRP) {
! fprintf(stderr, "Fatal error: illegal instruction, code 0x%x\n",
! info->si_code);
! exit(100);
! }
! /* Recover young_ptr and caml_exception_pointer from the %l5 and %l6 regs */
context = (ucontext_t *) arg;
! sp = (int *) context->uc_mcontext.gregs[REG_SP];
! caml_exception_pointer = (char *) sp[5];
! young_ptr = (char *) sp[6];
! array_bound_error();
}
#endif

--- 411,478 ----
}
#endif

  • #if defined(TARGET_i386) && defined(SYS_linux_elf)
  • static void trap_handler(int sig, siginfo_t * info, void * arg)
  • {
  • if (info->si_code != FPE_INTDIV) {
  • reraise(SIGFPE, 1);

  • return;
  • }
  • /* No need to change registers; i386 does not cache gc values. */
  • division_by_zero_error();
  • }
  • #endif
  • #if defined(TARGET_sparc) && defined(SYS_solaris)
  • static void trap_handler(int sig, siginfo_t * info, void * arg)
    {
    ucontext_t * context;
    ! long * sp;
    ! int code = info->si_code;

! switch (sig)
! {
! case SIGILL:
! if (code != ILL_ILLTRP) {
! fprintf(stderr, "Fatal error: illegal instruction, code 0x%x\n",
! code);
! /* Illegal instruction exceptions occur before the instruction
! completes and will recur on return from the signal handler. /
! reraise(SIGILL, code == 0);
! return;
! /exit(100);/
! }
! break;
! case SIGFPE:
! if (code != FPE_INTDIV) {
! / Floating point exceptions occur after the instruction completes
! and will not recur on return from the signal handler. /
! reraise(SIGFPE, 1);
! return;
! }
! break;
! }
! / Recover young_ptr and caml_exception_pointer from the %l5 and %l6 regs. */
context = (ucontext_t *) arg;
! #ifdef __sparcv9
! sp = (long *) (CONTEXT_GPR(context, REG_SP) + 2047);
! #else
! sp = (long *) (CONTEXT_GPR(context, REG_SP));
! #endif
! caml_exception_pointer = (char ) sp[5]; / %l5 */
! young_ptr = (char ) sp[6]; / %l6 */
! switch (sig)
! {
! case SIGILL:
! array_bound_error();
! break;
! case SIGFPE:
! division_by_zero_error();
! break;
! }
}
#endif

*** 515,522 ****
--- 596,613 ----
sigemptyset(&act.sa_mask);
act.sa_flags = SA_SIGINFO | SA_NODEFER;
sigaction(SIGILL, &act, NULL);

  • sigaction(SIGFPE, &act, NULL);
    }
    #endif
  • #if defined(TARGET_i386) && defined(SYS_linux_elf)
  • {
  • struct sigaction act;

  • act.sa_sigaction = trap_handler;

  • sigemptyset(&act.sa_mask);

  • act.sa_flags = SA_SIGINFO | SA_NODEFER;

  • sigaction(SIGFPE, &act, NULL);
  • }
  • #endif
    #if defined(TARGET_power)
    {
    struct sigaction act;
    *** asmrun/fail.c.orig Fri Dec 7 08:39:19 2001
    --- asmrun/fail.c Sun Sep 1 13:17:53 2002

*** 176,178 ****
--- 182,197 ----
array_bound_error_bucket.arg = (value) array_bound_error_msg.data;
mlraise((value) &array_bound_error_bucket.exn);
}
+

  • static struct {
  • header_t hdr;
  • value exn;
  • } division_by_zero_error_bucket;
  • void division_by_zero_error(void)
  • {
  • division_by_zero_error_bucket.hdr = Make_header(1, 0, Caml_white);
  • division_by_zero_error_bucket.exn = (value) Division_by_zero;
  • mlraise((value) &division_by_zero_error_bucket.exn);
  • }
@vicuna
Copy link
Author

vicuna commented Dec 2, 2002

Comment author: administrator

Marged with a few changes 2002-11-29 by XL

@vicuna vicuna closed this as completed Dec 2, 2002
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Assignees
No one assigned
Labels
feature-wish
Projects
None yet
Milestone
No milestone
Development

No branches or pull requests
1 participant
@vicuna