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

Revert the change to the GC calling protocol: the allocation pointer 

does not need to point to a valid header when the GC is called. On the
other hand, the major GC can only start a cycle when the minor heap
(allocation arena) is empty.
master
Damien Doligez 2015-12-04 14:40:37 +01:00
parent 99e265459f
commit 5b8296c933
18 changed files with 40 additions and 114 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
asmcomp/amd64/emit.mlp
View File

@ -269,7 +269,6 @@ let record_frame live dbg =
type gc_call =
{ gc_lbl: label; (* Entry label *)
gc_size: int; (* How much to add back to [young_ptr]*)
gc_return_lbl: label; (* Where to branch after GC *)
gc_frame: label } (* Label of frame descriptor *)
@ -277,7 +276,6 @@ let call_gc_sites = ref ([] : gc_call list)
let emit_call_gc gc =
def_label gc.gc_lbl;
I.add (int gc.gc_size) r15;
emit_call "caml_call_gc";
def_label gc.gc_frame;
I.jmp (label gc.gc_return_lbl)
@ -582,7 +580,6 @@ let emit_instr fallthrough i =
I.lea (mem64 NONE 8 R15) (res i 0);
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
gc_size = n;
gc_return_lbl = lbl_redo;
gc_frame = lbl_frame } :: !call_gc_sites
end else begin

8
asmcomp/arm/emit.mlp
View File

@ -125,18 +125,13 @@ let record_frame live dbg =
type gc_call =
{ gc_lbl: label; (* Entry label *)
gc_size : int; (* How much to add back to [young_ptr] *)
gc_return_lbl: label; (* Where to branch after GC *)
gc_frame_lbl: label } (* Label of frame descriptor *)
let call_gc_sites = ref ([] : gc_call list)
let emit_call_gc gc =
`{emit_label gc.gc_lbl}:`;
ignore (decompose_intconst
(Int32.of_int gc.gc_size)
(fun i -> ` add alloc_ptr, alloc_ptr, #{emit_int32 i}\n`));
` {emit_call "caml_call_gc"}\n`;
`{emit_label gc.gc_lbl}: {emit_call "caml_call_gc"}\n`;
`{emit_label gc.gc_frame_lbl}: b {emit_label gc.gc_return_lbl}\n`
(* Record calls to caml_ml_array_bound_error.
@ -557,7 +552,6 @@ let emit_instr i =
` bcc {emit_label lbl_call_gc}\n`;
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
gc_size = i;
gc_return_lbl = lbl_redo;
gc_frame_lbl = lbl_frame } :: !call_gc_sites;
3 + ninstr

7
asmcomp/arm64/emit.mlp
View File

