Skip to content

Commit

Permalink
amd64: Move stack realloc calls out-of-line
Browse files Browse the repository at this point in the history
  • Loading branch information
stedolan committed Nov 11, 2021
1 parent 324d218 commit 86dbe1c
Showing 1 changed file with 22 additions and 4 deletions.
26 changes: 22 additions & 4 deletions asmcomp/amd64/emit.mlp
Original file line number Diff line number Diff line change
Expand Up @@ -279,6 +279,19 @@ let emit_call_gc gc =
def_label gc.gc_frame;
I.jmp (label gc.gc_return_lbl)

(* Record calls to local stack reallocation *)

type local_realloc_call =
{ lr_lbl: label;
lr_return_lbl: label; }

let local_realloc_sites = ref ([] : local_realloc_call list)

let emit_local_realloc lr =
def_label lr.lr_lbl;
emit_call "caml_call_local_realloc";
I.jmp (label lr.lr_return_lbl)

(* Record calls to caml_ml_array_bound_error.
In -g mode we maintain one call to
caml_ml_array_bound_error per bound check site. Without -g, we can share
Expand Down Expand Up @@ -657,12 +670,15 @@ let emit_instr fallthrough i =
(* FIXME: before or after check? Calling conv w/ realloc *)
I.mov r (domain_field Domainstate.Domain_local_sp);
I.cmp (domain_field Domainstate.Domain_local_limit) r;
let lbl_ok = new_label () in
I.j GE (label lbl_ok);
emit_call "caml_call_local_realloc";
def_label lbl_ok;
let lbl_call = new_label () in
I.j L (label lbl_call);
let lbl_after_alloc = new_label () in
def_label lbl_after_alloc;
I.add (domain_field Domainstate.Domain_local_top) r;
I.add (int 8) r;
local_realloc_sites :=
{ lr_lbl = lbl_call;
lr_return_lbl = lbl_after_alloc } :: !local_realloc_sites
| Lop(Iintop(Icomp cmp)) ->
I.cmp (arg i 1) (arg i 0);
I.set (cond cmp) al;
Expand Down Expand Up @@ -885,6 +901,7 @@ let fundecl fundecl =
tailrec_entry_point := fundecl.fun_tailrec_entry_point_label;
stack_offset := 0;
call_gc_sites := [];
local_realloc_sites := [];
bound_error_sites := [];
bound_error_call := 0;
for i = 0 to Proc.num_register_classes - 1 do
Expand All @@ -908,6 +925,7 @@ let fundecl fundecl =
cfi_startproc ();
emit_all true fundecl.fun_body;
List.iter emit_call_gc !call_gc_sites;
List.iter emit_local_realloc !local_realloc_sites;
emit_call_bound_errors ();
if !frame_required then begin
let n = frame_size() - 8 - (if fp then 8 else 0) in
Expand Down

0 comments on commit 86dbe1c

Please sign in to comment.