555 lines
18 KiB
Plaintext
555 lines
18 KiB
Plaintext
(* Emission of Sparc assembly code *)
|
|
|
|
open Misc
|
|
open Cmm
|
|
open Arch
|
|
open Proc
|
|
open Reg
|
|
open Mach
|
|
open Linearize
|
|
open Emitaux
|
|
|
|
(* Tradeoff between code size and code speed *)
|
|
|
|
let fastcode_flag = ref true
|
|
|
|
(* Return the other register in a register pair *)
|
|
|
|
let next_in_pair = function
|
|
{loc = Reg r; typ = (Int | Addr)} -> phys_reg (r + 1)
|
|
| {loc = Reg r; typ = Float} -> phys_reg (r + 15)
|
|
| _ -> fatal_error "Emit.next_in_pair"
|
|
|
|
(* Symbols are prefixed with _ *)
|
|
|
|
let emit_symbol s =
|
|
emit_string "_"; Emitaux.emit_symbol s
|
|
|
|
(* Output a label *)
|
|
|
|
let emit_label lbl =
|
|
emit_string "L"; 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
|
|
| Iindexed2 ofs ->
|
|
if ofs = 0 then
|
|
` {emit_string instr} [{emit_reg arg.(0)} + {emit_reg arg.(1)}], {emit_reg dst}\n`
|
|
else if is_immediate ofs then begin
|
|
` add {emit_reg arg.(1)}, {emit_int ofs}, %g1\n`;
|
|
` {emit_string instr} [{emit_reg arg.(0)} + %g1], {emit_reg dst}\n`
|
|
end else begin
|
|
` sethi %hi({emit_int ofs}), %g1\n`;
|
|
` or %g1, %lo({emit_int ofs}), %g1\n`;
|
|
` add {emit_reg arg.(1)}, %g1, %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
|
|
| Iindexed2 ofs ->
|
|
if ofs = 0 then
|
|
` {emit_string instr} {emit_reg src}, [{emit_reg arg.(1)} + {emit_reg arg.(2)}]\n`
|
|
else if is_immediate ofs then begin
|
|
` add {emit_reg arg.(2)}, {emit_int ofs}, %g1\n`;
|
|
` {emit_string instr} {emit_reg src}, [{emit_reg arg.(1)} + %g1]\n`
|
|
end else begin
|
|
` sethi %hi({emit_int ofs}), %g1\n`;
|
|
` or %g1, %lo({emit_int ofs}), %g1\n`;
|
|
` add {emit_reg arg.(2)}, %g1, %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 live =
|
|
let lbl = new_label() in
|
|
let live_offset = ref [] in
|
|
Reg.Set.iter
|
|
(function
|
|
{typ = Addr; loc = Reg r} ->
|
|
live_offset := (-1 - r) :: !live_offset
|
|
| {typ = Addr; loc = Stack s} as reg ->
|
|
live_offset := slot_offset s (register_class reg) :: !live_offset
|
|
| _ -> ())
|
|
live;
|
|
frame_descriptors :=
|
|
{ fd_lbl = lbl;
|
|
fd_frame_size = frame_size();
|
|
fd_live_offset = !live_offset } :: !frame_descriptors;
|
|
`{emit_label lbl}:`
|
|
|
|
let emit_frame fd =
|
|
` .word {emit_label fd.fd_lbl} + 8\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 2\n`
|
|
|
|
(* Record floating-point constants *)
|
|
|
|
let float_constants = ref ([] : (int * string) list)
|
|
|
|
let emit_float_constant (lbl, cst) =
|
|
` .data\n`;
|
|
`{emit_label lbl}: .double 0r{emit_string cst}\n`
|
|
|
|
(* Names of various instructions *)
|
|
|
|
let name_for_int_operation = function
|
|
Iadd -> "add"
|
|
| Isub -> "sub"
|
|
| Imul -> "smul"
|
|
| Iand -> "and"
|
|
| Ior -> "or"
|
|
| Ixor -> "xor"
|
|
| Ilsl -> "sll"
|
|
| Ilsr -> "srl"
|
|
| Iasr -> "sra"
|
|
| _ -> Misc.fatal_error "Emit.name_for_int_operation"
|
|
|
|
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 = function
|
|
Ceq -> "fbe" | Cne -> "fbne"
|
|
| Cle -> "fble" | Cgt -> "fbgt"
|
|
| Clt -> "fbl" | Cge -> "fbge"
|
|
|
|
(* Output the assembly code for an instruction *)
|
|
|
|
let function_name = ref ""
|
|
let tailrec_entry_point = ref 0
|
|
|
|
let emit_instr i =
|
|
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 rs; typ = (Int | Addr)}, {loc = Reg rd} ->
|
|
if rs <> rd then
|
|
` mov {emit_reg src}, {emit_reg dst}\n`
|
|
| {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = Float} ->
|
|
if rs <> rd then
|
|
` 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 rd land 1 = 0 then
|
|
` ldd [%sp + 96], {emit_reg dst}\n`
|
|
else begin
|
|
` ld [%sp + 96], {emit_reg dst}\n`;
|
|
` ld [%sp + 96], {emit_reg(next_in_pair dst)}\n`
|
|
end;
|
|
` add %sp, 8, %sp\n`
|
|
| {loc = Reg rs; typ = (Int | Addr)}, {loc = Stack sd} ->
|
|
` st {emit_reg src}, {emit_stack dst}\n`
|
|
| {loc = Reg rs; typ = Float}, {loc = Stack sd} ->
|
|
` std {emit_reg src}, {emit_stack dst}\n`
|
|
| {loc = Stack ss; typ = (Int | Addr)}, {loc = Reg rd} ->
|
|
` ld {emit_stack src}, {emit_reg dst}\n`
|
|
| {loc = Stack ss; typ = Float}, {loc = Reg rd} ->
|
|
` ldd {emit_stack src}, {emit_reg dst}\n`
|
|
| (_, _) ->
|
|
fatal_error "Emit: Imove"
|
|
end
|
|
| Lop(Iconst_int n) ->
|
|
if is_immediate n then
|
|
` mov {emit_int n}, {emit_reg i.res.(0)}\n`
|
|
else begin
|
|
` sethi %hi({emit_int n}), %g1\n`;
|
|
` or %g1, %lo({emit_int n}), {emit_reg i.res.(0)}\n`
|
|
end
|
|
| Lop(Iconst_float s) ->
|
|
let lbl = new_label() in
|
|
float_constants := (lbl, s) :: !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) ->
|
|
`{record_frame i.live} call {emit_reg i.arg.(0)}\n`;
|
|
` nop\n`
|
|
| Lop(Icall_imm s) ->
|
|
`{record_frame i.live} call {emit_symbol s}\n`;
|
|
` nop\n`
|
|
| Lop(Itailcall_ind) ->
|
|
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`;
|
|
if n > 0 then
|
|
` add %sp, {emit_int n}, %sp\n`
|
|
else
|
|
` nop\n`
|
|
| Lop(Itailcall_imm s) ->
|
|
if s = !function_name then begin
|
|
` b {emit_label !tailrec_entry_point}\n`;
|
|
` nop\n`
|
|
end else begin
|
|
let n = frame_size() in
|
|
if !contains_calls then
|
|
` ld [%sp + {emit_int(n - 4 + 96)}], %o7\n`;
|
|
` sethi %hi({emit_symbol s}), %g1\n`;
|
|
` jmp %g1 + %lo({emit_symbol s})\n`;
|
|
if n > 0 then
|
|
` add %sp, {emit_int n}, %sp\n`
|
|
else
|
|
` nop\n`
|
|
end
|
|
| Lop(Iextcall s) ->
|
|
` sethi %hi({emit_symbol s}), %g1\n`;
|
|
`{record_frame i.live} call _caml_c_call\n`;
|
|
` or %g1, %lo({emit_symbol s}), %g1\n`
|
|
| Lop(Istackoffset n) ->
|
|
` add %sp, {emit_int (-n)}, %sp\n`;
|
|
stack_offset := !stack_offset + n
|
|
| Lop(Iload(chunk, addr)) ->
|
|
begin match i.res.(0).typ with
|
|
Int | Addr ->
|
|
let loadinstr =
|
|
match chunk with
|
|
Word -> "ld"
|
|
| Byte_unsigned -> "ldub"
|
|
| Byte_signed -> "ldsb"
|
|
| Sixteen_unsigned -> "lduh"
|
|
| Sixteen_signed -> "ldsh" in
|
|
emit_load loadinstr addr i.arg i.res.(0)
|
|
| Float ->
|
|
emit_load "ld" addr i.arg i.res.(0);
|
|
emit_load "ld" (offset_addressing addr 4) i.arg (next_in_pair i.res.(0))
|
|
end
|
|
| Lop(Istore(chunk, addr)) ->
|
|
begin match i.arg.(0).typ with
|
|
Int | Addr ->
|
|
let storeinstr =
|
|
match chunk with
|
|
Word -> "st"
|
|
| Byte_unsigned | Byte_signed -> "stb"
|
|
| Sixteen_unsigned | Sixteen_signed -> "sth" in
|
|
emit_store storeinstr addr i.arg i.arg.(0)
|
|
| Float ->
|
|
emit_store "st" addr i.arg i.arg.(0);
|
|
emit_store "st" (offset_addressing addr 4) i.arg (next_in_pair i.arg.(0))
|
|
end
|
|
| Lop(Ialloc n) ->
|
|
if !fastcode_flag then begin
|
|
let lbl_cont = new_label() in
|
|
` sub %g6, {emit_int n}, %g6\n`;
|
|
` cmp %g6, %g7\n`;
|
|
` bgeu {emit_label lbl_cont}\n`;
|
|
` add %g6, 4, {emit_reg i.res.(0)}\n`;
|
|
`{record_frame i.live} call _caml_call_gc\n`;
|
|
` mov {emit_int n}, %g1\n`;
|
|
` add %g6, 4, {emit_reg i.res.(0)}\n`;
|
|
`{emit_label lbl_cont}:`
|
|
end else begin
|
|
`{record_frame i.live} call _caml_alloc\n`;
|
|
` mov {emit_int n}, %g1\n`;
|
|
` add %g6, 4, {emit_reg i.res.(0)}\n`
|
|
end
|
|
| Lop(Imodify) ->
|
|
if !fastcode_flag then begin
|
|
` ld [{emit_reg i.arg.(0)} - 4], %g4\n`;
|
|
` andcc %g4, 1024, %g0\n`;
|
|
let lbl_continue = new_label() in
|
|
` bne {emit_label lbl_continue}\n`;
|
|
` nop\n`;
|
|
` call _caml_fast_modify\n`;
|
|
` mov {emit_reg i.arg.(0)}, %g1\n`;
|
|
`{emit_label lbl_continue}:`
|
|
end else begin
|
|
` call _caml_modify\n`;
|
|
` mov {emit_reg i.arg.(0)}, %g1\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 Idiv) ->
|
|
` sra {emit_reg i.arg.(0)}, 31, %g1\n`;
|
|
` wr %g0, %g1, %y\n`;
|
|
` nop\n`;
|
|
` nop\n`;
|
|
` nop\n`;
|
|
` sdiv {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
|
|
| Lop(Iintop Imod) ->
|
|
` sra {emit_reg i.arg.(0)}, 31, %g1\n`;
|
|
` wr %g0, %g1, %y\n`;
|
|
` nop\n`;
|
|
` nop\n`;
|
|
` nop\n`;
|
|
` sdiv {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, %g1\n`;
|
|
` smul %g1, {emit_reg i.arg.(1)}, %g1\n`;
|
|
` sub {emit_reg i.arg.(0)}, %g1, {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(Idiv, n)) ->
|
|
` sra {emit_reg i.arg.(0)}, 31, %g1\n`;
|
|
` wr %g0, %g1, %y\n`;
|
|
` nop\n`;
|
|
` nop\n`;
|
|
` nop\n`;
|
|
` sdiv {emit_reg i.arg.(0)}, {emit_int n}, {emit_reg i.res.(0)}\n`
|
|
| Lop(Iintop_imm(Imod, n)) ->
|
|
` sra {emit_reg i.arg.(0)}, 31, %g1\n`;
|
|
` wr %g0, %g1, %y\n`;
|
|
` nop\n`;
|
|
` nop\n`;
|
|
` nop\n`;
|
|
` sdiv {emit_reg i.arg.(0)}, {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`
|
|
| 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(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(Iaddf) ->
|
|
` faddd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
|
|
| Lop(Isubf) ->
|
|
` fsubd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
|
|
| Lop(Imulf) ->
|
|
` fmuld {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
|
|
| Lop(Idivf) ->
|
|
` fdivd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.res.(0)}\n`
|
|
| Lop(Ifloatofint) ->
|
|
` sub %sp, 4, %sp\n`;
|
|
` st {emit_reg i.arg.(0)}, [%sp + 96]\n`;
|
|
` ld [%sp + 96], %f30\n`;
|
|
` add %sp, 4, %sp\n`;
|
|
` fitod %f30, {emit_reg i.res.(0)}\n`
|
|
| Lop(Iintoffloat) ->
|
|
` fdtoi {emit_reg i.arg.(0)}, %f30\n`;
|
|
` sub %sp, 4, %sp\n`;
|
|
` st %f30, [%sp + 96]\n`;
|
|
` ld [%sp + 96], {emit_reg i.res.(0)}\n`;
|
|
` add %sp, 4, %sp\n`
|
|
| Lop(Ispecific sop) ->
|
|
fatal_error "Emit: specific"
|
|
| Lreturn ->
|
|
let n = frame_size() in
|
|
if !contains_calls then
|
|
` ld [%sp + {emit_int(n - 4 + 96)}], %o7\n`;
|
|
` retl\n`;
|
|
if n > 0 then
|
|
` add %sp, {emit_int n}, %sp\n`
|
|
else
|
|
` nop\n`
|
|
| Llabel lbl ->
|
|
`{emit_label lbl}:\n`
|
|
| Lbranch lbl ->
|
|
` b {emit_label lbl}\n`;
|
|
` nop\n`
|
|
| Lcondbranch(tst, lbl) ->
|
|
begin match tst with
|
|
Itruetest ->
|
|
` tst {emit_reg i.arg.(0)}\n`;
|
|
` bne {emit_label lbl}\n`;
|
|
` nop\n`
|
|
| Ifalsetest ->
|
|
` tst {emit_reg i.arg.(0)}\n`;
|
|
` be {emit_label lbl}\n`;
|
|
` nop\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`;
|
|
` nop\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`;
|
|
` nop\n`
|
|
| Ifloattest cmp ->
|
|
let comp = name_for_float_comparison cmp in
|
|
` fcmpd {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
|
|
` {emit_string comp} {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, %g4\n`;
|
|
` ld [%g1 + %g4], %g1\n`;
|
|
` jmp %g1\n`;
|
|
` nop\n`;
|
|
`{emit_label lbl_jumptbl}:`;
|
|
for i = 0 to Array.length jumptbl - 1 do
|
|
` .word {emit_label jumptbl.(i)}\n`
|
|
done
|
|
| Lpushtrap lbl ->
|
|
stack_offset := !stack_offset + 8;
|
|
` sub %sp, 8, %sp\n`;
|
|
` sethi %hi({emit_label lbl}), %g4\n`;
|
|
` or %g4, %lo({emit_label lbl}), %g4\n`;
|
|
` std %g4, [%sp + 96]\n`; (* Write %g4 and %g5 *)
|
|
` mov %sp, %g5\n`
|
|
| Lpoptrap ->
|
|
` ld [%sp + 100], %g5\n`;
|
|
` add %sp, 8, %sp\n`;
|
|
stack_offset := !stack_offset - 8
|
|
| Lentertrap ->
|
|
()
|
|
| Lraise ->
|
|
` mov %g5, %sp\n`;
|
|
` ldd [%sp + 96], %g4\n`; (* Load %g4 and %g5 *)
|
|
` jmp %g4\n`;
|
|
` add %sp, 8, %sp\n`
|
|
|
|
let rec emit_all i =
|
|
match i.desc with Lend -> () | _ -> emit_instr i; 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();
|
|
stack_offset := 0;
|
|
float_constants := [];
|
|
` .text\n`;
|
|
` .align 4\n`;
|
|
` .global {emit_symbol fundecl.fun_name}\n`;
|
|
`{emit_symbol fundecl.fun_name}:\n`;
|
|
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}:`;
|
|
emit_all fundecl.fun_body;
|
|
List.iter emit_float_constant !float_constants
|
|
|
|
(* Emission of data *)
|
|
|
|
let emit_item = function
|
|
Cdefine_symbol s ->
|
|
` .global {emit_symbol s}\n`;
|
|
`{emit_symbol s}:\n`
|
|
| Cdefine_label lbl ->
|
|
`{emit_label (lbl + 10000)}:\n`
|
|
| Cint8 n ->
|
|
` .byte {emit_int n}\n`
|
|
| Cint16 n ->
|
|
` .half {emit_int n}\n`
|
|
| Cint n ->
|
|
` .word {emit_int n}\n`
|
|
| Cfloat f ->
|
|
` .double 0r{emit_string f}\n`
|
|
| Csymbol_address s ->
|
|
` .word {emit_symbol s}\n`
|
|
| Clabel_address s ->
|
|
` .word {emit_label (lbl + 10000)}\n`
|
|
| Cstring s ->
|
|
let l = String.length s in
|
|
if l = 0 then ()
|
|
else if l < 80 then
|
|
` .ascii {emit_string_literal s}\n`
|
|
else begin
|
|
let i = ref 0 in
|
|
while !i < l do
|
|
let n = min (l - !i) 80 in
|
|
` .ascii {emit_string_literal(String.sub s !i n)}\n`;
|
|
i := !i + n
|
|
done
|
|
end
|
|
| Cskip n ->
|
|
if n > 0 then ` .skip {emit_int n}\n`
|
|
| Calign n ->
|
|
` .align {emit_int(Misc.log2 n)}\n`
|
|
|
|
let data l =
|
|
` .data\n`;
|
|
List.iter emit_item l
|
|
|
|
(* Beginning / end of an assembly file *)
|
|
|
|
let begin_assembly() = ()
|
|
|
|
let end_assembly() =
|
|
` .data\n`;
|
|
` .global _Frametable\n`;
|
|
`_Frametable:\n`;
|
|
List.iter emit_frame !frame_descriptors;
|
|
frame_descriptors := [];
|
|
` .word 0\n`
|