@ -145,15 +145,13 @@ let record_frame live dbg =
type gc_call =
{ gc_lbl: label; (* Entry label *)
gc_size: int; (* How much to add back to [young_ptr] *)
gc_return_lbl: label; (* Where to branch after GC *)
gc_frame_lbl: label } (* Label of frame descriptor *)
let call_gc_sites = ref ([] : gc_call list)
let emit_call_gc gc =
`{emit_label gc.gc_lbl}: add {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, #{emit_int gc.gc_size}\n`;
` bl {emit_symbol "caml_call_gc"}\n`;
`{emit_label gc.gc_lbl}: bl {emit_symbol "caml_call_gc"}\n`;
`{emit_label gc.gc_frame_lbl}: b {emit_label gc.gc_return_lbl}\n`
(* Record calls to caml_ml_array_bound_error.
@ -364,7 +362,7 @@ let num_call_gc_and_check_bound_points instr =
let max_out_of_line_code_offset instr ~num_call_gc ~num_check_bound =
if num_call_gc < 1 && num_check_bound < 1 then 0
else begin
let size_of_call_gc = 3 in
let size_of_call_gc = 2 in
let size_of_check_bound = 1 in
let size_of_last_thing =
(* Call-GC points come before check-bound points. *)
@ -530,7 +528,6 @@ let assembly_code_for_allocation i ~n ~far =
end;
call_gc_sites :=
{ gc_lbl = lbl_call_gc;
gc_size = n;
gc_return_lbl = lbl_redo;
gc_frame_lbl = lbl_frame } :: !call_gc_sites
end else begin

2
asmcomp/i386/emit.mlp
View File

@ -612,11 +612,11 @@ let emit_instr fallthrough i =
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;
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.mov eax (sym32 "caml_young_ptr");
I.lea (mem32 NONE 4 RAX) (reg i.res.(0));
call_gc_sites :=
{ gc_lbl = lbl_call_gc;

19
asmcomp/notes-on-changes-to-gc-interface.txt
View File

@ -1,19 +0,0 @@
Note: only the AMD64/unix has had a significant amount of testing.
sparc: save the requested size in %g2, [caml_call_gc] uses it to
recover the old value of [caml_young_ptr].
i386: do not write back [caml_young_ptr] in the "gc" branch, only in
the "allocation success" branch.
power: same as i386: do not adjust the allocation register in the GC branch
ARM: adjust the pointer back to its initial value before calling
[caml_call_gc].
ARM64: same as ARM
AMD64_nt: same as ARM
AMD64: same as ARM

16
asmcomp/power/emit.mlp
View File

@ -712,24 +712,22 @@ let emit_instr i =
emit_load_store storeinstr addr i.arg 1 i.arg.(0)
| Lop(Ialloc n) ->
if !call_gc_label = 0 then call_gc_label := new_label();
` addi 11, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 11, 30\n`;
` addi {emit_reg i.res.(0)}, 11, {emit_int size_addr}\n`;
` addi 31, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 31, 30\n`;
` addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`;
` bltl {emit_label !call_gc_label}\n`;
(* Exactly 4 instructions after the beginning of the alloc sequence *)
record_frame i.live Debuginfo.none;
` mr 31, 11\n`
record_frame i.live Debuginfo.none
| Lop(Ispecific(Ialloc_far n)) ->
if !call_gc_label = 0 then call_gc_label := new_label();
let lbl = new_label() in
` addi 11, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 11, 30\n`;
` addi 31, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 31, 30\n`;
` bge {emit_label lbl}\n`;
` bl {emit_label !call_gc_label}\n`;
(* Exactly 4 instructions after the beginning of the alloc sequence *)
record_frame i.live Debuginfo.none;
`{emit_label lbl}: addi {emit_reg i.res.(0)}, 11, {emit_int size_addr}\n`;
` mr 31, 11\n`
`{emit_label lbl}: addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`
| Lop(Iintop Isub) -> (* subfc has swapped arguments *)
` subfc {emit_reg i.res.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(0)}\n`
| Lop(Iintop Imod) ->

4
asmrun/amd64.S
View File

@ -372,7 +372,6 @@ LBL(caml_alloc1):
jb LBL(100)
ret
LBL(100):
addq $16, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8); */
@ -390,7 +389,6 @@ LBL(caml_alloc2):
jb LBL(101)
ret
LBL(101):
addq $24, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8); */
@ -408,7 +406,6 @@ LBL(caml_alloc3):
jb LBL(102)
ret
LBL(102):
addq $32, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8) */
@ -428,7 +425,6 @@ LBL(caml_allocN):
addq $8, %rsp; CFI_ADJUST (-8) /* drop desired size */
ret
LBL(103):
addq (%rsp), %r15
RECORD_STACK_FRAME(8)
#ifdef WITH_FRAME_POINTERS
/* Do we need 16-byte alignment here ? */

4
asmrun/amd64nt.asm
View File

