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

Push des arguments d'un appel externe 

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@820 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
master
Xavier Leroy 1996-05-16 14:17:59 +00:00
parent 77d13ee8d2
commit 33029f6ed5
9 changed files with 99 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
asmcomp/emit_alpha.mlp
View File

@ -159,14 +159,13 @@ let emit_frame fd =
type gc_call =
{ gc_lbl: label; (* Entry label *)
gc_return_lbl: label; (* Where to branch after GC *)
gc_desired_size: int; (* Required block size *)
gc_frame: label; (* Label of frame descriptor *)
gc_instr: instruction } (* Record live registers *)
let call_gc_sites = ref ([] : gc_call list)
let emit_call_gc gc =
`{emit_label gc.gc_lbl}: ldiq $25, {emit_int gc.gc_desired_size}\n`;
`{emit_label gc.gc_lbl}:`;
liveregs gc.gc_instr 0;
`{emit_label gc.gc_frame}: bsr caml_call_gc\n`;
` br {emit_label gc.gc_return_lbl}\n`

2
asmcomp/emit_i386.mlp
View File

@ -40,7 +40,7 @@ let slot_offset loc cl =
if cl = 0
then !stack_offset + n * 4
else !stack_offset + num_stack_slots.(0) * 4 + n * 8
| Outgoing n -> fatal_error "Emit_i386: Outgoing"
| Outgoing n -> n
(* Symbols are prefixed with _, except under Linux with ELF binaries *)

71
asmcomp/emit_i386nt.mlp
View File

@ -199,6 +199,19 @@ let emit_frame fd =
fd.fd_live_offset;
emit_align 4
(* Record calls to the GC -- we've moved them out of the way *)
type gc_call =
{ gc_lbl: label; (* Entry label *)
gc_return_lbl: label; (* Where to branch after GC *)
gc_frame: label } (* Label of frame descriptor *)
let call_gc_sites = ref ([] : gc_call list)
let emit_call_gc gc =
`{emit_label gc.gc_lbl}: call _caml_call_gc\n`;
`{emit_label gc.gc_frame}: jmp {emit_label gc.gc_return_lbl}\n`
(* Names for instructions *)
let instr_for_intop = function
@ -408,15 +421,19 @@ let emit_instr i =
end
| Lop(Ialloc n) ->
if !fastcode_flag then begin
` mov eax, _young_ptr\n`;
let lbl_redo = new_label() in
`{emit_label lbl_redo}: mov eax, _young_ptr\n`;
` sub eax, {emit_int n}\n`;
` mov _young_ptr, eax\n`;
` cmp eax, _young_limit\n`;
let lbl_cont = record_frame_label i.live in
` jae {emit_label lbl_cont}\n`;
` call _caml_call_gc\n`;
` WORD {emit_int n}\n`;
`{emit_label lbl_cont}: lea {emit_reg i.res.(0)}, [eax+4]\n`
let lbl_call_gc = new_label() in
let lbl_frame = record_frame_label i.live in
` jb {emit_label lbl_call_gc}\n`;
` lea {emit_reg i.res.(0)}, [eax+4]\n`;
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
gc_return_lbl = lbl_redo;
gc_frame = lbl_frame } :: !call_gc_sites
end else begin
begin match n with
8 -> ` call _caml_alloc1\n`
@ -540,6 +557,46 @@ let emit_instr i =
` mov DWORD PTR {emit_addressing addr i.arg 0},OFFSET {emit_symbol s}\n`
| Lop(Ispecific(Ioffset_loc(n, addr))) ->
` add DWORD PTR {emit_addressing addr i.arg 0},{emit_int n}\n`
| 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 rn; typ = Float} ->
` sub esp, 8\n`;
stack_offset := !stack_offset + 8;
begin match rn with
100 ->
` fstp REAL8 PTR 0[esp]\n`;
pop_fp()
| 101 when !fp_offset = 0 ->
` fst REAL8 PTR 0[esp]\n`
| _ ->
` fld {emit_reg r}\n`;
` fstp REAL8 PTR 0[esp]\n`
end
| {loc = Stack sl; typ = Float} ->
let ofs = slot_offset sl 1 in
` push DWORD PTR {emit_int (ofs + 4)}[esp]\n`;
` push DWORD PTR {emit_int (ofs + 4)}[esp]\n`;
stack_offset := !stack_offset + 8
| _ ->
` push {emit_reg r}\n`;
stack_offset := !stack_offset + 4
done
| Lop(Ispecific(Ipush_int n)) ->
` push {emit_int n}\n`;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_symbol s)) ->
` push {emit_symbol s}\n`;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ipush_load(ty, addr))) ->
if ty = Float then begin
` push DWORD PTR {emit_addressing (offset_addressing addr 4) i.arg 0}\n`;
stack_offset := !stack_offset + 4
end;
` push DWORD PTR {emit_addressing addr i.arg 0}\n`;
stack_offset := !stack_offset + 4
| Lop(Ispecific(Ifloatarithmem(op, addr))) ->
if i.arg.(0).loc <> Reg 100 then begin
` fld {emit_reg i.arg.(0)}\n`;
@ -709,6 +766,7 @@ let fundecl fundecl =
tailrec_entry_point := new_label();
stack_offset := 0;
float_constants := [];
call_gc_sites := [];
range_check_trap := 0;
` .CODE\n`;
add_def_symbol fundecl.fun_name;
@ -720,6 +778,7 @@ let fundecl fundecl =
` sub esp, {emit_int n}\n`;
`{emit_label !tailrec_entry_point}:\n`;
emit_all fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
if !range_check_trap > 0 then
`{emit_label !range_check_trap}: jmp _array_bound_error\n`;
begin match !float_constants with

