Skip to content

Commit bc41c99

Browse files
stedolanstedolan
committed
Minor fixes for local allocations (ocaml#24)
* Comballoc bugfix for local types. When Comballoc does an actual allocation, the state of the other allocation must must be preserved, as there are two independent allocation combining sequences. * Bugfix for type_function: check return modes of curried lambdas * Print total local allocations under v=0x400 * Rudimentary GC scanning for local types
1 parent a2a4e60 commit bc41c99

8 files changed

Lines changed: 61 additions & 5 deletions

File tree

‎asmcomp/amd64/emit.mlp‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -755,6 +755,9 @@ let emit_instr fallthrough i =
755755
| Lop(Ibeginregion) ->
756756
I.mov (domain_field Domainstate.Domain_local_sp) (res i 0)
757757
| Lop(Iendregion) ->
758+
I.mov (arg i 0) r11;
759+
I.sub (domain_field Domainstate.Domain_local_sp) r11;
760+
I.add r11 (domain_field Domainstate.Domain_local_total);
758761
I.mov (arg i 0) (domain_field Domainstate.Domain_local_sp)
759762
| Lop (Iname_for_debugger _) -> ()
760763
| Lreloadretaddr ->

‎asmcomp/amd64/proc.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -312,6 +312,7 @@ let destroyed_at_oper = function
312312
-> [| rax |]
313313
| Iswitch(_, _) -> [| rax; rdx |]
314314
| Itrywith _ -> [| r11 |]
315+
| Iop(Iendregion) -> [| r11 |]
315316
| _ ->
316317
if fp then
317318
(* prevent any use of the frame pointer ! *)

‎asmcomp/comballoc.ml‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -75,8 +75,9 @@ let rec combine i allocstate =
7575
else instr_cons_debug (Iop(Iintop_imm(Iadd, offset))) i.res
7676
i.res i.dbg next
7777
in
78+
let rstate = set_mode mode state (get_mode mode allocstate) in
7879
(instr_cons_debug (Iop(Ialloc {bytes = totalsz; dbginfo; mode}))
79-
i.arg i.res i.dbg next, allocstate)
80+
i.arg i.res i.dbg next, rstate)
8081
end
8182
| Iop(Icall_ind | Icall_imm _ | Iextcall _ |
8283
Itailcall_ind | Itailcall_imm _) ->

‎runtime/caml/domain_state.tbl‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -39,6 +39,7 @@ DOMAIN_STATE(struct caml_custom_table*, custom_table)
3939
DOMAIN_STATE(intnat, local_sp)
4040
DOMAIN_STATE(struct region_stack*, local_top)
4141
DOMAIN_STATE(intnat, local_limit)
42+
DOMAIN_STATE(intnat, local_total)
4243

4344
DOMAIN_STATE(struct mark_stack*, mark_stack)
4445
/* See major_gc.c */

‎runtime/memory.c‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -691,7 +691,8 @@ CAMLexport void caml_local_region_end(intnat reg)
691691
Caml_state->local_sp = reg;
692692
}
693693