@ -131,7 +131,6 @@ caml_alloc1:
jb L100
ret
L100:
add r15, 16
mov rax, [rsp + 0]
mov caml_last_return_address, rax
lea rax, [rsp + 8]
@ -149,7 +148,6 @@ caml_alloc2:
jb L101
ret
L101:
add r15, 24
mov rax, [rsp + 0]
mov caml_last_return_address, rax
lea rax, [rsp + 8]
@ -167,7 +165,6 @@ caml_alloc3:
jb L102
ret
L102:
add r15, 32
mov rax, [rsp + 0]
mov caml_last_return_address, rax
lea rax, [rsp + 8]
@ -185,7 +182,6 @@ caml_allocN:
jb L103
ret
L103:
add r15, rax
push rax ; save desired size
mov rax, [rsp + 8]
mov caml_last_return_address, rax

14
asmrun/arm.S
View File

@ -127,7 +127,7 @@ caml_call_gc:
/* Store pointer to saved integer registers in caml_gc_regs */
ldr r12, =caml_gc_regs
str sp, [r12]
/* Save current allocation pointer (the GC needs it) */
/* Save current allocation pointer for debugging purposes */
ldr alloc_limit, =caml_young_ptr
str alloc_ptr, [alloc_limit]
/* Save trap pointer in case an exception is raised during GC */
@ -162,8 +162,7 @@ caml_alloc1:
cmp alloc_ptr, alloc_limit
bcc 1f
bx lr
1: add alloc_ptr, alloc_ptr, 8
/* Record return address */
1: /* Record return address */
ldr r7, =caml_last_return_address
str lr, [r7]
/* Call GC (preserves r7) */
@ -186,8 +185,7 @@ caml_alloc2:
cmp alloc_ptr, alloc_limit
bcc 1f
bx lr
1: add alloc_ptr, alloc_ptr, 12
/* Record return address */
1: /* Record return address */
ldr r7, =caml_last_return_address
str lr, [r7]
/* Call GC (preserves r7) */
@ -211,8 +209,7 @@ caml_alloc3:
cmp alloc_ptr, alloc_limit
bcc 1f
bx lr
1: add alloc_ptr, alloc_ptr, 16
/* Record return address */
1: /* Record return address */
ldr r7, =caml_last_return_address
str lr, [r7]
/* Call GC (preserves r7) */
@ -235,8 +232,7 @@ caml_allocN:
cmp alloc_ptr, alloc_limit
bcc 1f
bx lr
1: add alloc_ptr, alloc_ptr, r7
/* Record return address */
1: /* Record return address */
ldr r12, =caml_last_return_address
str lr, [r12]
/* Call GC (preserves r7) */

14
asmrun/arm64.S
View File

@ -123,7 +123,7 @@ caml_call_gc:
/* Store pointer to saved integer registers in caml_gc_regs */
add TMP, sp, #16
STOREGLOBAL(TMP, caml_gc_regs)
/* Save current allocation pointer (the GC needs it) */
/* Save current allocation pointer for debugging purposes */
STOREGLOBAL(ALLOC_PTR, caml_young_ptr)
/* Save trap pointer in case an exception is raised during GC */
STOREGLOBAL(TRAP_PTR, caml_exception_pointer)
@ -173,8 +173,7 @@ caml_alloc1:
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
2: add ALLOC_PTR, ALLOC_PTR, #16
stp x29, x30, [sp, -16]!
2: stp x29, x30, [sp, -16]!
CFI_ADJUST(16)
/* Record the lowest address of the caller's stack frame. This is the
address immediately above the pair of words (x29 and x30) we just
@ -207,8 +206,7 @@ caml_alloc2:
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
2: add ALLOC_PTR, ALLOC_PTR, #24
stp x29, x30, [sp, -16]!
2: stp x29, x30, [sp, -16]!
CFI_ADJUST(16)
/* Record the lowest address of the caller's stack frame.
See comment above. */
@ -237,8 +235,7 @@ caml_alloc3:
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
2: add ALLOC_PTR, ALLOC_PTR, #32
stp x29, x30, [sp, -16]!
2: stp x29, x30, [sp, -16]!
CFI_ADJUST(16)
/* Record the lowest address of the caller's stack frame.
See comment above. */
@ -267,8 +264,7 @@ caml_allocN:
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
2: add ALLOC_PTR, ALLOC_PTR, ARG
stp x29, x30, [sp, -16]!
2: stp x29, x30, [sp, -16]!
CFI_ADJUST(16)
/* Record the lowest address of the caller's stack frame.
See comment above. */

