ocaml/asmcomp/emit_mips.mlp

538 lines
18 KiB
Plaintext

(***********************************************************************)
(* *)
(* Caml Special Light *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1995 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $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 pseudo-register *)
let emit_reg r =
match r.loc with
Reg r -> emit_string (register_name r)
| _ -> fatal_error "Emit_mips.emit_reg"
(* Output the other half of a floating-point pseudo-register *)
let float_reg_twin_name = [|
(* 100-104 *) "$f1"; "$f3"; "$f5"; "$f7"; "$f9";
(* 105-108 *) "$f13"; "$f15"; "$f17"; "$f19";
(* 109-114 *) "$f21"; "$f23"; "$f25"; "$f27"; "$f29"; "$f31"
|]
let emit_twin_reg = function
{ loc = Reg r; typ = Float } -> emit_string (float_reg_twin_name.(r - 100))
| _ -> fatal_error "Emit_mips.emit_twin_reg"
(* 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 4 else 0) in
Misc.align size 8
let slot_offset loc class =
match loc with
Incoming n -> frame_size() + n
| Local n ->
if class = 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} + {emit_int ofs}`
(* Communicate live registers at call points to the assembler *)
(* Not supported by older versions of 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; 2; 4; 6; 8; 12; 14; 16; 18; 20; 22; 24; 26; 28; 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 (3 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_24 = 1 lsl (31 - 24)
let live_25 = 1 lsl (31 - 25)
(* 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 - int_reg_number.(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`
(* 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 = function
Ceq -> "eq", "t" | Cne -> "eq", "f"
| Cle -> "le", "t" | Cge -> "lt", "f"
| Clt -> "lt", "t" | Cgt -> "le", "f"
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
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 = Float}, {loc = Reg rd; typ = Int|Addr} ->
` mfc1.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 0) ->
` move {emit_reg i.res.(0)}, $0\n`
| Lop(Iconst_int n) ->
` li {emit_reg i.res.(0)}, {emit_int 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) ->
liveregs i 0;
`{record_frame i.live} jal {emit_reg i.arg.(0)}\n`
| Lop(Icall_imm s) ->
liveregs i 0;
`{record_frame i.live} jal {emit_symbol s}\n`
| Lop(Itailcall_ind) ->
let n = frame_size() in
if !contains_calls then
` lw $31, {emit_int(n - 4)}($sp)\n`;
if n > 0 then
` addu $sp, $sp, {emit_int n}\n`;
liveregs i 0;
` 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 n > 0 then
` addu $sp, $sp, {emit_int n}\n`;
liveregs i 0;
` j {emit_symbol s}\n`
end
| Lop(Iextcall(s, alloc)) ->
if alloc then begin
` la $25, {emit_symbol s}\n`;
liveregs i live_25;
`{record_frame i.live} jal caml_c_call\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)) ->
begin match i.res.(0).typ with
Int | Addr ->
let load_instr =
match chunk with
Word -> "lw"
| Byte_unsigned -> "lbu"
| Byte_signed -> "lb"
| Sixteen_unsigned -> "lhu"
| Sixteen_signed -> "lh" in
` {emit_string load_instr} {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`
| Float ->
(* Destination is not necessarily 8-aligned, hence better not use l.d *)
` lwc1 {emit_reg i.res.(0)}, {emit_addressing addr i.arg 0}\n`;
` lwc1 {emit_twin_reg i.res.(0)}, {emit_addressing (offset_addressing addr 4) i.arg 0}\n`
end
| Lop(Istore(chunk, addr)) ->
begin match i.arg.(0).typ with
Int | Addr ->
let store_instr =
match chunk with
Word -> "sw"
| Byte_unsigned | Byte_signed -> "sb"
| Sixteen_unsigned | Sixteen_signed -> "sh" in
` {emit_string store_instr} {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n`
| Float ->
(* Destination is not necessarily 8-aligned, hence better not use s.d *)
` swc1 {emit_reg i.arg.(0)}, {emit_addressing addr i.arg 1}\n`;
` swc1 {emit_twin_reg i.arg.(0)}, {emit_addressing (offset_addressing addr 4) i.arg 1}\n`
end
| Lop(Ialloc n) ->
if !fastcode_flag then begin
if !call_gc_label = 0 then call_gc_label := new_label();
` subu $22, $22, {emit_int n}\n`;
` subu $25, $22, $23\n`;
` .set noreorder\n`;
`{record_frame i.live} bltzal $25, {emit_label !call_gc_label}\n`;
` li $25, {emit_int n}\n`;
` .set reorder\n`;
` addu {emit_reg i.res.(0)}, $22, 4\n`
end else begin
begin match n with
8 -> liveregs i 0;
`{record_frame i.live} jal caml_alloc1\n`
| 12 -> liveregs i 0;
`{record_frame i.live} jal caml_alloc2\n`
| 16 -> liveregs i 0;
`{record_frame i.live} jal caml_alloc3\n`
| _ -> ` li $25, {emit_int n}\n`;
liveregs i live_25;
`{record_frame i.live} jal caml_alloc\n`
end;
` addu {emit_reg i.res.(0)}, $22, 4\n`
end
| 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(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 $f10, {emit_reg i.arg.(0)}, $25\n`;
` mfc1 {emit_reg i.res.(0)}, $f10\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 n > 0 then
` addu $sp, $sp, {emit_int n}\n`;
(* Must and the return address even if this is a leaf routine,
because it may have been tail-called with a marked retaddr. *)
` and $31, $31, -2\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 ->
let (comp, test) = name_for_float_comparison cmp in
` c.{emit_string comp}.d {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`;
` bc1{emit_string test} {emit_label lbl}\n`
| Ioddtest ->
` and $25, {emit_reg i.arg.(0)}, 1\n`;
` bne $25, $0, {emit_label lbl}\n`
| Ieventest ->
` and $25, {emit_reg i.arg.(0)}, 1\n`;
` beq $25, $0, {emit_label lbl}\n`
end
| Lcondbranch3(lbl0, lbl1, lbl2) ->
` subu $25, {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 $25, $0, {emit_label lbl}\n`
end;
begin match lbl2 with
None -> ()
| Some lbl -> ` bgtz $25, {emit_label lbl}\n`
end
| Lswitch jumptbl ->
let lbl_jumptbl = new_label() in
` sll $25, {emit_reg i.arg.(0)}, 2\n`;
` lw $25, {emit_label lbl_jumptbl}($25)\n`;
liveregs i live_25;
` j $25\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, 8\n`;
` bal {emit_label lbl}\n`
| Lpushtrap ->
stack_offset := !stack_offset + 8;
` sw $30, 0($sp)\n`;
` sw $31, 4($sp)\n`;
` move $30, $sp\n`
| Lpoptrap ->
` lw $30, 0($sp)\n`;
` addu $sp, $sp, 8\n`;
stack_offset := !stack_offset - 8
| Lraise ->
` move $sp, $30\n`;
` lw $25, 4($sp)\n`;
` lw $30, 0($sp)\n`;
` addu $sp, $sp, 8\n`;
liveregs i 0;
` j $25\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;
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`;
`{emit_label !tailrec_entry_point}:\n`;
emit_all fundecl.fun_body;
if !call_gc_label > 0 then
`{emit_label !call_gc_label}: j caml_call_gc\n`;
if !range_check_trap > 0 then
`{emit_label !range_check_trap}: break BRK_RANGE\n`;
` .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 (10000 + lbl)}:\n`
| Cint8 n ->
` .byte {emit_int n}\n`
| Cint16 n ->
` .half {emit_int n}\n`
| Cint n ->
` .word {emit_int n}\n`
| Cfloat 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 (10000 + lbl)}\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 ` .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() =
`#include <sys/signal.h>\n\n`;
(* 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 end_assembly () =
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 := []