694-
#define Local_init_wsz 64
694+
//#define Local_init_wsz 64
695+
#define Local_init_wsz (64*1024*1024)
695696
void caml_local_realloc()
696697
{
697698
intnat new_bsize;
@@ -706,6 +707,7 @@ void caml_local_realloc()
706707
while (Caml_state->local_sp < -new_bsize) new_bsize *= 2;
707708
stkbase = caml_stat_alloc(new_bsize + sizeof(struct region_stack));
708709
stk = (struct region_stack*)(stkbase + new_bsize);
710+
memset(stkbase, 0x42, new_bsize); /* FIXME debugging only */
709711
stk->base = stkbase;
710712
stk->next = Caml_state->local_top;
711713
Caml_state->local_top = stk;

‎runtime/roots_nat.c‎

Lines changed: 42 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -330,6 +330,27 @@ void caml_oldify_local_roots (void)
330330
}
331331
}
332332
}
333+
/* Local allocations */
334+
{
335+
header_t* hp = (header_t*)((char*)Caml_state->local_top + Caml_state->local_sp);
336+
value start = Val_hp(hp), end = Val_hp((header_t*)Caml_state->local_top);
337+
while (hp < (header_t*)Caml_state->local_top) {
338+
header_t hd = Hd_hp(hp);
339+
CAMLassert(Tag_hd(hd) != Infix_tag);
340+
if (Tag_hd(hd) < No_scan_tag) {
341+
i = 0;
342+
if (Tag_hd(hd) == Closure_tag)
343+
i = Start_env_closinfo(Closinfo_val(Val_hp(hp)));
344+
for (; i < Wosize_hd(hd); i++) {
345+
value* p = Op_hp(hp) + i;
346+
if (Is_block(*p) && !(start <= *p && *p < end))
347+
Oldify(p);
348+
}
349+
}
350+
hp += Whsize_hd(hd);
351+
}
352+
CAMLassert(hp == (header_t*)Caml_state->local_top);
353+
}
333354
/* Global C roots */
334355
caml_scan_global_young_roots(&caml_oldify_one);
335356
/* Finalised values */
@@ -509,6 +530,27 @@ void caml_do_local_roots_nat(scanning_action f, char * bottom_of_stack,
509530
}
510531
}
511532
}
533+
/* Local allocations */
534+
{
535+
header_t* hp = (header_t*)((char*)Caml_state->local_top + Caml_state->local_sp);
536+
value start = Val_hp(hp), end = Val_hp((header_t*)Caml_state->local_top);
537+
while (hp < (header_t*)Caml_state->local_top) {
538+
header_t hd = Hd_hp(hp);
539+
CAMLassert(Tag_hd(hd) != Infix_tag);
540+
if (Tag_hd(hd) < No_scan_tag) {
541+
i = 0;
542+
if (Tag_hd(hd) == Closure_tag)
543+
i = Start_env_closinfo(Closinfo_val(Val_hp(hp)));
544+
for (; i < Wosize_hd(hd); i++) {
545+
value* p = Op_hp(hp) + i;
546+
if (Is_block(*p) && !(start <= *p && *p < end))
547+
f(*p, p);
548+
}
549+
}
550+
hp += Whsize_hd(hd);
551+
}
552+
CAMLassert(hp == (header_t*)Caml_state->local_top);
553+
}
512554
}
513555

514556
uintnat (*caml_stack_usage_hook)(void) = NULL;

‎runtime/sys.c‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -150,6 +150,8 @@ CAMLprim value caml_sys_exit(value retcode_v)
150150
caml_gc_message(0x400,
151151
"forced_major_collections: %"ARCH_INTNAT_PRINTF_FORMAT"d\n",
152152
forcmajcoll);
153+
caml_gc_message(0x400, "local_words: %"ARCH_INTNAT_PRINTF_FORMAT"d\n",
154+
Wsize_bsize(Caml_state->local_total));
153155
}
154156

155157
#ifndef NATIVE_CODE

‎typing/typecore.ml‎

Lines changed: 7 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -3814,11 +3814,15 @@ and type_function ?in_function loc attrs env mode ty_expected_explained l caseli
38143814
ty_fun,
38153815
explanation)))
38163816
in
3817-
if not curry then
3818-
begin match Types.Alloc_mode.submode ret_mode Alloc_heap with
3817+
if curry then begin
3818+
match Types.Alloc_mode.submode mode ret_mode with
38193819
| Ok () -> ()
38203820
| Error _ -> raise (Error(loc, env, Local_return_value_escapes))
3821-
end;
3821+
end else begin
3822+
match Types.Alloc_mode.submode ret_mode Alloc_heap with
3823+
| Ok () -> ()
3824+
| Error _ -> raise (Error(loc, env, Local_return_value_escapes))
3825+
end;
38223826
let ty_arg =
38233827
if is_optional l then
38243828
let tv = newvar() in

0 commit comments

Comments
 (0)