7
asmrun/i386.S
View File

@ -171,9 +171,9 @@ FUNCTION(caml_alloc1)
PROFILE_CAML
movl G(caml_young_ptr), %eax
subl $8, %eax
movl %eax, G(caml_young_ptr)
cmpl G(caml_young_limit), %eax
jb LBL(100)
movl %eax, G(caml_young_ptr)
ret
LBL(100):
movl 0(%esp), %eax
@ -191,9 +191,9 @@ FUNCTION(caml_alloc2)
PROFILE_CAML
movl G(caml_young_ptr), %eax
subl $12, %eax
movl %eax, G(caml_young_ptr)
cmpl G(caml_young_limit), %eax
jb LBL(101)
movl %eax, G(caml_young_ptr)
ret
LBL(101):
movl 0(%esp), %eax
@ -211,9 +211,9 @@ FUNCTION(caml_alloc3)
PROFILE_CAML
movl G(caml_young_ptr), %eax
subl $16, %eax
movl %eax, G(caml_young_ptr)
cmpl G(caml_young_limit), %eax
jb LBL(102)
movl %eax, G(caml_young_ptr)
ret
LBL(102):
movl 0(%esp), %eax
@ -239,6 +239,7 @@ LBL(103):
subl G(caml_young_ptr), %eax /* eax = - size */
negl %eax /* eax = size */
pushl %eax; CFI_ADJUST(4) /* save desired size */
subl %eax, G(caml_young_ptr) /* must update young_ptr */
movl 4(%esp), %eax
movl %eax, G(caml_last_return_address)
leal 8(%esp), %eax

7
asmrun/i386nt.asm
View File

@ -72,9 +72,9 @@ L105: push ebp
_caml_alloc1:
mov eax, _caml_young_ptr
sub eax, 8
mov _caml_young_ptr, eax
cmp eax, _caml_young_limit
jb L100
mov _caml_young_ptr, eax
ret
L100: mov eax, [esp]
mov _caml_last_return_address, eax
@ -87,9 +87,9 @@ L100: mov eax, [esp]
_caml_alloc2:
mov eax, _caml_young_ptr
sub eax, 12
mov _caml_young_ptr, eax
cmp eax, _caml_young_limit
jb L101
mov _caml_young_ptr, eax
ret
L101: mov eax, [esp]
mov _caml_last_return_address, eax
@ -102,9 +102,9 @@ L101: mov eax, [esp]
_caml_alloc3:
mov eax, _caml_young_ptr
sub eax, 16
mov _caml_young_ptr, eax
cmp eax, _caml_young_limit
jb L102
mov _caml_young_ptr, eax
ret
L102: mov eax, [esp]
mov _caml_last_return_address, eax
@ -124,6 +124,7 @@ _caml_allocN:
L103: sub eax, _caml_young_ptr ; eax = - size
neg eax ; eax = size
push eax ; save desired size
sub _caml_young_ptr, eax ; must update young_ptr
mov eax, [esp+4]
mov _caml_last_return_address, eax
lea eax, [esp+8]

2
asmrun/power.S
View File

@ -179,7 +179,7 @@ FUNCTION(caml_call_gc)
/* Record pointer to register array */
addi 0, 1, 8*32 + PARAM_SAVE_AREA + RESERVED_STACK
Storeglobal(0, caml_gc_regs, 11)
/* Save current allocation pointer (needed by the GC) */
/* Save current allocation pointer for debugging purposes */
Storeglobal(31, caml_young_ptr, 11)
/* Save exception pointer (if e.g. a sighandler raises) */
Storeglobal(29, caml_exception_pointer, 11)

