Ekdohibs
/
ocaml
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Adapt 32-bit emit.mlp to curried style. 

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/abstract_intel_emit@15614 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Alain Frisch 2014-11-27 17:29:49 +00:00
parent 22cb7ff170
commit 27a2bd3e16
1 changed files with 79 additions and 79 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

158
asmcomp/i386/emit.mlp
View File

@ -267,7 +267,7 @@ let emit_call_bound_errors () =
let instr_for_intop = function
| Iadd -> I.add
| Isub -> I.sub
| Imul -> (fun (arg1,arg2) -> I.imul (arg1, Some arg2))
| Imul -> (fun arg1 arg2 -> I.imul arg1 (Some arg2))
| Iand -> I.and_
| Ior -> I.or_
| Ixor -> I.xor
@ -329,8 +329,8 @@ let cond = function
let output_test_zero arg =
match arg.loc with
| Reg.Reg _ -> I.test (reg arg, reg arg)
| _ -> I.cmp (int 0, reg arg)
| Reg.Reg _ -> I.test (reg arg) (reg arg)
| _ -> I.cmp (int 0) (reg arg)
(* Deallocate the stack frame before a return or tail call *)
@ -338,7 +338,7 @@ let output_epilogue f =
let n = frame_size() - 4 in
if n > 0 then
begin
I.add (int n, esp);
I.add (int n) esp;
cfi_adjust_cfa_offset (-n);
f ();
(* reset CFA back cause function body may continue *)
@ -377,44 +377,44 @@ let emit_float_test cmp neg arg lbl =
match actual_cmp with
| Ceq ->
if neg then begin
I.and_ (int 68, ah);
I.xor (int 64, ah);
I.and_ (int 68) ah;
I.xor (int 64) ah;
I.jne lbl
end else begin
I.and_ (int 69, ah);
I.cmp (int 64, ah);
I.and_ (int 69) ah;
I.cmp (int 64) ah;
I.je lbl
end
| Cne ->
if neg then begin
I.and_ (int 69, ah);
I.cmp (int 64, ah);
I.and_ (int 69) ah;
I.cmp (int 64) ah;
I.je lbl
end else begin
I.and_ (int 68, ah);
I.xor (int 64, ah);
I.and_ (int 68) ah;
I.xor (int 64) ah;
I.jne lbl
end
| Cle ->
I.and_ (int 69, ah);
I.and_ (int 69) ah;
I.dec ah;
I.cmp (int 64, ah);
I.cmp (int 64) ah;
if neg
then I.jae lbl
else I.jb lbl
| Cge ->
I.and_ (int 5, ah);
I.and_ (int 5) ah;
if neg
then I.jne lbl
else I.je lbl
| Clt ->
I.and_ (int 69, ah);
I.cmp (int 1, ah);
I.and_ (int 69) ah;
I.cmp (int 1) ah;
if neg
then I.jne lbl
else I.je lbl
| Cgt ->
I.and_ (int 69, ah);
I.and_ (int 69) ah;
if neg
then I.jne lbl
else I.je lbl
@ -486,19 +486,19 @@ let emit_instr fallthrough i =
else if is_tos dst then
I.fld (reg src)
else begin
I.fld (reg src);
I.fld (reg src);
I.fstp (reg dst)
end
else
I.mov (reg src, reg dst)
I.mov (reg src) (reg dst)
end
| Lop(Iconst_int n | Iconst_blockheader n) ->
if n = 0n then begin
match i.res.(0).loc with
| Reg _ -> I.xor (reg i.res.(0), reg i.res.(0))
| _ -> I.mov (int 0, reg i.res.(0))
| Reg _ -> I.xor (reg i.res.(0)) (reg i.res.(0))
| _ -> I.mov (int 0) (reg i.res.(0))
end else
I.mov (nat n, reg i.res.(0))
I.mov (nat n) (reg i.res.(0))
| Lop(Iconst_float f) ->
begin match Int64.bits_of_float f with
| 0x0000_0000_0000_0000L -> (* +0.0 *)
@ -515,7 +515,7 @@ let emit_instr fallthrough i =
end
| Lop(Iconst_symbol s) ->
add_used_symbol s;
I.mov (immsym s, reg i.res.(0))
I.mov (immsym s) (reg i.res.(0))
| Lop(Icall_ind) ->
I.call (reg i.arg.(0));
record_frame i.live i.dbg
@ -540,12 +540,12 @@ let emit_instr fallthrough i =
add_used_symbol s;
if alloc then begin
if system <> S_macosx then
I.mov (immsym s, eax)
I.mov (immsym s) eax
else begin
external_symbols_indirect :=
StringSet.add s !external_symbols_indirect;
I.mov (mem_sym DWORD (Printf.sprintf "L%s$non_lazy_ptr"
(emit_symbol s)), eax)
(emit_symbol s))) eax
end;
emit_call "caml_c_call";
record_frame i.live i.dbg
@ -560,23 +560,23 @@ let emit_instr fallthrough i =
end
| Lop(Istackoffset n) ->
if n < 0
then I.add (int (-n), esp)
else I.sub (int n, esp);
then I.add (int (-n)) esp
else I.sub (int n) esp;
cfi_adjust_cfa_offset n;
stack_offset := !stack_offset + n
| Lop(Iload(chunk, addr)) ->
let dest = i.res.(0) in
begin match chunk with
| Word | Thirtytwo_signed | Thirtytwo_unsigned ->
I.mov (addressing addr DWORD i 0, reg dest)
I.mov (addressing addr DWORD i 0) (reg dest)
| Byte_unsigned ->
I.movzx (addressing addr BYTE i 0, reg dest)
I.movzx (addressing addr BYTE i 0) (reg dest)
| Byte_signed ->
I.movsx (addressing addr BYTE i 0, reg dest)
I.movsx (addressing addr BYTE i 0) (reg dest)
| Sixteen_unsigned ->
I.movzx (addressing addr WORD i 0, reg dest)
I.movzx (addressing addr WORD i 0) (reg dest)
| Sixteen_signed ->
I.movsx (addressing addr WORD i 0, reg dest)
I.movsx (addressing addr WORD i 0) (reg dest)
| Single ->
I.fld (addressing addr REAL4 i 0)
| Double | Double_u ->
@ -585,11 +585,11 @@ let emit_instr fallthrough i =
| Lop(Istore(chunk, addr, _)) ->
begin match chunk with
| Word | Thirtytwo_signed | Thirtytwo_unsigned ->
I.mov (reg i.arg.(0), addressing addr DWORD i 1)
I.mov (reg i.arg.(0)) (addressing addr DWORD i 1)
| Byte_unsigned | Byte_signed ->
I.mov (reg8 i.arg.(0), addressing addr BYTE i 1)
I.mov (reg8 i.arg.(0)) (addressing addr BYTE i 1)
| Sixteen_unsigned | Sixteen_signed ->
I.mov (reg16 i.arg.(0), addressing addr WORD i 1)
I.mov (reg16 i.arg.(0)) (addressing addr WORD i 1)
| Single ->
if is_tos i.arg.(0) then
I.fstp (addressing addr REAL4 i 1)
@ -609,14 +609,14 @@ let emit_instr fallthrough i =
if !fastcode_flag then begin
let lbl_redo = new_label() in
def_label lbl_redo;
I.mov (sym32 "caml_young_ptr", eax);
I.sub (int n, eax);
I.mov (eax, sym32 "caml_young_ptr");
I.cmp (sym32 "caml_young_limit", eax);
I.mov (sym32 "caml_young_ptr") eax;
I.sub (int n) eax;
I.mov eax (sym32 "caml_young_ptr");
I.cmp (sym32 "caml_young_limit") eax;
let lbl_call_gc = new_label() in
let lbl_frame = record_frame_label i.live Debuginfo.none in
I.jb (label lbl_call_gc);
I.lea (mem32 NONE 4 RAX, reg i.res.(0));
I.lea (mem32 NONE 4 RAX) (reg i.res.(0));
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_redo;
@ -627,48 +627,48 @@ let emit_instr fallthrough i =
| 12 -> emit_call "caml_alloc2"
| 16 -> emit_call "caml_alloc3"
| _ ->
I.mov (int n, eax);
I.mov (int n) eax;
emit_call "caml_allocN"
end;
record_frame i.live Debuginfo.none;
I.lea (mem32 NONE 4 RAX, reg i.res.(0))
I.lea (mem32 NONE 4 RAX) (reg i.res.(0))
end
| Lop(Iintop(Icomp cmp)) ->
I.cmp (reg i.arg.(1), reg i.arg.(0));
I.cmp (reg i.arg.(1)) (reg i.arg.(0));
I.set (cond cmp) al;
I.movzx (al, reg i.res.(0));
I.movzx al (reg i.res.(0));
| Lop(Iintop_imm(Icomp cmp, n)) ->
I.cmp (int n, reg i.arg.(0));
I.cmp (int n) (reg i.arg.(0));
I.set (cond cmp) al;
I.movzx (al, reg i.res.(0))
I.movzx al (reg i.res.(0))
| Lop(Iintop Icheckbound) ->
let lbl = bound_error_label i.dbg in
I.cmp (reg i.arg.(1), reg i.arg.(0));
I.cmp (reg i.arg.(1)) (reg i.arg.(0));
I.jbe (label lbl)
| Lop(Iintop_imm(Icheckbound, n)) ->
let lbl = bound_error_label i.dbg in
I.cmp (int n, reg i.arg.(0));
I.cmp (int n) (reg i.arg.(0));
I.jbe (label lbl)
| Lop(Iintop(Idiv | Imod)) ->
I.cdq ();
I.idiv (reg i.arg.(1))
| Lop(Iintop(Ilsl | Ilsr | Iasr as op)) ->
(* We have i.arg.(0) = i.res.(0) and i.arg.(1) = %ecx *)
instr_for_intop op (cl, reg i.res.(0))
instr_for_intop op cl (reg i.res.(0))
| Lop(Iintop Imulh) ->
I.imul (reg i.arg.(1), None)
I.imul (reg i.arg.(1)) None
| Lop(Iintop op) ->
(* We have i.arg.(0) = i.res.(0) *)
instr_for_intop op (reg i.arg.(1), reg i.res.(0))
instr_for_intop op (reg i.arg.(1)) (reg i.res.(0))
| Lop(Iintop_imm(Iadd, n)) when i.arg.(0).loc <> i.res.(0).loc ->
I.lea (mem32 NONE n (reg32 i.arg.(0)), reg i.res.(0))
I.lea (mem32 NONE n (reg32 i.arg.(0))) (reg i.res.(0))
| Lop(Iintop_imm(Iadd, 1) | Iintop_imm(Isub, -1)) ->
I.inc (reg i.res.(0))
| Lop(Iintop_imm(Iadd, -1) | Iintop_imm(Isub, 1)) ->
I.dec (reg i.res.(0))
| Lop(Iintop_imm(op, n)) ->
(* We have i.arg.(0) = i.res.(0) *)
instr_for_intop op (int n, reg i.res.(0))
instr_for_intop op (int n) (reg i.res.(0))
| Lop(Inegf | Iabsf as floatop) ->
if not (is_tos i.arg.(0)) then
I.fld (reg i.arg.(0));
@ -678,7 +678,7 @@ let emit_instr fallthrough i =
begin match (is_tos i.arg.(0), is_tos i.arg.(1)) with
(true, true) ->
(* both operands on top of FP stack *)
instr_for_floatop_reversed_pop floatop (st0, st1)
instr_for_floatop_reversed_pop floatop st0 st1
| (true, false) ->
(* first operand on stack *)
instr_for_floatop floatop (reg i.arg.(1))
@ -697,46 +697,46 @@ let emit_instr fallthrough i =
| _ ->
I.push (reg i.arg.(0));
I.fild (mem32 DWORD 0 RSP);
I.add (int 4, esp)
I.add (int 4) esp
end
| Lop(Iintoffloat) ->
if not (is_tos i.arg.(0)) then
I.fld (reg i.arg.(0));
stack_offset := !stack_offset - 8;
I.sub (int 8, esp);
I.sub (int 8) esp;
cfi_adjust_cfa_offset 8;
I.fnstcw (mem32 NONE 4 RSP);
I.mov (mem32 WORD 4 RSP, ax);
I.mov (int 12, ah);
I.mov (ax, mem32 WORD 0 RSP);
I.mov (mem32 WORD 4 RSP) ax;
I.mov (int 12) ah;
I.mov ax (mem32 WORD 0 RSP);
I.fldcw (mem32 NONE 0 RSP);
begin match i.res.(0).loc with
| Stack _ ->
I.fistp (reg i.res.(0))
| _ ->
I.fistp (mem32 DWORD 0 RSP);
I.mov (mem32 DWORD 0 RSP, reg i.res.(0))
I.mov (mem32 DWORD 0 RSP) (reg i.res.(0))
end;
I.fldcw (mem32 NONE 4 RSP);
I.add (int 8, esp);
I.add (int 8) esp;
cfi_adjust_cfa_offset (-8);
stack_offset := !stack_offset + 8
| Lop(Ispecific(Ilea addr)) ->
I.lea (addressing addr DWORD i 0, reg i.res.(0))
I.lea (addressing addr DWORD i 0) (reg i.res.(0))
| Lop(Ispecific(Istore_int(n, addr, _))) ->
I.mov (nat n, addressing addr DWORD i 0)
I.mov (nat n) (addressing addr DWORD i 0)
| Lop(Ispecific(Istore_symbol(s, addr, _))) ->
add_used_symbol s;
I.mov (immsym s, addressing addr DWORD i 0)
I.mov (immsym s) (addressing addr DWORD i 0)
| Lop(Ispecific(Ioffset_loc(n, addr))) ->
I.add (int n, addressing addr DWORD i 0)
I.add (int n) (addressing addr DWORD i 0)
| Lop(Ispecific(Ipush)) ->
(* Push arguments in reverse order *)
for n = Array.length i.arg - 1 downto 0 do
let r = i.arg.(n) in
match r with
{loc = Reg _; typ = Float} ->
I.sub (int 8, esp);
I.sub (int 8) esp;
cfi_adjust_cfa_offset 8;
I.fstp (mem32 REAL8 0 RSP);
stack_offset := !stack_offset + 8
@ -804,26 +804,26 @@ let emit_instr fallthrough i =
output_test_zero i.arg.(0);
I.je lbl
| Iinttest cmp ->
I.cmp (reg i.arg.(1), reg i.arg.(0));
I.cmp (reg i.arg.(1)) (reg i.arg.(0));
I.j (cond cmp) lbl
| Iinttest_imm((Isigned Ceq | Isigned Cne |
Iunsigned Ceq | Iunsigned Cne) as cmp, 0) ->
output_test_zero i.arg.(0);
I.j (cond cmp) lbl
| Iinttest_imm(cmp, n) ->
I.cmp (int n, reg i.arg.(0));
I.cmp (int n) (reg i.arg.(0));
I.j (cond cmp) lbl
| Ifloattest(cmp, neg) ->
emit_float_test cmp neg i.arg lbl
| Ioddtest ->
I.test (int 1, reg i.arg.(0));
I.test (int 1) (reg i.arg.(0));
I.jne lbl
| Ieventest ->
I.test (int 1, reg i.arg.(0));
I.test (int 1) (reg i.arg.(0));
I.je lbl
end
| Lcondbranch3(lbl0, lbl1, lbl2) ->
I.cmp (int 1, reg i.arg.(0));
I.cmp (int 1) (reg i.arg.(0));
begin match lbl0 with
None -> ()
| Some lbl -> I.jb (label lbl)
@ -849,14 +849,14 @@ let emit_instr fallthrough i =
I.call (label lbl)
| Lpushtrap ->
if trap_frame_size > 8 then
I.sub (int (trap_frame_size - 8), esp);
I.sub (int (trap_frame_size - 8)) esp;
I.push (sym32 "caml_exception_pointer");
cfi_adjust_cfa_offset trap_frame_size;
I.mov (esp, sym32 "caml_exception_pointer");
I.mov esp (sym32 "caml_exception_pointer");
stack_offset := !stack_offset + trap_frame_size
| Lpoptrap ->
I.pop (sym32 "caml_exception_pointer");
I.add (int (trap_frame_size - 4), esp);
I.add (int (trap_frame_size - 4)) esp;
cfi_adjust_cfa_offset (-trap_frame_size);
stack_offset := !stack_offset - trap_frame_size
| Lraise k ->
@ -869,10 +869,10 @@ let emit_instr fallthrough i =
record_frame Reg.Set.empty i.dbg
| false, _
| true, Lambda.Raise_notrace ->
I.mov (sym32 "caml_exception_pointer", esp);
I.mov (sym32 "caml_exception_pointer") esp;
I.pop (sym32 "caml_exception_pointer");
if trap_frame_size > 8 then
I.add (int (trap_frame_size - 8), esp);
I.add (int (trap_frame_size - 8)) esp;
I.ret ()
end
@ -915,7 +915,7 @@ let emit_external_symbols () =
let call_mcount mcount =
I.push eax;
I.mov (esp, ebp);
I.mov esp ebp;
I.push ecx;
I.push edx;
I.call (sym mcount);
@ -956,7 +956,7 @@ let fundecl fundecl =
if !Clflags.gprofile then emit_profile();
let n = frame_size() - 4 in
if n > 0 then begin
I.sub (int n, esp);
I.sub (int n) esp;
cfi_adjust_cfa_offset n;
end;
def_label !tailrec_entry_point;