593 lines
20 KiB
Plaintext
593 lines
20 KiB
Plaintext
(***********************************************************************)
|
|
(* *)
|
|
(* Objective Caml *)
|
|
(* *)
|
|
(* 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 Q Public License version 1.0. *)
|
|
(* *)
|
|
(***********************************************************************)
|
|
|
|
(* $Id$ *)
|
|
|
|
(* Emission of Mips 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
|
|
|
|
(* Output a label *)
|
|
|
|
let emit_label lbl =
|
|
emit_string "$"; emit_int lbl
|
|
|
|
(* Output a symbol *)
|
|
|
|
let emit_symbol s =
|
|
Emitaux.emit_symbol '$' s
|
|
|
|
(* Output a pseudo-register *)
|
|
|
|
let emit_reg r =
|
|
match r.loc with
|
|
Reg r -> emit_string (register_name r)
|
|
| _ -> fatal_error "Emit_mips.emit_reg"
|
|
|
|
(* Record if $gp is needed *)
|
|
|
|
let uses_gp = ref false
|
|
|
|
(* Layout of the stack frame *)
|
|
|
|
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 if !uses_gp then 8 else 4 else 0) in
|
|
Misc.align size 16
|
|
|
|
let slot_offset loc cl =
|
|
match loc with
|
|
Incoming n -> frame_size() + n
|
|
| Local n ->
|
|
if cl = 0
|
|
then !stack_offset + num_stack_slots.(1) * 8 + n * 4
|
|
else !stack_offset + n * 8
|
|
| Outgoing n -> n
|
|
|
|
(* Output a stack reference *)
|
|
|
|
let emit_stack r =
|
|
match r.loc with
|
|
Stack s ->
|
|
let ofs = slot_offset s (register_class r) in `{emit_int ofs}($sp)`
|
|
| _ -> fatal_error "Emit_mips.emit_stack"
|
|
|
|
(* Output an addressing mode *)
|
|
|
|
let emit_addressing addr r n =
|
|
match addr with
|
|
Iindexed ofs ->
|
|
`{emit_int ofs}({emit_reg r.(n)})`
|
|
| Ibased(s, 0) ->
|
|
`{emit_symbol s}`
|
|
| Ibased(s, ofs) ->
|
|
`{emit_symbol s}`;
|
|
if ofs > 0 then ` + {emit_int ofs}`;
|
|
if ofs < 0 then ` - {emit_int(-ofs)}`
|
|
|
|
(* Communicate live registers at call points to the assembler *)
|
|
|
|
let int_reg_number =
|
|
[| 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19; 20; 21 |]
|
|
|
|
let float_reg_number =
|
|
[| 0; 1; 2; 3; 4; 5; 6; 7; 8; 9; 10; 11; 12; 13; 14; 15; 16; 17; 18; 19;
|
|
20; 21; 22; 23; 24; 25; 26; 27; 28; 29; 30 |]
|
|
|
|
let liveregs instr extra_msk =
|
|
(* $22, $23, $30 always live *)
|
|
let int_mask = ref(0x00000302 lor extra_msk)
|
|
and float_mask = ref 0 in
|
|
let add_register = function
|
|
{loc = Reg r; typ = (Int | Addr)} ->
|
|
int_mask := !int_mask lor (1 lsl (31 - int_reg_number.(r)))
|
|
| {loc = Reg r; typ = Float} ->
|
|
float_mask := !float_mask lor (1 lsl (31 - float_reg_number.(r - 100)))
|
|
| _ -> () in
|
|
Reg.Set.iter add_register instr.live;
|
|
Array.iter add_register instr.arg;
|
|
emit_printf " .livereg 0x%08x, 0x%08x\n" !int_mask !float_mask
|
|
|
|
let live_25 = 1 lsl (31 - 25)
|
|
let live_24 = 1 lsl (31 - 24)
|
|
|
|
(* 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 := ((int_reg_number.(r) lsl 1) + 1) :: !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}\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`
|
|
|
|
(* Determine if $gp is used in the function *)
|
|
|
|
let rec instr_uses_gp i =
|
|
match i.desc with
|
|
Lend -> false
|
|
| Lop(Iconst_symbol s) -> true
|
|
| Lop(Icall_imm s) -> true
|
|
| Lop(Itailcall_imm s) -> true
|
|
| Lop(Iextcall(_, _)) -> true
|
|
| Lop(Iload(_, Ibased(_, _))) -> true
|
|
| Lop(Istore(_, Ibased(_, _))) -> true
|
|
| Lop(Ialloc _) -> true
|
|
| Lop(Iintop(Icheckbound)) -> true
|
|
| Lop(Iintop_imm(Icheckbound, _)) -> true
|
|
| Lswitch jumptbl -> true
|
|
| _ -> instr_uses_gp i.next
|
|
|
|
(* Names of various instructions *)
|
|
|
|
let name_for_comparison = function
|
|
Isigned Ceq -> "eq" | Isigned Cne -> "ne" | Isigned Cle -> "le"
|
|
| Isigned Cge -> "ge" | Isigned Clt -> "lt" | Isigned Cgt -> "gt"
|
|
| Iunsigned Ceq -> "eq" | Iunsigned Cne -> "ne" | Iunsigned Cle -> "leu"
|
|
| Iunsigned Cge -> "geu" | Iunsigned Clt -> "ltu" | Iunsigned Cgt -> "gtu"
|
|
|
|
let name_for_float_comparison cmp neg =
|
|
match cmp with
|
|
Ceq -> ("eq", neg) | Cne -> ("eq", not neg)
|
|
| Cle -> ("le", neg) | Cge -> ("ult", not neg)
|
|
| Clt -> ("lt", neg) | Cgt -> ("ule", not neg)
|
|
|
|
let name_for_int_operation = function
|
|
Iadd -> "addu"
|
|
| Isub -> "subu"
|
|
| Imul -> "mul"
|
|
| Idiv -> "div"
|
|
| Imod -> "rem"
|
|
| Iand -> "and"
|
|
| Ior -> "or"
|
|
| Ixor -> "xor"
|
|
| Ilsl -> "sll"
|
|
| Ilsr -> "srl"
|
|
| Iasr -> "sra"
|
|
| Icomp cmp -> "s" ^ name_for_comparison cmp
|
|
| _ -> Misc.fatal_error "Emit.name_for_int_operation"
|
|
|
|
let name_for_float_operation = function
|
|
Inegf -> "neg.d"
|
|
| Iabsf -> "abs.d"
|
|
| Iaddf -> "add.d"
|
|
| Isubf -> "sub.d"
|
|
| Imulf -> "mul.d"
|
|
| Idivf -> "div.d"
|
|
| _ -> Misc.fatal_error "Emit.name_for_float_operation"
|
|
|
|
(* Output the assembly code for an instruction *)
|
|
|
|
(* Name of current function *)
|
|
let function_name = ref ""
|
|
(* Entry point for tail recursive calls *)
|
|
let tailrec_entry_point = ref 0
|
|
(* Label of jump to caml_call_gc *)
|
|
let call_gc_label = ref 0
|
|
(* Label of trap for out-of-range accesses *)
|
|
let range_check_trap = 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
|
|
if src.loc <> dst.loc then begin
|
|
match (src, dst) with
|
|
{loc = Reg rs; typ = Int|Addr}, {loc = Reg rd; typ = Int|Addr} ->
|
|
` move {emit_reg dst}, {emit_reg src}\n`
|
|
| {loc = Reg rs; typ = Float}, {loc = Reg rd; typ = Float} ->
|
|
` mov.d {emit_reg dst}, {emit_reg src}\n`
|
|
| {loc = Reg rs; typ = Int|Addr}, {loc = Stack sd} ->
|
|
` sw {emit_reg src}, {emit_stack dst}\n`
|
|
| {loc = Reg rs; typ = Float}, {loc = Stack sd} ->
|
|
` s.d {emit_reg src}, {emit_stack dst}\n`
|
|
| {loc = Stack ss; typ = Int|Addr}, {loc = Reg rd} ->
|
|
` lw {emit_reg dst}, {emit_stack src}\n`
|
|
| {loc = Stack ss; typ = Float}, {loc = Reg rd} ->
|
|
` l.d {emit_reg dst}, {emit_stack src}\n`
|
|
| _ ->
|
|
fatal_error "Emit_mips: Imove"
|
|
end
|
|
| Lop(Iconst_int n) ->
|
|
if n = Nativeint.zero then
|
|
` move {emit_reg i.res.(0)}, $0\n`
|
|
else
|
|
` li {emit_reg i.res.(0)}, {emit_nativeint n}\n`
|
|
| Lop(Iconst_float s) ->
|
|
` li.d {emit_reg i.res.(0)}, {emit_string s}\n`
|
|
| Lop(Iconst_symbol s) ->
|
|
` la {emit_reg i.res.(0)}, {emit_symbol s}\n`
|
|
| Lop(Icall_ind) ->
|
|
` move $25, {emit_reg i.arg.(0)}\n`;
|
|
liveregs i live_25;
|
|
` jal {emit_reg i.arg.(0)}\n`;
|
|
`{record_frame i.live}\n`
|
|
| Lop(Icall_imm s) ->
|
|
liveregs i 0;
|
|
` jal {emit_symbol s}\n`;
|
|
`{record_frame i.live}\n`
|
|
| Lop(Itailcall_ind) ->
|
|
let n = frame_size() in
|
|
if !contains_calls then
|
|
` lw $31, {emit_int(n - 4)}($sp)\n`;
|
|
if !uses_gp then
|
|
` lw $gp, {emit_int(n - 8)}($sp)\n`;
|
|
if n > 0 then
|
|
` addu $sp, $sp, {emit_int n}\n`;
|
|
liveregs i 0;
|
|
` move $25, {emit_reg i.arg.(0)}\n`;
|
|
liveregs i live_25;
|
|
` j {emit_reg i.arg.(0)}\n`
|
|
| Lop(Itailcall_imm s) ->
|
|
if s = !function_name then begin
|
|
` b {emit_label !tailrec_entry_point}\n`
|
|
end else begin
|
|
let n = frame_size() in
|
|
if !contains_calls then
|
|
` lw $31, {emit_int(n - 4)}($sp)\n`;
|
|
if !uses_gp then
|
|
` lw $gp, {emit_int(n - 8)}($sp)\n`;
|
|
if n > 0 then
|
|
` addu $sp, $sp, {emit_int n}\n`;
|
|
` la $25, {emit_symbol s}\n`;
|
|
liveregs i live_25;
|
|
` j $25\n`
|
|
end
|
|
| Lop(Iextcall(s, alloc)) ->
|
|
if alloc then begin
|
|
` la $24, {emit_symbol s}\n`;
|
|
liveregs i live_24;
|
|
` jal caml_c_call\n`;
|
|
`{record_frame i.live}\n`
|
|
end else begin
|
|
` jal {emit_symbol s}\n`
|
|
end
|
|
| Lop(Istackoffset n) ->
|
|
if n >= 0 then
|
|
` subu $sp, $sp, {emit_int n}\n`
|
|
else
|
|
` addu $sp, $sp, {emit_int (-n)}\n`;
|
|
stack_offset := !stack_offset + n
|
|
| Lop(Iload(chunk, addr)) ->
|
|
let dest = i.res.(0) in
|
|
begin match chunk with
|
|
Double_u ->
|
|
(* Destination is not 8-aligned, hence cannot use l.d *)
|
|
` ldl $24, {emit_addressing addr i.arg 0}\n`;
|
|
` ldr $24, {emit_addressing (offset_addressing addr 7) i.arg 0}\n`;
|
|
` dmtc1 $24, {emit_reg dest}\n`
|
|
| Single ->
|
|
` l.s {emit_reg dest}, {emit_addressing addr i.arg 0}\n`;
|
|
` cvt.d.s {emit_reg dest}, {emit_reg dest}\n`
|
|
| _ ->
|
|
let load_instr =
|
|
match chunk with
|
|
Byte_unsigned -> "lbu"
|
|
| Byte_signed -> "lb"
|
|
| Sixteen_unsigned -> "lhu"
|
|
| Sixteen_signed -> "lh"
|
|
| Double -> "l.d"
|
|
| _ -> "lw" in
|
|
` {emit_string load_instr} {emit_reg dest}, {emit_addressing addr i.arg 0}\n`
|
|
end
|
|
| Lop(Istore(chunk, addr)) ->
|
|
let src = i.arg.(0) in
|
|
begin match chunk with
|
|
Double_u ->
|
|
(* Destination is not 8-aligned, hence cannot use l.d *)
|
|
` dmfc1 $24, {emit_reg src}\n`;
|
|
` sdl $24, {emit_addressing addr i.arg 1}\n`;
|
|
` sdr $24, {emit_addressing (offset_addressing addr 7) i.arg 1}\n`
|
|
| Single ->
|
|
` cvt.s.d $f31, {emit_reg src}\n`;
|
|
` s.s $f31, {emit_addressing addr i.arg 1}\n`
|
|
| _ ->
|
|
let store_instr =
|
|
match chunk with
|
|
Byte_unsigned | Byte_signed -> "sb"
|
|
| Sixteen_unsigned | Sixteen_signed -> "sh"
|
|
| Double -> "s.d"
|
|
| _ -> "sw" in
|
|
` {emit_string store_instr} {emit_reg src}, {emit_addressing addr i.arg 1}\n`
|
|
end
|
|
| Lop(Ialloc n) ->
|
|
if !call_gc_label = 0 then call_gc_label := new_label();
|
|
` .set noreorder\n`;
|
|
` subu $22, $22, {emit_int n}\n`;
|
|
` subu $24, $22, $23\n`;
|
|
` bltzal $24, {emit_label !call_gc_label}\n`;
|
|
` addu {emit_reg i.res.(0)}, $22, 4\n`;
|
|
`{record_frame i.live}\n`;
|
|
` .set reorder\n`
|
|
| Lop(Iintop(Icheckbound)) ->
|
|
if !range_check_trap = 0 then range_check_trap := new_label();
|
|
` bleu {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label !range_check_trap}\n`
|
|
| Lop(Iintop op) ->
|
|
let instr = name_for_int_operation op in
|
|
` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
|
|
| Lop(Iintop_imm(Icheckbound, n)) ->
|
|
if !range_check_trap = 0 then range_check_trap := new_label();
|
|
` bleu {emit_reg i.arg.(0)}, {emit_int n}, {emit_label !range_check_trap}\n`
|
|
| Lop(Iintop_imm(op, n)) ->
|
|
let instr = name_for_int_operation op in
|
|
` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_int n}\n`
|
|
| Lop(Inegf | Iabsf as op) ->
|
|
let instr = name_for_float_operation op in
|
|
` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}\n`
|
|
| Lop(Iaddf | Isubf | Imulf | Idivf as op) ->
|
|
let instr = name_for_float_operation op in
|
|
` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`
|
|
| Lop(Ifloatofint) ->
|
|
` mtc1 {emit_reg i.arg.(0)}, {emit_reg i.res.(0)}\n`;
|
|
` cvt.d.w {emit_reg i.res.(0)}, {emit_reg i.res.(0)}\n`
|
|
| Lop(Iintoffloat) ->
|
|
` trunc.w.d $f31, {emit_reg i.arg.(0)}, $24\n`;
|
|
` mfc1 {emit_reg i.res.(0)}, $f31\n`
|
|
| Lop(Ispecific sop) ->
|
|
fatal_error "Emit_mips: Ispecific"
|
|
| Lreloadretaddr ->
|
|
let n = frame_size() in
|
|
` lw $31, {emit_int(n - 4)}($sp)\n`;
|
|
| Lreturn ->
|
|
let n = frame_size() in
|
|
if !uses_gp then
|
|
` lw $gp, {emit_int(n - 8)}($sp)\n`;
|
|
if n > 0 then
|
|
` addu $sp, $sp, {emit_int n}\n`;
|
|
liveregs i 0;
|
|
` j $31\n`
|
|
| Llabel lbl ->
|
|
`{emit_label lbl}:\n`
|
|
| Lbranch lbl ->
|
|
` b {emit_label lbl}\n`
|
|
| Lcondbranch(tst, lbl) ->
|
|
begin match tst with
|
|
Itruetest ->
|
|
` bne {emit_reg i.arg.(0)}, $0, {emit_label lbl}\n`
|
|
| Ifalsetest ->
|
|
` beq {emit_reg i.arg.(0)}, $0, {emit_label lbl}\n`
|
|
| Iinttest cmp ->
|
|
let comp = name_for_comparison cmp in
|
|
` b{emit_string comp} {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_label lbl}\n`
|
|
| Iinttest_imm(cmp, n) ->
|
|
let comp = name_for_comparison cmp in
|
|
` b{emit_string comp} {emit_reg i.arg.(0)}, {emit_int n}, {emit_label lbl}\n`
|
|
| Ifloattest(cmp, neg) ->
|
|
let (comp, branch) = name_for_float_comparison cmp neg in
|
|
` c.{emit_string comp}.d {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
|
|
if branch
|
|
then ` bc1f {emit_label lbl}\n`
|
|
else ` bc1t {emit_label lbl}\n`
|
|
| Ioddtest ->
|
|
` and $24, {emit_reg i.arg.(0)}, 1\n`;
|
|
` bne $24, $0, {emit_label lbl}\n`
|
|
| Ieventest ->
|
|
` and $24, {emit_reg i.arg.(0)}, 1\n`;
|
|
` beq $24, $0, {emit_label lbl}\n`
|
|
end
|
|
| Lcondbranch3(lbl0, lbl1, lbl2) ->
|
|
` subu $24, {emit_reg i.arg.(0)}, 1\n`;
|
|
begin match lbl0 with
|
|
None -> ()
|
|
| Some lbl -> ` beq {emit_reg i.arg.(0)}, $0, {emit_label lbl}\n`
|
|
end;
|
|
begin match lbl1 with
|
|
None -> ()
|
|
| Some lbl -> ` beq $24, $0, {emit_label lbl}\n`
|
|
end;
|
|
begin match lbl2 with
|
|
None -> ()
|
|
| Some lbl -> ` bgtz $24, {emit_label lbl}\n`
|
|
end
|
|
| Lswitch jumptbl ->
|
|
let lbl_jumptbl = new_label() in
|
|
` sll $24, {emit_reg i.arg.(0)}, 2\n`;
|
|
` lw $24, {emit_label lbl_jumptbl}($24)\n`;
|
|
liveregs i live_24;
|
|
` j $24\n`;
|
|
` .rdata\n`;
|
|
`{emit_label lbl_jumptbl}:\n`;
|
|
for i = 0 to Array.length jumptbl - 1 do
|
|
` .word {emit_label jumptbl.(i)}\n`
|
|
done;
|
|
` .text\n`
|
|
| Lsetuptrap lbl ->
|
|
` subu $sp, $sp, 16\n`;
|
|
` bal {emit_label lbl}\n`
|
|
| Lpushtrap ->
|
|
stack_offset := !stack_offset + 16;
|
|
` sw $30, 0($sp)\n`;
|
|
` sw $31, 4($sp)\n`;
|
|
` sw $gp, 8($sp)\n`;
|
|
` move $30, $sp\n`
|
|
| Lpoptrap ->
|
|
` lw $30, 0($sp)\n`;
|
|
` addu $sp, $sp, 16\n`;
|
|
stack_offset := !stack_offset - 16
|
|
| Lraise ->
|
|
` lw $25, 4($30)\n`;
|
|
` move $sp, $30\n`;
|
|
` lw $30, 0($sp)\n`;
|
|
` lw $gp, 8($sp)\n`;
|
|
` addu $sp, $sp, 16\n`;
|
|
liveregs i live_25;
|
|
` jal $25\n` (* Keep retaddr in $31 for debugging *)
|
|
|
|
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;
|
|
uses_gp := instr_uses_gp fundecl.fun_body;
|
|
if !uses_gp then contains_calls := true;
|
|
tailrec_entry_point := new_label();
|
|
stack_offset := 0;
|
|
call_gc_label := 0;
|
|
range_check_trap := 0;
|
|
` .text\n`;
|
|
` .align 2\n`;
|
|
` .globl {emit_symbol fundecl.fun_name}\n`;
|
|
` .ent {emit_symbol fundecl.fun_name}\n`;
|
|
`{emit_symbol fundecl.fun_name}:\n`;
|
|
let n = frame_size() in
|
|
if n > 0 then
|
|
` subu $sp, $sp, {emit_int n}\n`;
|
|
if !contains_calls then
|
|
` sw $31, {emit_int(n - 4)}($sp)\n`;
|
|
if !uses_gp then begin
|
|
` sw $gp, {emit_int(n - 8)}($sp)\n`;
|
|
` lui $24, %hi(%neg(%gp_rel({emit_symbol fundecl.fun_name})))\n`;
|
|
` addiu $24, $24, %lo(%neg(%gp_rel({emit_symbol fundecl.fun_name})))\n`;
|
|
` daddu $gp, $25, $24\n`
|
|
end;
|
|
`{emit_label !tailrec_entry_point}:\n`;
|
|
emit_all fundecl.fun_body;
|
|
if !call_gc_label > 0 then begin
|
|
`{emit_label !call_gc_label}:\n`;
|
|
` la $25, caml_call_gc\n`;
|
|
` j $25\n`
|
|
end;
|
|
if !range_check_trap > 0 then begin
|
|
`{emit_label !range_check_trap}:\n`;
|
|
` la $25, caml_array_bound_error\n`;
|
|
` j $25\n`
|
|
end;
|
|
` .end {emit_symbol fundecl.fun_name}\n`
|
|
|
|
(* Emission of data *)
|
|
|
|
let emit_item = function
|
|
Cdefine_symbol s ->
|
|
` .globl {emit_symbol s}\n`;
|
|
`{emit_symbol s}:\n`
|
|
| Cdefine_label lbl ->
|
|
`{emit_label (100000 + lbl)}:\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 ->
|
|
` .float {emit_string f}\n`
|
|
| Cdouble f ->
|
|
` .align 0\n`; (* Prevent alignment on 8-byte boundary *)
|
|
` .double {emit_string f}\n`
|
|
| Csymbol_address s ->
|
|
` .word {emit_symbol s}\n`
|
|
| Clabel_address lbl ->
|
|
` .word {emit_label (100000 + lbl)}\n`
|
|
| Cstring s ->
|
|
emit_string_directive " .ascii " s
|
|
| Cskip n ->
|
|
if n > 0 then ` .space {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() =
|
|
(* There are really two groups of registers:
|
|
$sp and $30 always point to stack locations
|
|
$2 - $21 never point to stack locations. *)
|
|
` .noalias $2,$sp; .noalias $2,$30; .noalias $3,$sp; .noalias $3,$30\n`;
|
|
` .noalias $4,$sp; .noalias $4,$30; .noalias $5,$sp; .noalias $5,$30\n`;
|
|
` .noalias $6,$sp; .noalias $6,$30; .noalias $7,$sp; .noalias $7,$30\n`;
|
|
` .noalias $8,$sp; .noalias $8,$30; .noalias $9,$sp; .noalias $9,$30\n`;
|
|
` .noalias $10,$sp; .noalias $10,$30; .noalias $11,$sp; .noalias $11,$30\n`;
|
|
` .noalias $12,$sp; .noalias $12,$30; .noalias $13,$sp; .noalias $13,$30\n`;
|
|
` .noalias $14,$sp; .noalias $14,$30; .noalias $15,$sp; .noalias $15,$30\n`;
|
|
` .noalias $16,$sp; .noalias $16,$30; .noalias $17,$sp; .noalias $17,$30\n`;
|
|
` .noalias $18,$sp; .noalias $18,$30; .noalias $19,$sp; .noalias $19,$30\n`;
|
|
` .noalias $20,$sp; .noalias $20,$30; .noalias $21,$sp; .noalias $21,$30\n\n`;
|
|
let lbl_begin = Compilenv.current_unit_name() ^ "__data_begin" in
|
|
` .data\n`;
|
|
` .globl {emit_symbol lbl_begin}\n`;
|
|
`{emit_symbol lbl_begin}:\n`;
|
|
let lbl_begin = Compilenv.current_unit_name() ^ "__code_begin" in
|
|
` .text\n`;
|
|
` .globl {emit_symbol lbl_begin}\n`;
|
|
` .ent {emit_symbol lbl_begin}\n`;
|
|
`{emit_symbol lbl_begin}:\n`;
|
|
` .end {emit_symbol lbl_begin}\n`
|
|
|
|
let end_assembly () =
|
|
let lbl_end = Compilenv.current_unit_name() ^ "__code_end" in
|
|
` .text\n`;
|
|
` .globl {emit_symbol lbl_end}\n`;
|
|
` .ent {emit_symbol lbl_end}\n`;
|
|
`{emit_symbol lbl_end}:\n`;
|
|
` .end {emit_symbol lbl_end}\n`;
|
|
let lbl_end = Compilenv.current_unit_name() ^ "__data_end" in
|
|
` .data\n`;
|
|
` .globl {emit_symbol lbl_end}\n`;
|
|
`{emit_symbol lbl_end}:\n`;
|
|
` .word 0\n`;
|
|
let lbl = Compilenv.current_unit_name() ^ "__frametable" in
|
|
` .rdata\n`;
|
|
` .globl {emit_symbol lbl}\n`;
|
|
`{emit_symbol lbl}:\n`;
|
|
` .word {emit_int (List.length !frame_descriptors)}\n`;
|
|
List.iter emit_frame !frame_descriptors;
|
|
frame_descriptors := []
|