16
asmrun/roots.c
View File

@ -437,22 +437,6 @@ void caml_do_roots (scanning_action f, int do_globals)
/* Finalised values */
caml_final_do_strong_roots (f);
CAML_INSTR_TIME (tmr, "major_roots/finalised");
/* Objects in the minor heap are roots for the major GC. */
{
value *hp;
asize_t sz, i;
for (hp = caml_young_ptr;
hp < caml_young_alloc_end;
hp += Whsize_wosize (sz)){
sz = Wosize_hp (hp);
if (Tag_hp (hp) < No_scan_tag){
for (i = 0; i < sz; i++){
f(Field(Val_hp(hp), i), &Field(Val_hp(hp), i));
}
}
}
}
CAML_INSTR_TIME (tmr, "major_roots/minor_heap");
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f);
CAML_INSTR_TIME (tmr, "major_roots/hook");

5
asmrun/sparc.S
View File

@ -52,12 +52,11 @@ caml_allocN:
retl
nop
/* Required size in %g2, Alloc_ptr is decremented by required size. */
/* Required size in %g2 */
caml_call_gc:
add Alloc_ptr, %g2, Alloc_ptr
/* Save exception pointer if GC raises */
Store(Exn_ptr, caml_exception_pointer)
/* Save current allocation pointer (the GC needs it) */
/* Save current allocation pointer for debugging purposes */
Store(Alloc_ptr, caml_young_ptr)
/* Record lowest stack address */
Store(%sp, caml_bottom_of_stack)

8
byterun/major_gc.c
View File

@ -606,8 +606,12 @@ void caml_major_collection_slice (intnat howmuch)
(intnat) (p * 1000000));
if (caml_gc_phase == Phase_idle){
start_cycle ();
CAML_INSTR_TIME (tmr, "major/roots");
if (caml_young_ptr == caml_young_alloc_end){
/* We can only start a major GC cycle if the minor allocation arena
is empty, otherwise we'd have to treat it as a set of roots. */
start_cycle ();
CAML_INSTR_TIME (tmr, "major/roots");
}
p = 0;
goto finished;
}

2
byterun/minor_gc.c
View File

@ -380,6 +380,7 @@ CAMLexport void caml_gc_dispatch (void)
caml_young_trigger = caml_young_alloc_mid;
caml_young_limit = caml_young_trigger;
caml_empty_minor_heap ();
/* The minor heap is empty, we can start a major collection. */
if (caml_gc_phase == Phase_idle) caml_major_collection_slice (-1);
CAML_INSTR_TIME (tmr, "dispatch/minor");
@ -393,6 +394,7 @@ CAMLexport void caml_gc_dispatch (void)
caml_young_trigger = caml_young_alloc_mid;
caml_young_limit = caml_young_trigger;
caml_empty_minor_heap ();
/* The minor heap is empty, we can start a major collection. */
if (caml_gc_phase == Phase_idle) caml_major_collection_slice (-1);
CAML_INSTR_TIME (tmr, "dispatch/finalizers_minor");
}

16
byterun/roots.c
View File

@ -89,22 +89,6 @@ void caml_do_roots (scanning_action f, int do_globals)
/* Finalised values */
caml_final_do_strong_roots (f);
CAML_INSTR_TIME (tmr, "major_roots/finalised");
/* Objects in the minor heap are roots for the major GC. */
{
value *hp;
asize_t sz, i;
for (hp = caml_young_ptr;
hp < caml_young_alloc_end;
hp += Whsize_wosize (sz)){
sz = Wosize_hp (hp);
if (Tag_hp (hp) < No_scan_tag){
for (i = 0; i < sz; i++){
f(Field(Val_hp(hp), i), &Field(Val_hp(hp), i));
}
}
}
}
CAML_INSTR_TIME (tmr, "major_roots/minor_heap");
/* Hook */
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(f);
CAML_INSTR_TIME (tmr, "major_roots/hook");