3
asmcomp/proc_alpha.ml
View File

@ -63,6 +63,8 @@ let select_oper op args =
let select_store addr exp = raise Use_default
let select_push exp = fatal_error "Proc: select_push"
let pseudoregs_for_operation op arg res = raise Use_default
let is_immediate (n:int) = true
@ -215,6 +217,7 @@ let loc_external_arguments arg =
ext_calling_conventions 13 18 116 121 outgoing arg
let loc_external_results res =
let (loc, ofs) = ext_calling_conventions 0 0 100 100 not_supported res in loc
let extcall_use_push = false
let loc_exn_bucket = phys_reg 0 (* $0 *)

4
asmcomp/proc_hppa.ml
View File

@ -165,6 +165,8 @@ let select_oper op args =
let select_store addr exp = raise Use_default
let select_push exp = fatal_error "Proc: select_push"
let pseudoregs_for_operation op arg res =
match op with
Iintop(Idiv | Imod) -> (* handled via calls to millicode *)
@ -250,6 +252,8 @@ let loc_external_arguments arg =
done;
(loc, Misc.align !ofs 8)
let extcall_use_push = false
let loc_external_results res =
let (loc, ofs) = calling_conventions 21 21 100 100 not_supported res in loc

15
asmcomp/proc_i386nt.ml
View File

@ -257,6 +257,16 @@ let select_store addr exp =
| Cconst_symbol s -> (Ispecific(Istore_symbol(s, addr)), Ctuple [])
| _ -> raise Use_default
let select_push exp =
match exp with
Cconst_int n -> (Ispecific(Ipush_int n), Ctuple [])
| Cconst_pointer n -> (Ispecific(Ipush_int n), Ctuple [])
| Cconst_symbol s -> (Ispecific(Ipush_symbol s), Ctuple [])
| Cop(Cload ty, [loc]) when Array.length ty = 1 ->
let (addr, arg) = select_addressing loc in
(Ispecific(Ipush_load(ty.(0), addr)), arg)
| _ -> (Ispecific(Ipush), exp)
let pseudoregs_for_operation op arg res =
match op with
(* Two-address binary operations *)
@ -341,8 +351,9 @@ let loc_parameters arg =
let (loc, ofs) = calling_conventions 0 5 101 104 incoming arg in loc
let loc_results res =
let (loc, ofs) = calling_conventions 0 5 101 104 not_supported res in loc
let extcall_use_push = true
let loc_external_arguments arg =
calling_conventions 0 (-1) 101 100 outgoing arg
fatal_error "Proc.loc_external_arguments"
let loc_external_results res =
let (loc, ofs) = calling_conventions 0 0 101 101 not_supported res in loc
@ -400,7 +411,7 @@ let reload_operation makereg op arg res =
then ([|arg.(0); makereg arg.(1)|], res)
else (arg, res)
| Iintop(Ilsl|Ilsr|Iasr) | Iintop_imm(_, _) | Ifloatofint | Iintoffloat |
Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf ->
Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf | Ispecific(Ipush) ->
(* The argument(s) can be either in register or on stack *)
(arg, res)
| Ispecific(Ifloatarithmem(_, _)) ->

4
asmcomp/proc_mips.ml
View File

@ -41,6 +41,8 @@ let select_oper op args = raise Use_default
let select_store addr exp = raise Use_default
let select_push exp = fatal_error "Proc: select_push"
let pseudoregs_for_operation op arg res = raise Use_default
let is_immediate (n:int) = true
@ -184,6 +186,8 @@ let loc_external_arguments arg =
| _ ->
fatal_error "Proc_mips.loc_external_arguments"
let extcall_use_push = false
let loc_external_results res =
let (loc, ofs) = calling_conventions 0 0 100 100 0 not_supported res in loc

4
asmcomp/proc_power.ml
View File

@ -99,6 +99,8 @@ let select_oper op args =
let select_store addr exp = raise Use_default
let select_push exp = fatal_error "Proc: select_push"
let pseudoregs_for_operation op arg res = raise Use_default
let is_immediate n = (n <= 32767) & (n >= -32768)
@ -246,6 +248,8 @@ let external_conventions first_int last_int first_float last_float arg =
let loc_external_arguments arg = external_conventions 0 7 100 112 arg
let extcall_use_push = false
(* Results are in GPR 3 and FPR 1 *)
let loc_external_results res =

4
asmcomp/proc_sparc.ml
View File

@ -85,6 +85,8 @@ let select_oper op args =
let select_store addr exp = raise Use_default
let select_push exp = fatal_error "Proc: select_push"
let pseudoregs_for_operation op arg res = raise Use_default
let word_addressed = false
@ -223,6 +225,8 @@ let loc_external_arguments arg =
done;
(loc, Misc.align (!ofs + 4) 8) (* Keep stack 8-aligned *)
let extcall_use_push = false
let loc_external_results res =
let (loc, ofs) = calling_conventions 8 8 100 100 not_supported res in loc