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

GC latency improvements

master
Damien Doligez 2015-11-20 17:54:26 +01:00
parent 7c71653524
commit 0225ca01e3
82 changed files with 4927 additions and 2747 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Changes
View File

@ -152,6 +152,8 @@ Runtime system:
Shinwell, review by Damien Doligez)
- GPR#325: Add v=0x400 flag to OCAMLRUNPARAM to display GC stats on exit (Louis
Gesbert, review by Alain Frisch)
- GPR#297: Several changes to improve the worst-case GC pause time.
(Damien Doligez, with help from Leo White and Francois Bobot)
Standard library:
- PR#5197, GPR#63: Arg: allow flags such as --flag=arg as well as --flag arg

4
INSTALL.adoc
View File

@ -106,6 +106,10 @@ The `configure` script accepts the following options:
Compile and install the debug version of the runtimes, useful
for debugging C stubs and other low-level code.
-with-instrumented-runtime::
Compile and install the instrumented version of the runtimes,
useful mainly for fine-tuning the GC. Works only on Linux.
-verbose::
Verbose output of the configuration tests. Use it if the outcome
of configure is not what you were expecting.

2
VERSION
View File

@ -1,4 +1,4 @@
4.03.0+dev11-2015-10-19
4.03.0+dev12-2015-11-20
# The version string is the first line of this file.
# It must be in the format described in stdlib/sys.mli

3
asmcomp/amd64/emit.mlp
View File

@ -269,6 +269,7 @@ 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 *)
@ -276,6 +277,7 @@ let call_gc_sites = ref ([] : gc_call list)
let emit_call_gc gc =
def_label gc.gc_lbl;
I.sub (int gc.gc_size) r15;
emit_call "caml_call_gc";
def_label gc.gc_frame;
I.jmp (label gc.gc_return_lbl)
@ -580,6 +582,7 @@ 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,13 +125,18 @@ 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}: {emit_call "caml_call_gc"}\n`;
`{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_frame_lbl}: b {emit_label gc.gc_return_lbl}\n`
(* Record calls to caml_ml_array_bound_error.
@ -552,6 +557,7 @@ 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,13 +145,15 @@ 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}: bl {emit_symbol "caml_call_gc"}\n`;
`{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_frame_lbl}: b {emit_label gc.gc_return_lbl}\n`
(* Record calls to caml_ml_array_bound_error.
@ -362,7 +364,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 = 2 in
let size_of_call_gc = 3 in
let size_of_check_bound = 1 in
let size_of_last_thing =
(* Call-GC points come before check-bound points. *)
@ -528,6 +530,7 @@ 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 Normal file
View File

@ -0,0 +1,19 @@
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,22 +712,24 @@ 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 31, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 31, 30\n`;
` addi {emit_reg i.res.(0)}, 31, {emit_int size_addr}\n`;
` 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`;
` bltl {emit_label !call_gc_label}\n`;
(* Exactly 4 instructions after the beginning of the alloc sequence *)
record_frame i.live Debuginfo.none
record_frame i.live Debuginfo.none;
` mr 31, 11\n`
| Lop(Ispecific(Ialloc_far n)) ->
if !call_gc_label = 0 then call_gc_label := new_label();
let lbl = new_label() in
` addi 31, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 31, 30\n`;
` addi 11, 31, {emit_int(-n)}\n`;
` {emit_string cmplg} 11, 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)}, 31, {emit_int size_addr}\n`
`{emit_label lbl}: addi {emit_reg i.res.(0)}, 11, {emit_int size_addr}\n`;
` mr 31, 11\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) ->

2478
asmrun/.depend
View File

File diff suppressed because it is too large Load Diff

76
asmrun/Makefile
View File

@ -18,12 +18,13 @@ FLAGS=-I../byterun -DCAML_NAME_SPACE -DNATIVE_CODE \
-DTARGET_$(ARCH) -DMODEL_$(MODEL) -DSYS_$(SYSTEM) $(IFLEXDIR)
CFLAGS=$(FLAGS) $(NATIVECCCOMPOPTS)
DFLAGS=$(FLAGS) -g -DDEBUG $(NATIVECCCOMPOPTS)
IFLAGS=$(FLAGS) -DCAML_INSTR
PFLAGS=$(FLAGS) -pg -DPROFILING $(NATIVECCPROFOPTS) $(NATIVECCCOMPOPTS)
PICFLAGS=$(FLAGS) $(SHAREDCCCOMPOPTS) $(NATIVECCCOMPOPTS)
COBJS=startup_aux.o startup.o \
main.o fail.o roots.o globroots.o signals.o signals_asm.o \
misc.o freelist.o major_gc.o minor_gc.o memory.o alloc.o compare.o ints.o \
freelist.o misc.o major_gc.o minor_gc.o memory.o alloc.o compare.o ints.o \
floats.o str.o array.o io.o extern.o intern.o hash.o sys.o parsing.o \
gc_ctrl.o terminfo.o md5.o obj.o lexing.o printexc.o callback.o weak.o \
compact.o finalise.o custom.o $(UNIX_OR_WIN32).o backtrace_prim.o \
@ -34,11 +35,16 @@ ASMOBJS=$(ARCH).o
OBJS=$(COBJS) $(ASMOBJS)
DOBJS=$(COBJS:.o=.d.o) $(ASMOBJS)
IOBJS=$(COBJS:.o=.i.o) $(ASMOBJS)
POBJS=$(COBJS:.o=.p.o) $(ASMOBJS:.o=.p.o)
PICOBJS=$(COBJS:.o=.pic.o) $(ASMOBJS:.o=.pic.o)
all: libasmrun.a all-$(RUNTIMED) all-$(PROFILING) all-$(SHARED)
ifeq "$(RUNTIMEI)" "true"
all: libasmruni.a
endif
libasmrun.a: $(OBJS)
rm -f libasmrun.a
$(ARCMD) rc libasmrun.a $(OBJS)
@ -55,6 +61,11 @@ libasmrund.a: $(DOBJS)
$(ARCMD) rc libasmrund.a $(DOBJS)
$(RANLIB) libasmrund.a
libasmruni.a: $(IOBJS)
rm -f $@
$(ARCMD) rc $@ $^
$(RANLIB) $@
all-noprof:
all-prof: libasmrunp.a
@ -78,40 +89,39 @@ libasmrun_shared.so: $(PICOBJS)
INSTALL_LIBDIR=$(DESTDIR)$(LIBDIR)
install: install-default install-$(RUNTIMED) install-$(PROFILING) \
install-$(SHARED)
install-default:
install::
cp libasmrun.a $(INSTALL_LIBDIR)/libasmrun.a
cd $(INSTALL_LIBDIR); $(RANLIB) libasmrun.a
.PHONY: install-default
install-noruntimed:
.PHONY: install-noruntimed
install-runtimed:
ifeq "$(RUNTIMED)" "runtimed"
install::
cp libasmrund.a $(INSTALL_LIBDIR)/libasmrund.a
cd $(INSTALL_LIBDIR); $(RANLIB) libasmrund.a
.PHONY: install-runtimed
endif
install-noprof:
rm -f $(INSTALL_LIBDIR)/libasmrunp.a
ln -s libasmrun.a $(INSTALL_LIBDIR)/libasmrunp.a
.PHONY: install-noprof
ifeq "$(RUNTIMEI)" "true"
install::
cp libasmruni.a $(INSTALL_LIBDIR)/libasmruni.a
cd $(INSTALL_LIBDIR); $(RANLIB) libasmruni.a
endif
install-prof:
ifeq "$(PROFILING)" "prof"
install::
cp libasmrunp.a $(INSTALL_LIBDIR)/libasmrunp.a
cd $(INSTALL_LIBDIR); $(RANLIB) libasmrunp.a
.PHONY: install-prof
else
install::
rm -f $(INSTALL_LIBDIR)/libasmrunp.a
ln -s libasmrun.a $(INSTALL_LIBDIR)/libasmrunp.a
endif
install-noshared:
.PHONY: install-noshared
install-shared:
ifeq "$(SHARED)" "shared"
install::
cp libasmrun_pic.a $(INSTALL_LIBDIR)/libasmrun_pic.a
cd $(INSTALL_LIBDIR); $(RANLIB) libasmrunp.a
cp libasmrun_shared.so $(INSTALL_LIBDIR)/libasmrun_shared.so
.PHONY: install-prof
endif
main.c: ../byterun/main.c
ln -s ../byterun/main.c main.c
@ -197,6 +207,18 @@ LINKEDFILES=misc.c freelist.c major_gc.c minor_gc.c memory.c alloc.c array.c \
clean::
rm -f $(LINKEDFILES)
%.d.o: %.c
$(CC) -c $(DFLAGS) -o $@ $<
%.i.o : %.c
$(CC) -c $(IFLAGS) -o $@ $<
%.p.o: %.c
$(CC) -c $(PFLAGS) -o $@ $<
%.pic.o: %.c
$(CC) -c $(PICFLAGS) -o $@ $<
%.o: %.S
$(ASPP) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) -o $@ $< || \
{ echo "If your assembler produced syntax errors, it is probably";\
@ -210,15 +232,6 @@ clean::
%.pic.o: %.S
$(ASPP) -DSYS_$(SYSTEM) -DMODEL_$(MODEL) $(SHAREDCCCOMPOPTS) -o $@ $<
%.d.o: %.c
$(CC) -c $(DFLAGS) -o $@ $<
%.p.o: %.c
$(CC) -c $(PFLAGS) -o $@ $<
%.pic.o: %.c
$(CC) -c $(PICFLAGS) -o $@ $<
%.o: %.s
$(ASPP) -DSYS_$(SYSTEM) -o $@ $<
@ -233,7 +246,8 @@ clean::
depend: $(COBJS:.o=.c) ${LINKEDFILES}
$(CC) -MM $(FLAGS) *.c > .depend
$(CC) -MM $(FLAGS) -DPROFILING *.c | sed -e 's/\.o/.p.o/' >> .depend
$(CC) -MM $(FLAGS) -DDEBUG *.c | sed -e 's/\.o/.d.o/' >> .depend
$(CC) -MM $(FLAGS) *.c | sed -e 's/\.o/.p.o/' >> .depend
$(CC) -MM $(FLAGS) -DCAML_INSTR *.c | sed -e 's/\.o/.i.o/' >> .depend
include .depend

4
asmrun/amd64.S
View File

@ -372,6 +372,7 @@ LBL(caml_alloc1):
jb LBL(100)
ret
LBL(100):
addq $16, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8); */
@ -389,6 +390,7 @@ LBL(caml_alloc2):
jb LBL(101)
ret
LBL(101):
addq $24, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8); */
@ -406,6 +408,7 @@ LBL(caml_alloc3):
jb LBL(102)
ret
LBL(102):
addq $32, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8) */
@ -425,6 +428,7 @@ 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,6 +131,7 @@ caml_alloc1:
jb L100
ret
L100:
add r15, 16
mov rax, [rsp + 0]
mov caml_last_return_address, rax
lea rax, [rsp + 8]
@ -148,6 +149,7 @@ caml_alloc2:
jb L101
ret
L101:
add r15, 24
mov rax, [rsp + 0]
mov caml_last_return_address, rax
lea rax, [rsp + 8]
@ -165,6 +167,7 @@ caml_alloc3:
jb L102
ret
L102:
add r15, 32
mov rax, [rsp + 0]
mov caml_last_return_address, rax
lea rax, [rsp + 8]
@ -182,6 +185,7 @@ 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 for debugging purposes */
/* Save current allocation pointer (the GC needs it) */
ldr alloc_limit, =caml_young_ptr
str alloc_ptr, [alloc_limit]
/* Save trap pointer in case an exception is raised during GC */
@ -162,7 +162,8 @@ caml_alloc1:
cmp alloc_ptr, alloc_limit
bcc 1f
bx lr
1: /* Record return address */
1: add alloc_ptr, alloc_ptr, 8
/* Record return address */
ldr r7, =caml_last_return_address
str lr, [r7]
/* Call GC (preserves r7) */
@ -185,7 +186,8 @@ caml_alloc2:
cmp alloc_ptr, alloc_limit
bcc 1f
bx lr
1: /* Record return address */
1: add alloc_ptr, alloc_ptr, 12
/* Record return address */
ldr r7, =caml_last_return_address
str lr, [r7]
/* Call GC (preserves r7) */
@ -209,7 +211,8 @@ caml_alloc3:
cmp alloc_ptr, alloc_limit
bcc 1f
bx lr
1: /* Record return address */
1: add alloc_ptr, alloc_ptr, 16
/* Record return address */
ldr r7, =caml_last_return_address
str lr, [r7]
/* Call GC (preserves r7) */
@ -232,7 +235,8 @@ caml_allocN:
cmp alloc_ptr, alloc_limit
bcc 1f
bx lr
1: /* Record return address */
1: add alloc_ptr, alloc_ptr, r7
/* 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 for debugging purposes */
/* Save current allocation pointer (the GC needs it) */
STOREGLOBAL(ALLOC_PTR, caml_young_ptr)
/* Save trap pointer in case an exception is raised during GC */
STOREGLOBAL(TRAP_PTR, caml_exception_pointer)
@ -173,7 +173,8 @@ caml_alloc1:
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
2: stp x29, x30, [sp, -16]!
2: add ALLOC_PTR, ALLOC_PTR, #16
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
@ -206,7 +207,8 @@ caml_alloc2:
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
2: stp x29, x30, [sp, -16]!
2: add ALLOC_PTR, ALLOC_PTR, #24
stp x29, x30, [sp, -16]!
CFI_ADJUST(16)
/* Record the lowest address of the caller's stack frame.
See comment above. */
@ -235,7 +237,8 @@ caml_alloc3:
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
2: stp x29, x30, [sp, -16]!
2: add ALLOC_PTR, ALLOC_PTR, #32
stp x29, x30, [sp, -16]!
CFI_ADJUST(16)
/* Record the lowest address of the caller's stack frame.
See comment above. */
@ -264,7 +267,8 @@ caml_allocN:
cmp ALLOC_PTR, ALLOC_LIMIT
b.lo 2f
ret
2: stp x29, x30, [sp, -16]!
2: add ALLOC_PTR, ALLOC_PTR, ARG
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,7 +239,6 @@ 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,7 +124,6 @@ _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 for debugging purposes */
/* Save current allocation pointer (needed by the GC) */
Storeglobal(31, caml_young_ptr, 11)
/* Save exception pointer (if e.g. a sighandler raises) */
Storeglobal(29, caml_exception_pointer, 11)

92
asmrun/roots.c
View File

@ -335,27 +335,77 @@ void caml_oldify_local_roots (void)
if (caml_scan_roots_hook != NULL) (*caml_scan_roots_hook)(&caml_oldify_one);
}
/* Call [darken] on all roots */
static mlsize_t incr_roots_i, incr_roots_j, roots_count;
static value *incr_roots_glob;
uintnat caml_incremental_roots_count = 0;
void caml_darken_all_roots (void)
/* Call [caml_darken] on all roots, incrementally:
[caml_darken_all_roots_start] does the non-incremental part and
sets things up for [caml_darken_all_roots_slice].
*/
void caml_darken_all_roots_start (void)
{
caml_do_roots (caml_darken);
caml_do_roots (caml_darken, 0);
incr_roots_i = 0;
incr_roots_glob = caml_globals[incr_roots_i];
incr_roots_j = 0;
roots_count = 0;
}
void caml_do_roots (scanning_action f)
/* Call [caml_darken] on at most [work] global roots. Return the
number of roots darkened; if this is less than [work], then the
work is done and there are no more roots to darken.
*/
intnat caml_darken_all_roots_slice (intnat work)
{
mlsize_t j = incr_roots_j;
mlsize_t sz;
intnat work_done = 0;
CAML_INSTR_SETUP (tmr, "");
if (incr_roots_glob == NULL) goto finished;
sz = Wosize_val (*incr_roots_glob);
while (work_done < work){
while (j >= sz){
++ incr_roots_glob;
while (*incr_roots_glob == 0){
++ incr_roots_i;
incr_roots_glob = caml_globals[incr_roots_i];
if (incr_roots_glob == 0) goto finished;
}
j = 0;
sz = Wosize_val (*incr_roots_glob);
}
caml_darken (Field (*incr_roots_glob, j), &Field (*incr_roots_glob, j));
++ work_done;
++ j;
}
finished:
incr_roots_j = j;
roots_count += work_done;
if (work_done < work){
caml_incremental_roots_count = roots_count;
}
CAML_INSTR_TIME (tmr, "major/mark/global_roots_slice");
return work_done;
}
void caml_do_roots (scanning_action f, int do_globals)
{
int i, j;
value * glob;
link *lnk;
CAML_INSTR_SETUP (tmr, "major_roots");
/* The global roots */
for (i = 0; caml_globals[i] != 0; i++) {
for(glob = caml_globals[i]; *glob != 0; glob++) {
for (j = 0; j < Wosize_val(*glob); j++)
f (Field (*glob, j), &Field (*glob, j));
if (do_globals){
/* The global roots */
for (i = 0; caml_globals[i] != 0; i++) {
for(glob = caml_globals[i]; *glob != 0; glob++) {
for (j = 0; j < Wosize_val(*glob); j++)
f (Field (*glob, j), &Field (*glob, j));
}
}
}
/* Dynamic global roots */
iter_list(caml_dyn_globals, lnk) {
for(glob = (value *) lnk->data; *glob != 0; glob++) {
@ -364,16 +414,36 @@ void caml_do_roots (scanning_action f)
}
}
}
CAML_INSTR_TIME (tmr, "major_roots/dynamic_global");
/* The stack and local roots */
caml_do_local_roots(f, caml_bottom_of_stack, caml_last_return_address,
caml_gc_regs, caml_local_roots);
CAML_INSTR_TIME (tmr, "major_roots/local");
/* Global C roots */
caml_scan_global_roots(f);
CAML_INSTR_TIME (tmr, "major_roots/C");
/* 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");
}
void caml_do_local_roots(scanning_action f, char * bottom_of_stack,

8
asmrun/signals_asm.c
View File

@ -67,9 +67,11 @@ extern char caml_system__code_begin, caml_system__code_end;
void caml_garbage_collection(void)
{
caml_young_limit = caml_young_start;
if (caml_young_ptr < caml_young_start || caml_force_major_slice) {
caml_minor_collection();
CAMLassert (caml_young_ptr >= caml_young_alloc_start);
caml_young_limit = caml_young_trigger;
if (caml_requested_major_slice || caml_requested_minor_gc ||
caml_young_ptr - caml_young_trigger < Max_young_whsize){
caml_gc_dispatch ();
}
caml_process_pending_signals();
}

5
asmrun/sparc.S
View File

@ -52,11 +52,12 @@ caml_allocN:
retl
nop
/* Required size in %g2 */
/* Required size in %g2, Alloc_ptr is decremented by required size. */
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 for debugging purposes */
/* Save current allocation pointer (the GC needs it) */
Store(Alloc_ptr, caml_young_ptr)
/* Record lowest stack address */
Store(%sp, caml_bottom_of_stack)

11
asmrun/startup.c
View File

@ -107,14 +107,17 @@ void caml_main(char **argv)
caml_install_invalid_parameter_handler();
#endif
caml_init_custom_operations();
#ifdef DEBUG
caml_verb_gc = 63;
#endif
caml_top_of_stack = &tos;
#ifdef DEBUG
caml_verb_gc = 0x3F;
#endif
caml_parse_ocamlrunparam();
#ifdef DEBUG
caml_gc_message (-1, "### OCaml runtime: debug mode ###\n", 0);
#endif
caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz,
caml_init_heap_chunk_sz, caml_init_percent_free,
caml_init_max_percent_free);
caml_init_max_percent_free, caml_init_major_window);
init_static();
caml_init_signals();
caml_init_backtrace();

1
asmrun/startup_aux.c Symbolic link
View File

@ -0,0 +1 @@
../byterun/startup_aux.c

1514
byterun/.depend
View File

File diff suppressed because it is too large Load Diff

17
byterun/Makefile
View File

@ -15,9 +15,11 @@ include Makefile.common
CFLAGS=-DCAML_NAME_SPACE $(BYTECCCOMPOPTS) $(IFLEXDIR)
DFLAGS=-DCAML_NAME_SPACE -g -DDEBUG $(BYTECCCOMPOPTS) $(IFLEXDIR)
IFLAGS=$(CFLAGS) -DCAML_INSTR
OBJS=$(COMMONOBJS) $(UNIX_OR_WIN32).o main.o
DOBJS=$(OBJS:.o=.d.o) instrtrace.d.o
IOBJS=$(OBJS:.o=.i.o)
PICOBJS=$(OBJS:.o=.pic.o)
all:: all-$(SHARED)
@ -30,6 +32,9 @@ ocamlrund$(EXE): libcamlrund.a prims.o
$(MKEXE) $(MKEXEDEBUGFLAG) $(BYTECCLINKOPTS) -o ocamlrund$(EXE) \
prims.o libcamlrund.a $(BYTECCLIBS)
ocamlruni$(EXE): prims.o libcamlruni.a
$(MKEXE) $(BYTECCLINKOPTS) -o $@ $^ $(BYTECCLIBS)
libcamlrun.a: $(OBJS)
$(ARCMD) rc libcamlrun.a $(OBJS)
$(RANLIB) libcamlrun.a
@ -38,6 +43,10 @@ libcamlrund.a: $(DOBJS)
$(ARCMD) rc libcamlrund.a $(DOBJS)
$(RANLIB) libcamlrund.a
libcamlruni.a: $(IOBJS)
$(ARCMD) rc $@ $^
$(RANLIB) $@
all-noshared:
.PHONY: all-noshared
@ -68,12 +77,18 @@ clean::
%.d.o: %.c
$(CC) -c $(DFLAGS) $< -o $@
%.i.o: %.c
$(CC) -c $(IFLAGS) -o $@ $<
%.pic.o: %.c
$(CC) -c $(CFLAGS) $(SHAREDCCCOMPOPTS) $< -o $@
depend : prims.c caml/opnames.h caml/jumptbl.h caml/version.h
-$(CC) -MM $(BYTECCCOMPOPTS) *.c > .depend
-$(CC) -MM $(BYTECCCOMPOPTS) -DDEBUG *.c | sed -e 's/\.o/.d.o/' >> .depend
-$(CC) -MM $(BYTECCCOMPOPTS) -DDEBUG *.c | sed -e 's/\.o/.d.o/' \
>> .depend
-$(CC) -MM $(BYTECCCOMPOPTS) -DCAML_INSTR *.c | sed -e 's/\.o/.i.o/' \
>> .depend
-$(CC) -MM $(BYTECCCOMPOPTS) *.c | sed -e 's/\.o/.pic.o/' >> .depend
.PHONY: depend

10
byterun/Makefile.common
View File

@ -48,6 +48,10 @@ all-noruntimed:
all-runtimed: ocamlrund$(EXE) libcamlrund.$(A)
.PHONY: all-runtimed
ifeq "$(RUNTIMEI)" "true"
all:: ocamlruni$(EXE) libcamlruni.$(A)
endif
ld.conf: ../config/Makefile
echo "$(STUBLIBDIR)" > ld.conf
echo "$(LIBDIR)" >> ld.conf
@ -84,6 +88,12 @@ install-runtimed:
cp libcamlrund.$(A) $(INSTALL_LIBDIR)/libcamlrund.$(A)
.PHONY: install-runtimed
ifeq "$(RUNTIMEI)" "true"
install::
cp ocamlruni$(EXE) $(INSTALL_BINDIR)/ocamlruni$(EXE)
cp libcamlruni.$(A) $(INSTALL_LIBDIR)/libcamlruni.$(A)
endif
# If primitives contain duplicated lines (e.g. because the code is defined
# like
# #ifdef X

9
byterun/array.c
View File

@ -18,6 +18,7 @@
#include "caml/memory.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"
#include "caml/signals.h"
/* returns number of elements (either fields or floats) */
CAMLexport mlsize_t caml_array_length(value array)
@ -181,12 +182,14 @@ CAMLprim value caml_make_vect(value len, value init)
}
} else {
if (size > Max_wosize) caml_invalid_argument("Array.make");
if (size < Max_young_wosize) {
if (size <= Max_young_wosize) {
res = caml_alloc_small(size, 0);
for (i = 0; i < size; i++) Field(res, i) = init;
}
else if (Is_block(init) && Is_young(init)) {
caml_minor_collection();
CAML_INSTR_INT ("force_minor/make_vect@", 1);
caml_request_minor_gc ();
caml_gc_dispatch ();
res = caml_alloc_shr(size, 0);
for (i = 0; i < size; i++) Field(res, i) = init;
res = caml_check_urgent_gc (res);
@ -324,7 +327,7 @@ static value caml_array_gather(intnat num_arrays,
/* Array of values, too big. */
caml_invalid_argument("Array.concat");
}
else if (size < Max_young_wosize) {
else if (size <= Max_young_wosize) {
/* Array of values, small enough to fit in young generation.
We can use memcpy directly. */
res = caml_alloc_small(size, 0);

6
byterun/caml/address_class.h
View File

@ -16,12 +16,18 @@
#ifndef CAML_ADDRESS_CLASS_H
#define CAML_ADDRESS_CLASS_H
#include "config.h"
#include "misc.h"
#include "mlvalues.h"
/* Use the following macros to test an address for the different classes
it might belong to. */
#define Is_in_heap(a) (Classify_addr(a) & In_heap)
#define Is_in_heap_or_young(a) (Classify_addr(a) & (In_heap | In_young))
#define Is_in_value_area(a) \
(Classify_addr(a) & (In_heap | In_young | In_static_data))
#define Is_young(val) \
(Assert (Is_block (val)), \
(addr)(val) < (addr)caml_young_end && (addr)(val) > (addr)caml_young_start)

10
byterun/caml/config.h
View File

@ -143,10 +143,11 @@ typedef uint64_t uintnat;
/* Maximum size of a block allocated in the young generation (words). */
/* Must be > 4 */
#define Max_young_wosize 256
#define Max_young_whsize (Whsize_wosize (Max_young_wosize))
/* Minimum size of the minor zone (words).
This must be at least [Max_young_wosize + 1]. */
This must be at least [2 * Max_young_whsize]. */
#define Minor_heap_min 4096
/* Maximum size of the minor zone (words).
@ -185,5 +186,12 @@ typedef uint64_t uintnat;
*/
#define Max_percent_free_def 500
/* Default setting for the major GC slice smoothing window: 1
(i.e. no smoothing)
*/
#define Major_window_def 1
/* Maximum size of the major GC slice smoothing window. */
#define Max_major_window 50
#endif /* CAML_CONFIG_H */

2
byterun/caml/gc_ctrl.h
View File

@ -32,7 +32,7 @@ extern intnat
uintnat caml_normalize_heap_increment (uintnat);
void caml_init_gc (uintnat, uintnat, uintnat,
uintnat, uintnat);
uintnat, uintnat, uintnat);
#ifdef DEBUG

1
byterun/caml/instrtrace.h
View File

@ -20,7 +20,6 @@
#include "mlvalues.h"
#include "misc.h"
extern int caml_trace_flag;
extern intnat caml_icount;
void caml_stop_here (void);
void caml_disasm_instr (code_t pc);

20
byterun/caml/major_gc.h
View File

@ -40,21 +40,29 @@ extern uintnat caml_fl_wsz_at_phase_change;
#define Phase_mark 0
#define Phase_sweep 1
#define Phase_idle 2
#define Subphase_main 10
#define Subphase_weak1 11
#define Subphase_weak2 12
#define Subphase_final 13
#define Subphase_roots 10
#define Subphase_main 11
#define Subphase_weak1 12
#define Subphase_weak2 13
#define Subphase_final 14
CAMLextern char *caml_heap_start;
extern uintnat total_heap_size;
extern char *caml_gc_sweep_hp;
extern int caml_major_window;
double caml_major_ring[Max_major_window];
int caml_major_ring_index;
double caml_major_work_credit;
extern double caml_gc_clock;
void caml_init_major_heap (asize_t); /* size in bytes */
asize_t caml_round_heap_chunk_wsz (asize_t);
asize_t caml_clip_heap_chunk_wsz (asize_t wsz);
void caml_darken (value, value *);
intnat caml_major_collection_slice (intnat);
void caml_major_collection_slice (intnat);
void major_collection (void);
void caml_finish_major_cycle (void);
void caml_set_major_window (int);
#endif /* CAML_MAJOR_GC_H */

30
byterun/caml/memory.h
View File

@ -44,15 +44,32 @@ CAMLextern value caml_check_urgent_gc (value);
CAMLextern void * caml_stat_alloc (asize_t); /* Size in bytes. */
CAMLextern void caml_stat_free (void *);
CAMLextern void * caml_stat_resize (void *, asize_t); /* Size in bytes. */
char *caml_alloc_for_heap (asize_t request); /* Size in bytes. */
void caml_free_for_heap (char *mem);
int caml_add_to_heap (char *mem);
color_t caml_allocation_color (void *hp);
CAMLextern int caml_init_alloc_for_heap (void);
CAMLextern char *caml_alloc_for_heap (asize_t request); /* Size in bytes. */
CAMLextern void caml_free_for_heap (char *mem);
CAMLextern int caml_add_to_heap (char *mem);
CAMLextern color_t caml_allocation_color (void *hp);
CAMLextern int caml_huge_fallback_count;
/* void caml_shrink_heap (char *); Only used in compact.c */
/* <private> */
extern uintnat caml_use_huge_pages;
#ifdef HAS_HUGE_PAGES
#include <sys/mman.h>
#define Heap_page_size HUGE_PAGE_SIZE
#define Round_mmap_size(x) \
(((x) + (Heap_page_size - 1)) & ~ (Heap_page_size - 1))
#endif
int caml_page_table_add(int kind, void * start, void * end);
int caml_page_table_remove(int kind, void * start, void * end);
int caml_page_table_initialize(mlsize_t bytesize);
#ifdef DEBUG
#define DEBUG_clear(result, wosize) do{ \
uintnat caml__DEBUG_i; \
@ -68,10 +85,11 @@ color_t caml_allocation_color (void *hp);
CAMLassert ((tag_t) (tag) < 256); \
CAMLassert ((wosize) <= Max_young_wosize); \
caml_young_ptr -= Whsize_wosize (wosize); \
if (caml_young_ptr < caml_young_start){ \
if (caml_young_ptr < caml_young_trigger){ \
caml_young_ptr += Whsize_wosize (wosize); \
CAML_INSTR_INT ("force_minor/alloc_small@", 1); \
Setup_for_gc; \
caml_minor_collection (); \
caml_gc_dispatch (); \
Restore_after_gc; \
caml_young_ptr -= Whsize_wosize (wosize); \
} \

17
byterun/caml/minor_gc.h
View File

@ -17,8 +17,10 @@
#include "address_class.h"
CAMLextern value *caml_young_start, *caml_young_ptr;
CAMLextern value *caml_young_end, *caml_young_limit;
CAMLextern value *caml_young_start, *caml_young_end;
CAMLextern value *caml_young_alloc_start, *caml_young_alloc_end;
CAMLextern value *caml_young_ptr, *caml_young_limit;
CAMLextern value *caml_young_trigger;
extern asize_t caml_minor_heap_wsz;
extern int caml_in_minor_collection;
@ -34,9 +36,18 @@ struct caml_ref_table {
CAMLextern struct caml_ref_table caml_ref_table, caml_weak_ref_table,
caml_finalize_table;
#define Add_to_ref_table(tbl, p) \
do { \
if ((tbl).ptr >= (tbl).limit){ \
Assert ((tbl).ptr == (tbl).limit); \
caml_realloc_ref_table (&(tbl)); \
} \
*(tbl).ptr++ = (p); \
} while(0)
extern void caml_set_minor_heap_size (asize_t); /* size in bytes */
extern void caml_empty_minor_heap (void);
CAMLextern void caml_minor_collection (void);
CAMLextern void caml_gc_dispatch (void);
CAMLextern void garbage_collection (void); /* def in asmrun/signals_asm.c */
extern void caml_realloc_ref_table (struct caml_ref_table *);
extern void caml_alloc_table (struct caml_ref_table *, asize_t, asize_t);

98
byterun/caml/misc.h
View File

@ -201,6 +201,104 @@ extern int caml_snprintf(char * buf, size_t size, const char * format, ...);
#define snprintf caml_snprintf
#endif
#ifdef CAML_INSTR
/* Timers and counters for GC latency profiling (Linux-only) */
#include <time.h>
#include <stdio.h>
extern intnat caml_stat_minor_collections;
extern intnat CAML_INSTR_STARTTIME, CAML_INSTR_STOPTIME;
struct CAML_INSTR_BLOCK {
struct timespec ts[10];
char *tag[10];
int index;
struct CAML_INSTR_BLOCK *next;
};
extern struct CAML_INSTR_BLOCK *CAML_INSTR_LOG;
/* Declare a timer/counter name. [t] must be a new variable name. */
#define CAML_INSTR_DECLARE(t) \
struct CAML_INSTR_BLOCK *t = NULL
/* Allocate the data block for a given name.
[t] must have been declared with [CAML_INSTR_DECLARE]. */
#define CAML_INSTR_ALLOC(t) do{ \
if (caml_stat_minor_collections >= CAML_INSTR_STARTTIME \
&& caml_stat_minor_collections < CAML_INSTR_STOPTIME){ \
t = malloc (sizeof (struct CAML_INSTR_BLOCK)); \
t->index = 0; \
t->tag[0] = ""; \
t->next = CAML_INSTR_LOG; \
CAML_INSTR_LOG = t; \
} \
}while(0)
/* Allocate the data block and start the timer.
[t] must have been declared with [CAML_INSTR_DECLARE]
and allocated with [CAML_INSTR_ALLOC]. */
#define CAML_INSTR_START(t, msg) do{ \
if (t != NULL){ \
t->tag[0] = msg; \
clock_gettime (CLOCK_REALTIME, &(t->ts[0])); \
} \
}while(0)
/* Declare a timer, allocate its data, and start it.
[t] must be a new variable name. */
#define CAML_INSTR_SETUP(t, msg) \
CAML_INSTR_DECLARE (t); \
CAML_INSTR_ALLOC (t); \
CAML_INSTR_START (t, msg)
/* Record an intermediate time within a given timer.
[t] must have been declared, allocated, and started. */
#define CAML_INSTR_TIME(t, msg) do{ \
if (t != NULL){ \
++ t->index; \
t->tag[t->index] = (msg); \
clock_gettime (CLOCK_REALTIME, &(t->ts[t->index])); \
} \
}while(0)
/* Record an integer data point.
If [msg] ends with # it will be interpreted as an integer-valued event.
If it ends with @ it will be interpreted as an event counter.
*/
#define CAML_INSTR_INT(msg, data) do{ \
CAML_INSTR_SETUP (__caml_tmp, ""); \
if (__caml_tmp != NULL){ \
__caml_tmp->index = 1; \
__caml_tmp->tag[1] = msg; \
__caml_tmp->ts[1].tv_sec = 0; \
__caml_tmp->ts[1].tv_nsec = (data); \
} \
}while(0)
/* This function is called at the start of the program to set up
the data for the above macros.
*/
extern void CAML_INSTR_INIT (void);
/* This function is automatically called by the runtime to output
the collected data to the dump file. */
extern void CAML_INSTR_ATEXIT (void);
#else /* CAML_INSTR */
#define CAML_INSTR_DECLARE(t) /**/
#define CAML_INSTR_ALLOC(t) /**/
#define CAML_INSTR_START(t, name) /**/
#define CAML_INSTR_SETUP(t, name) /**/
#define CAML_INSTR_TIME(t, msg) /**/
#define CAML_INSTR_INT(msg, c) /**/
#define CAML_INSTR_INIT() /**/
#define CAML_INSTR_ATEXIT() /**/
#endif /* CAML_INSTR */
/* </private> */
#ifdef __cplusplus

5
byterun/caml/mlvalues.h
View File

@ -217,7 +217,8 @@ CAMLextern value caml_hash_variant(char const * tag);
#define Byte_u(x, i) (((unsigned char *) (x)) [i]) /* Also an l-value. */
/* Abstract things. Their contents is not traced by the GC; therefore they
must not contain any [value].
must not contain any [value]. Must have odd number so that headers with
this tag cannot be mistaken for pointers (see caml_obj_truncate).
*/
#define Abstract_tag 251
@ -304,6 +305,4 @@ CAMLextern value caml_set_oo_id(value obj);
}
#endif
extern intnat caml_stat_top_heap_wsz;
#endif /* CAML_MLVALUES_H */

6
byterun/caml/roots.h
View File

@ -20,8 +20,10 @@
typedef void (*scanning_action) (value, value *);
void caml_oldify_local_roots (void);
void caml_darken_all_roots (void);
void caml_do_roots (scanning_action);
void caml_darken_all_roots_start (void);
intnat caml_darken_all_roots_slice (intnat);
void caml_do_roots (scanning_action, int);
extern uintnat caml_incremental_roots_count;
#ifndef NATIVE_CODE
CAMLextern void caml_do_local_roots (scanning_action, value *, value *,
struct caml__roots_block *);

6
byterun/caml/signals.h
View File

@ -28,14 +28,16 @@ extern "C" {
CAMLextern intnat volatile caml_signals_are_pending;
CAMLextern intnat volatile caml_pending_signals[];
CAMLextern int volatile caml_something_to_do;
extern int volatile caml_force_major_slice;
extern int volatile caml_requested_major_slice;
extern int volatile caml_requested_minor_gc;
/* </private> */
CAMLextern void caml_enter_blocking_section (void);
CAMLextern void caml_leave_blocking_section (void);
/* <private> */
void caml_urge_major_slice (void);
void caml_request_major_slice (void);
void caml_request_minor_gc (void);
CAMLextern int caml_convert_signal_number (int);
CAMLextern int caml_rev_convert_signal_number (int);
void caml_execute_signal(int signal_number, int in_signal_handler);

1
byterun/caml/startup_aux.h
View File

@ -21,6 +21,7 @@ extern uintnat caml_init_minor_heap_wsz;
extern uintnat caml_init_heap_chunk_sz;
extern uintnat caml_init_heap_wsz;
extern uintnat caml_init_max_stack_wsz;
extern uintnat caml_init_major_window;
extern uintnat caml_trace_level;
extern void caml_parse_ocamlrunparam (void);

25
byterun/compact.c
View File

@ -185,7 +185,7 @@ static void do_compaction (void)
/* Invert roots first because the threads library needs some heap
data structures to find its roots. Fortunately, it doesn't need
the headers (see above). */
caml_do_roots (invert_root);
caml_do_roots (invert_root, 1);
caml_final_do_weak_roots (invert_root);
ch = caml_heap_start;
@ -398,8 +398,14 @@ uintnat caml_percent_max; /* used in gc_ctrl.c and memory.c */
void caml_compact_heap (void)
{
uintnat target_wsz, live;
CAML_INSTR_SETUP(tmr, "compact");
CAMLassert (caml_young_ptr == caml_young_alloc_end);
CAMLassert (caml_ref_table.ptr == caml_ref_table.base);
CAMLassert (caml_weak_ref_table.ptr == caml_weak_ref_table.base);
do_compaction ();
CAML_INSTR_TIME (tmr, "compact/main");
/* Compaction may fail to shrink the heap to a reasonable size
because it deals in complete chunks: if a very large chunk
is at the beginning of the heap, everything gets moved to
@ -428,8 +434,14 @@ void caml_compact_heap (void)
live = caml_stat_heap_wsz - caml_fl_cur_wsz;
target_wsz = live + caml_percent_free * (live / 100 + 1)
+ Wsize_bsize (Page_size);
target_wsz = caml_round_heap_chunk_wsz (target_wsz);
target_wsz = caml_clip_heap_chunk_wsz (target_wsz);
#ifdef HAS_HUGE_PAGES
if (caml_use_huge_pages && caml_stat_heap_size <= HUGE_PAGE_SIZE) return;
#endif
if (target_wsz < caml_stat_heap_wsz / 2){
/* Recompact. */
char *chunk;
caml_gc_message (0x10, "Recompacting heap (target=%luk words)\n",
@ -456,6 +468,7 @@ void caml_compact_heap (void)
Assert (caml_stat_heap_chunks == 1);
Assert (Chunk_next (caml_heap_start) == NULL);
Assert (caml_stat_heap_wsz == Wsize_bsize (Chunk_size (chunk)));
CAML_INSTR_TIME (tmr, "compact/recompact");
}
}
@ -473,7 +486,11 @@ void caml_compact_heap_maybe (void)
Assert (caml_gc_phase == Phase_idle);
if (caml_percent_max >= 1000000) return;
if (caml_stat_major_collections < 3) return;
if (caml_stat_heap_wsz <= 2 * caml_round_heap_chunk_wsz (0)) return;
if (caml_stat_heap_wsz <= 2 * caml_clip_heap_chunk_wsz (0)) return;
#ifdef HAS_HUGE_PAGES
if (caml_use_huge_pages && caml_stat_heap_size <= HUGE_PAGE_SIZE) return;
#endif
fw = 3.0 * caml_fl_cur_wsz - 2.0 * caml_fl_wsz_at_phase_change;
if (fw < 0) fw = caml_fl_cur_wsz;
@ -492,9 +509,9 @@ void caml_compact_heap_maybe (void)
(uintnat) fp);
if (fp >= caml_percent_max){
caml_gc_message (0x200, "Automatic compaction triggered.\n", 0);
caml_empty_minor_heap (); /* minor heap must be empty for compaction */
caml_finish_major_cycle ();
/* We just did a complete GC, so we can measure the overhead exactly. */
fw = caml_fl_cur_wsz;
fp = 100.0 * fw / (caml_stat_heap_wsz - fw);
caml_gc_message (0x200, "Measured overhead: %"

54
byterun/finalise.c
View File

@ -61,14 +61,13 @@ static void alloc_to_do (int size)
/* Find white finalisable values, put them in the finalising set, and
darken them.
The recent set is empty.
*/
void caml_final_update (void)
{
uintnat i, j, k;
uintnat todo_count = 0;
Assert (young == old);
Assert (old <= young);
for (i = 0; i < old; i++){
Assert (Is_block (final_table[i].val));
Assert (Is_in_heap (final_table[i].val));
@ -79,35 +78,25 @@ void caml_final_update (void)
alloc_to_do (todo_count);
j = k = 0;
for (i = 0; i < old; i++){
again:
Assert (Is_block (final_table[i].val));
Assert (Is_in_heap (final_table[i].val));
Assert (Tag_val (final_table[i].val) != Forward_tag);
if (Is_white_val (final_table[i].val)){
if (Tag_val (final_table[i].val) == Forward_tag){
value fv;
Assert (final_table[i].offset == 0);
fv = Forward_val (final_table[i].val);
if (Is_block (fv)
&& (!Is_in_value_area(fv) || Tag_val (fv) == Forward_tag
|| Tag_val (fv) == Lazy_tag || Tag_val (fv) == Double_tag)){
/* Do not short-circuit the pointer. */
}else{
final_table[i].val = fv;
if (Is_block (final_table[i].val)
&& Is_in_heap (final_table[i].val)){
goto again;
}
}
}
to_do_tl->item[k++] = final_table[i];
}else{
final_table[j++] = final_table[i];
}
}
young = old = j;
CAMLassert (i == old);
old = j;
for(;i < young; i++){
final_table[j++] = final_table[i];
}
young = j;
to_do_tl->size = k;
for (i = 0; i < k; i++){
CAMLassert (Is_white_val (to_do_tl->item[i].val));
/* Note that item may alredy be dark due to multiple entries in
the final table. */
caml_darken (to_do_tl->item[i].val, NULL);
}
}
@ -124,7 +113,7 @@ void caml_final_do_calls (void)
value res;
if (running_finalisation_function) return;
if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) ();
if (to_do_hd != NULL){
if (caml_finalise_begin_hook != NULL) (*caml_finalise_begin_hook) ();
caml_gc_message (0x80, "Calling finalisation functions.\n", 0);
@ -147,6 +136,7 @@ void caml_final_do_calls (void)
caml_gc_message (0x80, "Done calling finalisation functions.\n", 0);
if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
}
if (caml_finalise_end_hook != NULL) (*caml_finalise_end_hook) ();
}
/* Call a scanning_action [f] on [x]. */
@ -154,17 +144,15 @@ void caml_final_do_calls (void)
/* Call [*f] on the closures of the finalisable set and
the closures and values of the finalising set.
The recent set is empty.
This is called by the major GC and the compactor
through [caml_darken_all_roots].
This is called by the major GC through [caml_darken_all_roots].
*/
void caml_final_do_strong_roots (scanning_action f)
{
uintnat i;
struct to_do *todo;
Assert (old == young);
for (i = 0; i < old; i++) Call_action (f, final_table[i].fun);
Assert (old <= young);
for (i = 0; i < young; i++) Call_action (f, final_table[i].fun);
for (todo = to_do_hd; todo != NULL; todo = todo->next){
for (i = 0; i < todo->size; i++){
@ -175,15 +163,14 @@ void caml_final_do_strong_roots (scanning_action f)
}
/* Call [*f] on the values of the finalisable set.
The recent set is empty.
This is called directly by the compactor.
*/
void caml_final_do_weak_roots (scanning_action f)
{
uintnat i;
Assert (old == young);
for (i = 0; i < old; i++) Call_action (f, final_table[i].val);
CAMLassert (old <= young);
for (i = 0; i < young; i++) Call_action (f, final_table[i].val);
}
/* Call [*f] on the closures and values of the recent set.
@ -213,9 +200,10 @@ void caml_final_empty_young (void)
CAMLprim value caml_final_register (value f, value v)
{
if (!Is_block (v)
|| !Is_in_heap_or_young(v)
|| Tag_val (v) == Lazy_tag
|| Tag_val (v) == Double_tag) {
|| !Is_in_heap_or_young(v)
|| Tag_val (v) == Lazy_tag
|| Tag_val (v) == Double_tag
|| Tag_val (v) == Forward_tag) {
caml_invalid_argument ("Gc.finalise");
}
Assert (old <= young);

52
byterun/freelist.c
View File

@ -148,6 +148,35 @@ static header_t *allocate_block (mlsize_t wh_sz, int flpi, value prev,
return (header_t *) &Field (cur, Wosize_hd (h) - wh_sz);
}
#ifdef CAML_INSTR
static uintnat instr_size [20] =
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};
static char *instr_name [20] = {
NULL,
"alloc01@",
"alloc02@",
"alloc03@",
"alloc04@",
"alloc05@",
"alloc06@",
"alloc07@",
"alloc08@",
"alloc09@",
"alloc10-19@",
"alloc20-29@",
"alloc30-39@",
"alloc40-49@",
"alloc50-59@",
"alloc60-69@",
"alloc70-79@",
"alloc80-89@",
"alloc90-99@",
"alloc_large@",
};
uintnat caml_instr_alloc_jump = 0;
/* number of pointers followed to allocate from the free list */
#endif /*CAML_INSTR*/
/* [caml_fl_allocate] does not set the header of the newly allocated block.
The calling function must do it before any GC function gets called.
[caml_fl_allocate] returns a head pointer.
@ -160,6 +189,16 @@ header_t *caml_fl_allocate (mlsize_t wo_sz)
mlsize_t sz, prevsz;
Assert (sizeof (char *) == sizeof (value));
Assert (wo_sz >= 1);
#ifdef CAML_INSTR
if (wo_sz < 10){
++instr_size[wo_sz];
}else if (wo_sz < 100){
++instr_size[wo_sz/10 + 9];
}else{
++instr_size[19];
}
#endif /* CAML_INSTR */
switch (policy){
case Policy_next_fit:
Assert (fl_prev != Val_NULL);
@ -172,6 +211,9 @@ header_t *caml_fl_allocate (mlsize_t wo_sz)
}
prev = cur;
cur = Next (prev);
#ifdef CAML_INSTR
++ caml_instr_alloc_jump;
#endif
}
fl_last = prev;
/* Search from the start of the list to [fl_prev]. */
@ -183,6 +225,9 @@ header_t *caml_fl_allocate (mlsize_t wo_sz)
}
prev = cur;
cur = Next (prev);
#ifdef CAML_INSTR
++ caml_instr_alloc_jump;
#endif
}
/* No suitable block was found. */
return NULL;
@ -347,6 +392,13 @@ static header_t *last_fragment;
void caml_fl_init_merge (void)
{
#ifdef CAML_INSTR
int i;
for (i = 1; i < 20; i++){
CAML_INSTR_INT (instr_name[i], instr_size[i]);
instr_size[i] = 0;
}
#endif /* CAML_INSTR */
last_fragment = NULL;
caml_fl_merge = Fl_head;
#ifdef DEBUG

151
byterun/gc_ctrl.c
View File

@ -12,21 +12,26 @@
/***********************************************************************/
#include "caml/alloc.h"
#include "caml/backtrace.h"
#include "caml/compact.h"
#include "caml/custom.h"
#include "caml/fail.h"
#include "caml/finalise.h"
#include "caml/freelist.h"
#include "caml/gc.h"
#include "caml/gc_ctrl.h"
#include "caml/major_gc.h"
#include "caml/memory.h"
#include "caml/minor_gc.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"
#include "caml/signals.h"
#ifdef NATIVE_CODE
#include "stack.h"
#else
#include "caml/stacks.h"
#endif
#include "caml/startup_aux.h"
#ifndef NATIVE_CODE
extern uintnat caml_max_stack_size; /* defined in stacks.c */
@ -214,7 +219,7 @@ static value heap_stats (int returnstats)
/* get a copy of these before allocating anything... */
double minwords = caml_stat_minor_words
+ (double) (caml_young_end - caml_young_ptr);
+ (double) (caml_young_alloc_end - caml_young_ptr);
double prowords = caml_stat_promoted_words;
double majwords = caml_stat_major_words + (double) caml_allocated_words;
intnat mincoll = caml_stat_minor_collections;
@ -255,8 +260,12 @@ void caml_heap_check (void)
CAMLprim value caml_gc_stat(value v)
{
value result;
CAML_INSTR_SETUP (tmr, "");
Assert (v == Val_unit);
return heap_stats (1);
result = heap_stats (1);
CAML_INSTR_TIME (tmr, "explicit/gc_stat");
return result;
}
CAMLprim value caml_gc_quick_stat(value v)
@ -266,7 +275,7 @@ CAMLprim value caml_gc_quick_stat(value v)
/* get a copy of these before allocating anything... */
double minwords = caml_stat_minor_words
+ (double) (caml_young_end - caml_young_ptr);
+ (double) (caml_young_alloc_end - caml_young_ptr);
double prowords = caml_stat_promoted_words;
double majwords = caml_stat_major_words + (double) caml_allocated_words;
intnat mincoll = caml_stat_minor_collections;
@ -303,7 +312,7 @@ CAMLprim value caml_gc_counters(value v)
/* get a copy of these before allocating anything... */
double minwords = caml_stat_minor_words
+ (double) (caml_young_end - caml_young_ptr);
+ (double) (caml_young_alloc_end - caml_young_ptr);
double prowords = caml_stat_promoted_words;
double majwords = caml_stat_major_words + (double) caml_allocated_words;
@ -314,12 +323,17 @@ CAMLprim value caml_gc_counters(value v)
CAMLreturn (res);
}
CAMLprim value caml_gc_huge_fallback_count (value v)
{
return Val_long (caml_huge_fallback_count);
}
CAMLprim value caml_gc_get(value v)
{
CAMLparam0 (); /* v is ignored */
CAMLlocal1 (res);
res = caml_alloc_tuple (7);
res = caml_alloc_tuple (8);
Store_field (res, 0, Val_long (caml_minor_heap_wsz)); /* s */
Store_field (res, 1, Val_long (caml_major_heap_increment)); /* i */
Store_field (res, 2, Val_long (caml_percent_free)); /* o */
@ -331,6 +345,7 @@ CAMLprim value caml_gc_get(value v)
Store_field (res, 5, Val_long (0));
#endif
Store_field (res, 6, Val_long (caml_allocation_policy)); /* a */
Store_field (res, 7, Val_long (caml_major_window)); /* w */
CAMLreturn (res);
}
@ -353,12 +368,20 @@ static intnat norm_minsize (intnat s)
return s;
}
static uintnat norm_window (intnat w)
{
if (w < 1) w = 1;
if (w > Max_major_window) w = Max_major_window;
return w;
}
CAMLprim value caml_gc_set(value v)
{
uintnat newpf, newpm;
asize_t newheapincr;
asize_t newminwsz;
uintnat oldpolicy;
CAML_INSTR_SETUP (tmr, "");
caml_verb_gc = Long_val (Field (v, 3));
@ -396,6 +419,15 @@ CAMLprim value caml_gc_set(value v)
caml_allocation_policy);
}
if (Wosize_val (v) >= 8){
int old_window = caml_major_window;
caml_set_major_window (norm_window (Long_val (Field (v, 7))));
if (old_window != caml_major_window){
caml_gc_message (0x20, "New smoothing window size: %d\n",
caml_major_window);
}
}
/* Minor heap size comes last because it will trigger a minor collection
(thus invalidating [v]) and it can raise [Out_of_memory]. */
newminwsz = norm_minsize (Long_val (Field (v, 0)));
@ -404,12 +436,17 @@ CAMLprim value caml_gc_set(value v)
newminwsz / 1024);
caml_set_minor_heap_size (Bsize_wsize (newminwsz));
}
CAML_INSTR_TIME (tmr, "explicit/gc_set");
return Val_unit;
}
CAMLprim value caml_gc_minor(value v)
{ Assert (v == Val_unit);
caml_minor_collection ();
{
CAML_INSTR_SETUP (tmr, "");
Assert (v == Val_unit);
caml_request_minor_gc ();
caml_gc_dispatch ();
CAML_INSTR_TIME (tmr, "explicit/gc_minor");
return Val_unit;
}
@ -429,17 +466,22 @@ static void test_and_compact (void)
}
CAMLprim value caml_gc_major(value v)
{ Assert (v == Val_unit);
{
CAML_INSTR_SETUP (tmr, "");
Assert (v == Val_unit);
caml_gc_message (0x1, "Major GC cycle requested\n", 0);
caml_empty_minor_heap ();
caml_finish_major_cycle ();
test_and_compact ();
caml_final_do_calls ();
CAML_INSTR_TIME (tmr, "explicit/gc_major");
return Val_unit;
}
CAMLprim value caml_gc_full_major(value v)
{ Assert (v == Val_unit);
{
CAML_INSTR_SETUP (tmr, "");
Assert (v == Val_unit);
caml_gc_message (0x1, "Full major GC cycle requested\n", 0);
caml_empty_minor_heap ();
caml_finish_major_cycle ();
@ -448,18 +490,24 @@ CAMLprim value caml_gc_full_major(value v)
caml_finish_major_cycle ();
test_and_compact ();
caml_final_do_calls ();
CAML_INSTR_TIME (tmr, "explicit/gc_full_major");
return Val_unit;
}
CAMLprim value caml_gc_major_slice (value v)
{
CAML_INSTR_SETUP (tmr, "");
Assert (Is_long (v));
caml_empty_minor_heap ();
return Val_long (caml_major_collection_slice (Long_val (v)));
caml_major_collection_slice (Long_val (v));
CAML_INSTR_TIME (tmr, "explicit/gc_major_slice");
return Val_long (0);
}
CAMLprim value caml_gc_compaction(value v)
{ Assert (v == Val_unit);
{
CAML_INSTR_SETUP (tmr, "");
Assert (v == Val_unit);
caml_gc_message (0x10, "Heap compaction requested\n", 0);
caml_empty_minor_heap ();
caml_finish_major_cycle ();
@ -468,9 +516,35 @@ CAMLprim value caml_gc_compaction(value v)
caml_finish_major_cycle ();
caml_compact_heap ();
caml_final_do_calls ();
CAML_INSTR_TIME (tmr, "explicit/gc_compact");
return Val_unit;
}
CAMLprim value caml_get_minor_free (value v)
{
return Val_int (caml_young_ptr - caml_young_alloc_start);
}
CAMLprim value caml_get_major_bucket (value v)
{
long i = Long_val (v);
if (i < 0) caml_invalid_argument ("Gc.get_bucket");
if (i < caml_major_window){
i += caml_major_ring_index;
if (i >= caml_major_window) i -= caml_major_window;
CAMLassert (0 <= i && i < caml_major_window);
return Val_long ((long) (caml_major_ring[i] * 1e6));
}else{
return Val_long (0);
}
}
CAMLprim value caml_get_major_credit (value v)
{
CAMLassert (v == Val_unit);
return Val_long ((long) (caml_major_work_credit * 1e6));
}
uintnat caml_normalize_heap_increment (uintnat i)
{
if (i < Bsize_wsize (Heap_chunk_min)){
@ -483,11 +557,15 @@ uintnat caml_normalize_heap_increment (uintnat i)
[major_incr] is either a percentage or a number of words */
void caml_init_gc (uintnat minor_size, uintnat major_size,
uintnat major_incr, uintnat percent_fr,
uintnat percent_m)
uintnat percent_m, uintnat window)
{
uintnat major_heap_size =
Bsize_wsize (caml_normalize_heap_increment (major_size));
CAML_INSTR_INIT ();
if (caml_init_alloc_for_heap () != 0){
caml_fatal_error ("cannot initialize heap: mmap failed\n");
}
if (caml_page_table_initialize(Bsize_wsize(minor_size) + major_heap_size)){
caml_fatal_error ("OCaml runtime error: cannot initialize page table\n");
}
@ -496,6 +574,7 @@ void caml_init_gc (uintnat minor_size, uintnat major_size,
caml_percent_free = norm_pfree (percent_fr);
caml_percent_max = norm_pmax (percent_m);
caml_init_major_heap (major_heap_size);
caml_major_window = norm_window (window);
caml_gc_message (0x20, "Initial minor heap size: %luk words\n",
caml_minor_heap_wsz / 1024);
caml_gc_message (0x20, "Initial major heap size: %luk bytes\n",
@ -511,6 +590,54 @@ void caml_init_gc (uintnat minor_size, uintnat major_size,
}
caml_gc_message (0x20, "Initial allocation policy: %d\n",
caml_allocation_policy);
caml_gc_message (0x20, "Initial smoothing window: %d\n",
caml_major_window);
}
/* FIXME After the startup_aux.c unification, move these functions there. */
CAMLprim value caml_runtime_variant (value unit)
{
CAMLassert (unit == Val_unit);
#if defined (DEBUG)
return caml_copy_string ("d");
#elif defined (CAML_INSTR)
return caml_copy_string ("i");
#elif defined (MMAP_INTERVAL)
return caml_copy_string ("m");
#else
return caml_copy_string ("");
#endif
}
extern int caml_parser_trace;
CAMLprim value caml_runtime_parameters (value unit)
{
CAMLassert (unit == Val_unit);
return caml_alloc_sprintf
("a=%d,b=%s,H=%lu,i=%lu,l=%lu,o=%lu,O=%lu,p=%d,s=%lu,t=%d,v=%lu,w=%d,W=%lu",
/* a */ caml_allocation_policy,
/* b */ caml_backtrace_active,
/* h */ /* missing */ /* FIXME add when changed to min_heap_size */
/* H */ caml_use_huge_pages,
/* i */ caml_major_heap_increment,
#ifdef NATIVE_CODE
/* l */ 0,
#else
/* l */ caml_max_stack_size,
#endif
/* o */ caml_percent_free,
/* O */ caml_percent_max,
/* p */ caml_parser_trace,
/* R */ /* missing */
/* s */ caml_minor_heap_wsz,
/* t */ caml_trace_level,
/* v */ caml_verb_gc,
/* w */ caml_major_window,
/* W */ caml_runtime_warnings
);
}
/* Control runtime warnings */

1
byterun/instrtrace.c
View File

@ -19,6 +19,7 @@
#include <string.h>
#include <ctype.h>
#include "caml/instrtrace.h"
#include "caml/instruct.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"

3
byterun/intern.c
View File

@ -618,8 +618,7 @@ static void intern_add_to_heap(mlsize_t whsize)
/* Add new heap chunk to heap if needed */
if (intern_extra_block != NULL) {
/* If heap chunk not filled totally, build free block at end */
asize_t request =
((Bsize_wsize(whsize) + Page_size - 1) >> Page_log) << Page_log;
asize_t request = Chunk_size (intern_extra_block);
header_t * end_extra_block =
(header_t *) intern_extra_block + Wsize_bsize(request);
Assert(intern_block == 0);

21
byterun/main.c
View File

@ -26,27 +26,6 @@ CAMLextern void caml_expand_command_line (int *, char ***);
int main(int argc, char **argv)
{
#ifdef DEBUG
caml_gc_message (-1, "### OCaml runtime: debug mode ###\n", 0);
#if 0
{
int i;
char *ocp;
char *cp;
caml_gc_message (-1, "### command line:", 0);
for (i = 0; i < argc; i++){
caml_gc_message (-1, " %s", argv[i]);
}
caml_gc_message (-1, "\n", 0);
ocp = getenv ("OCAMLRUNPARAM");
caml_gc_message (-1, "### OCAMLRUNPARAM=%s\n", ocp == NULL ? "" : ocp);
cp = getenv ("CAMLRUNPARAM");
caml_gc_message (-1, "### CAMLRUNPARAM=%s\n", cp == NULL ? "" : cp);
caml_gc_message (-1, "### working dir: %s\n", getcwd (NULL, 0));
}
#endif
#endif
#ifdef _WIN32
/* Expand wildcards and diversions in command line */
caml_expand_command_line(&argc, &argv);

356
byterun/major_gc.c
View File

@ -12,6 +12,7 @@
/***********************************************************************/
#include <limits.h>
#include <math.h>
#include "caml/compact.h"
#include "caml/custom.h"
@ -55,6 +56,12 @@ static char *markhp, *chunk, *limit;
int caml_gc_subphase; /* Subphase_{main,weak1,weak2,final} */
static value *weak_prev;
int caml_major_window = 1;
double caml_major_ring[Max_major_window] = { 0. };
int caml_major_ring_index = 0;
double caml_major_work_credit = 0.0;
double caml_gc_clock = 0.0;
#ifdef DEBUG
static unsigned long major_gc_counter = 0;
#endif
@ -91,7 +98,7 @@ static void realloc_gray_vals (void)
void caml_darken (value v, value *p /* not used */)
{
#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
if (Is_block (v) && Wosize_val (v) > 0) {
if (Is_block (v) && !Is_young (v) && Wosize_val (v) > 0) {
#else
if (Is_block (v) && Is_in_heap (v)) {
#endif
@ -129,9 +136,9 @@ static void start_cycle (void)
Assert (caml_gc_phase == Phase_idle);
Assert (gray_vals_cur == gray_vals);
caml_gc_message (0x01, "Starting new major GC cycle\n", 0);
caml_darken_all_roots();
caml_darken_all_roots_start ();
caml_gc_phase = Phase_mark;
caml_gc_subphase = Subphase_main;
caml_gc_subphase = Subphase_roots;
markhp = NULL;
#ifdef DEBUG
++ major_gc_counter;
@ -139,35 +146,65 @@ static void start_cycle (void)
#endif
}
/* We may stop the slice inside values, in order to avoid large latencies
on large arrays. In this case, [current_value] is the partially-marked
value and [current_index] is the index of the next field to be marked.
*/
static value current_value = 0;
static mlsize_t current_index = 0;
#ifdef CAML_INSTR
#define INSTR(x) x
#else
#define INSTR(x) /**/
#endif
static void mark_slice (intnat work)
{
value *gray_vals_ptr; /* Local copy of gray_vals_cur */
value *gray_vals_ptr; /* Local copy of [gray_vals_cur] */
value v, child;
header_t hd;
mlsize_t size, i;
header_t hd, chd;
mlsize_t size, i, start, end; /* [start] is a local copy of [current_index] */
#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
int marking_closure = 0;
#endif
#ifdef CAML_INSTR
int slice_fields = 0;
int slice_pointers = 0;
#endif
caml_gc_message (0x40, "Marking %ld words\n", work);
caml_gc_message (0x40, "Subphase = %ld\n", caml_gc_subphase);
gray_vals_ptr = gray_vals_cur;
v = current_value;
start = current_index;
while (work > 0){
if (gray_vals_ptr > gray_vals){
if (v == 0 && gray_vals_ptr > gray_vals){
CAMLassert (start == 0);
v = *--gray_vals_ptr;
CAMLassert (Is_gray_val (v));
}
if (v != 0){
hd = Hd_val(v);
#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
marking_closure =
(Tag_hd (hd) == Closure_tag || Tag_hd (hd) == Infix_tag);
#endif
Assert (Is_gray_hd (hd));
Hd_val (v) = Blackhd_hd (hd);
size = Wosize_hd (hd);
end = start + work;
if (Tag_hd (hd) < No_scan_tag){
for (i = 0; i < size; i++){
start = size < start ? size : start;
end = size < end ? size : end;
CAMLassert (end > start);
INSTR (slice_fields += end - start;)
INSTR (if (size > end)
CAML_INSTR_INT ("major/mark/slice/remain", size - end);)
for (i = start; i < end; i++){
child = Field (v, i);
#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
if (Is_block (child)
&& ! Is_young (child)
&& Wosize_val (child) > 0 /* Atoms never need to be marked. */
/* Closure blocks contain code pointers at offsets that cannot
be reliably determined, so we always use the page table when
@ -176,8 +213,9 @@ static void mark_slice (intnat work)
#else
if (Is_block (child) && Is_in_heap (child)) {
#endif
hd = Hd_val (child);
if (Tag_hd (hd) == Forward_tag){
INSTR (++ slice_pointers;)
chd = Hd_val (child);
if (Tag_hd (chd) == Forward_tag){
value f = Forward_val (child);
if (Is_block (f)
&& (!Is_in_value_area(f) || Tag_val (f) == Forward_tag
@ -185,18 +223,19 @@ static void mark_slice (intnat work)
/* Do not short-circuit the pointer. */
}else{
Field (v, i) = f;
if (Is_block (f) && Is_young (f) && !Is_young (child))
Add_to_ref_table (caml_ref_table, &Field (v, i));
}
}
else if (Tag_hd(hd) == Infix_tag) {
}else if (Tag_hd(chd) == Infix_tag) {
child -= Infix_offset_val(child);
hd = Hd_val(child);
chd = Hd_val(child);
}
#ifdef NATIVE_CODE_AND_NO_NAKED_POINTERS
/* See [caml_darken] for a description of this assertion. */
CAMLassert (Is_in_heap (child) || Is_black_hd (hd));
CAMLassert (Is_in_heap (child) || Is_black_hd (chd));
#endif
if (Is_white_hd (hd)){
Hd_val (child) = Grayhd_hd (hd);
if (Is_white_hd (chd)){
Hd_val (child) = Grayhd_hd (chd);
*gray_vals_ptr++ = child;
if (gray_vals_ptr >= gray_vals_end) {
gray_vals_cur = gray_vals_ptr;
@ -206,8 +245,25 @@ static void mark_slice (intnat work)
}
}
}
if (end < size){
work = 0;
start = end;
/* [v] doesn't change. */
CAMLassert (Is_gray_val (v));
}else{
CAMLassert (end == size);
Hd_val (v) = Blackhd_hd (hd);
work -= Whsize_wosize(end - start);
start = 0;
v = 0;
}
}else{
/* The block doesn't contain any pointers. */
CAMLassert (start == 0);
Hd_val (v) = Blackhd_hd (hd);
work -= Whsize_wosize(size);
v = 0;
}
work -= Whsize_wosize(size);
}else if (markhp != NULL){
if (markhp == limit){
chunk = Chunk_next (chunk);
@ -220,7 +276,8 @@ static void mark_slice (intnat work)
}else{
if (Is_gray_val (Val_hp (markhp))){
Assert (gray_vals_ptr == gray_vals);
*gray_vals_ptr++ = Val_hp (markhp);
CAMLassert (v == 0 && start == 0);
v = Val_hp (markhp);
}
markhp += Bhsize_hp (markhp);
}
@ -231,6 +288,17 @@ static void mark_slice (intnat work)
limit = chunk + Chunk_size (chunk);
}else{
switch (caml_gc_subphase){
case Subphase_roots: {
intnat work_done;
gray_vals_cur = gray_vals_ptr;
work_done = caml_darken_all_roots_slice (work);
gray_vals_ptr = gray_vals_cur;
if (work_done < work){
caml_gc_subphase = Subphase_main;
}
work -= work_done;
}
break;
case Subphase_main: {
/* The main marking phase is over. Start removing weak pointers to
dead values. */
@ -251,7 +319,7 @@ static void mark_slice (intnat work)
curfield = Field (cur, i);
weak_again:
if (curfield != caml_weak_none
&& Is_block (curfield) && Is_in_heap (curfield)){
&& Is_block (curfield) && Is_in_heap_or_young (curfield)){
if (Tag_val (curfield) == Forward_tag){
value f = Forward_val (curfield);
if (Is_block (f)) {
@ -260,11 +328,13 @@ static void mark_slice (intnat work)
/* Do not short-circuit the pointer. */
}else{
Field (cur, i) = curfield = f;
if (Is_block (f) && Is_young (f))
Add_to_ref_table (caml_weak_ref_table, &Field (cur, i));
goto weak_again;
}
}
}
if (Is_white_val (curfield)){
if (Is_white_val (curfield) && !Is_young (curfield)){
Field (cur, i) = caml_weak_none;
}
}
@ -277,6 +347,10 @@ static void mark_slice (intnat work)
gray_vals_cur = gray_vals_ptr;
caml_final_update ();
gray_vals_ptr = gray_vals_cur;
if (gray_vals_ptr > gray_vals){
v = *--gray_vals_ptr;
CAMLassert (start == 0);
}
caml_gc_subphase = Subphase_weak2;
weak_prev = &caml_weak_list_head;
}
@ -304,7 +378,6 @@ static void mark_slice (intnat work)
break;
case Subphase_final: {
/* Initialise the sweep phase. */
gray_vals_cur = gray_vals_ptr;
caml_gc_sweep_hp = caml_heap_start;
caml_fl_init_merge ();
caml_gc_phase = Phase_sweep;
@ -321,6 +394,10 @@ static void mark_slice (intnat work)
}
}
gray_vals_cur = gray_vals_ptr;
current_value = v;
current_index = start;
INSTR (CAML_INSTR_INT ("major/mark/slice/fields#", slice_fields);)
INSTR (CAML_INSTR_INT ("major/mark/slice/pointers#", slice_pointers);)
}
static void sweep_slice (intnat work)
@ -368,14 +445,37 @@ static void sweep_slice (intnat work)
}
}
/* The main entry point for the GC. Called after each minor GC.
[howmuch] is the amount of work to do, 0 to let the GC compute it.
Return the computed amount of work to do.
#ifdef CAML_INSTR
static char *mark_slice_name[] = {
/* 0 */ NULL,
/* 1 */ NULL,
/* 2 */ NULL,
/* 3 */ NULL,
/* 4 */ NULL,
/* 5 */ NULL,
/* 6 */ NULL,
/* 7 */ NULL,
/* 8 */ NULL,
/* 9 */ NULL,
/* 10 */ "major/mark_roots",
/* 11 */ "major/mark_main",
/* 12 */ "major/mark_weak1",
/* 13 */ "major/mark_weak2",
/* 14 */ "major/mark_final",
};
#endif
/* The main entry point for the major GC. Called about once for each
minor GC. [howmuch] is the amount of work to do:
-1 if the GC is triggered automatically
0 to let the GC compute the amount of work
[n] to make the GC do enough work to (on average) free [n] words
*/
intnat caml_major_collection_slice (intnat howmuch)
void caml_major_collection_slice (intnat howmuch)
{
double p, dp;
double p, dp, filt_p, spend;
intnat computed_work;
int i;
/*
Free memory at the start of the GC cycle (garbage + free list) (assumed):
FM = caml_stat_heap_wsz * caml_percent_free
@ -395,24 +495,37 @@ intnat caml_major_collection_slice (intnat howmuch)
PE = caml_extra_heap_resources
Proportion of total work to do in this slice:
P = max (PH, PE)
Here, we insert a time-based filter on the P variable to avoid large
latency spikes in the GC, so the P below is a smoothed-out version of
the P above.
Amount of marking work for the GC cycle:
MW = caml_stat_heap_wsz * 100 / (100 + caml_percent_free)
+ caml_incremental_roots_count
Amount of sweeping work for the GC cycle:
SW = caml_stat_heap_wsz
In order to finish marking with a non-empty free list, we will
use 40% of the time for marking, and 60% for sweeping.
If TW is the total work for this cycle,
MW = 40/100 * TW
SW = 60/100 * TW
Let MT be the time spent marking, ST the time spent sweeping, and TT
the total time for this cycle. We have:
MT = 40/100 * TT
ST = 60/100 * TT
Amount of work to do for this slice:
W = P * TW
Amount of time to spend on this slice:
T = P * TT = P * MT / (40/100) = P * ST / (60/100)
Since we must do MW work in MT time or SW work in ST time, the amount
of work for this slice is:
MS = P * MW / (40/100) if marking
SS = P * SW / (60/100) if sweeping
Amount of marking work for a marking slice:
MS = P * MW / (40/100)
MS = P * caml_stat_heap_wsz * 250 / (100 + caml_percent_free)
MS = P * (caml_stat_heap_wsz * 250 / (100 + caml_percent_free)
+ 2.5 * caml_incremental_roots_count)
Amount of sweeping work for a sweeping slice:
SS = P * SW / (60/100)
SS = P * caml_stat_heap_wsz * 5 / 3
@ -421,8 +534,7 @@ intnat caml_major_collection_slice (intnat howmuch)
*/
if (caml_major_slice_begin_hook != NULL) (*caml_major_slice_begin_hook) ();
if (caml_gc_phase == Phase_idle) start_cycle ();
CAML_INSTR_SETUP (tmr, "major");
p = (double) caml_allocated_words * 3.0 * (100 + caml_percent_free)
/ caml_stat_heap_wsz / caml_percent_free / 2.0;
@ -434,51 +546,134 @@ intnat caml_major_collection_slice (intnat howmuch)
}
if (p < dp) p = dp;
if (p < caml_extra_heap_resources) p = caml_extra_heap_resources;
if (p > 0.3) p = 0.3;
CAML_INSTR_INT ("major/work/extra#",
(uintnat) (caml_extra_heap_resources * 1000000));
caml_gc_message (0x40, "ordered work = %ld words\n", howmuch);
caml_gc_message (0x40, "allocated_words = %"
ARCH_INTNAT_PRINTF_FORMAT "u\n",
caml_allocated_words);
caml_gc_message (0x40, "extra_heap_resources = %"
ARCH_INTNAT_PRINTF_FORMAT "uu\n",
(uintnat) (caml_extra_heap_resources * 1000000));
caml_gc_message (0x40, "amount of work to do = %"
ARCH_INTNAT_PRINTF_FORMAT "uu\n",
(uintnat) (p * 1000000));
caml_gc_message (0x40, "raw work-to-do = %"
ARCH_INTNAT_PRINTF_FORMAT "du\n",
(intnat) (p * 1000000));
for (i = 0; i < caml_major_window; i++){
caml_major_ring[i] += p / caml_major_window;
}
if (caml_gc_clock >= 1.0){
caml_gc_clock -= 1.0;
++caml_major_ring_index;
if (caml_major_ring_index >= caml_major_window){
caml_major_ring_index = 0;
}
}
if (howmuch == -1){
/* auto-triggered GC slice: spend work credit on the current bucket,
then do the remaining work, if any */
/* Note that the minor GC guarantees that the major slice is called in
automatic mode (with [howmuch] = -1) at least once per clock tick.
This means we never leave a non-empty bucket behind. */
spend = fmin (caml_major_work_credit,
caml_major_ring[caml_major_ring_index]);
caml_major_work_credit -= spend;
filt_p = caml_major_ring[caml_major_ring_index] - spend;
caml_major_ring[caml_major_ring_index] = 0.0;
}else{
/* forced GC slice: do work and add it to the credit */
if (howmuch == 0){
/* automatic setting: size of next bucket
we do not use the current bucket, as it may be empty */
int i = caml_major_ring_index + 1;
if (i >= caml_major_window) i = 0;
filt_p = caml_major_ring[i];
}else{
/* manual setting */
filt_p = (double) howmuch * 3.0 * (100 + caml_percent_free)
/ caml_stat_heap_wsz / caml_percent_free / 2.0;
}
caml_major_work_credit += filt_p;
}
p = filt_p;
caml_gc_message (0x40, "filtered work-to-do = %"
ARCH_INTNAT_PRINTF_FORMAT "du\n",
(intnat) (p * 1000000));
if (caml_gc_phase == Phase_idle){
start_cycle ();
CAML_INSTR_TIME (tmr, "major/roots");
p = 0;
goto finished;
}
if (p < 0){
p = 0;
goto finished;
}
if (caml_gc_phase == Phase_mark){
computed_work = (intnat) (p * caml_stat_heap_wsz * 250
/ (100 + caml_percent_free));
computed_work = (intnat) (p * (caml_stat_heap_wsz * 250
/ (100 + caml_percent_free)
+ caml_incremental_roots_count));
}else{
computed_work = (intnat) (p * caml_stat_heap_wsz * 5 / 3);
}
caml_gc_message (0x40, "ordered work = %ld words\n", howmuch);
caml_gc_message (0x40, "computed work = %ld words\n", computed_work);
if (howmuch == 0) howmuch = computed_work;
if (caml_gc_phase == Phase_mark){
mark_slice (howmuch);
CAML_INSTR_INT ("major/work/mark#", computed_work);
mark_slice (computed_work);
CAML_INSTR_TIME (tmr, mark_slice_name[caml_gc_subphase]);
caml_gc_message (0x02, "!", 0);
/*
remaining_p = remaining_work / (Wsize_bsize (caml_stat_heap_size) * 250
/ (100 + caml_percent_free)
+ caml_incremental_roots_count);
*/
}else{
Assert (caml_gc_phase == Phase_sweep);
sweep_slice (howmuch);
CAML_INSTR_INT ("major/work/sweep#", computed_work);
sweep_slice (computed_work);
CAML_INSTR_TIME (tmr, "major/sweep");
caml_gc_message (0x02, "$", 0);
}
if (caml_gc_phase == Phase_idle) caml_compact_heap_maybe ();
if (caml_gc_phase == Phase_idle){
caml_compact_heap_maybe ();
CAML_INSTR_TIME (tmr, "major/check_and_compact");
}
finished:
caml_gc_message (0x40, "work-done = %"
ARCH_INTNAT_PRINTF_FORMAT "du\n",
(intnat) (p * 1000000));
/* if some of the work was not done, take it back from the credit
or spread it over the buckets. */
p = filt_p - p;
spend = fmin (p, caml_major_work_credit);
caml_major_work_credit -= spend;
if (p > spend){
p -= spend;
p /= caml_major_window;
for (i = 0; i < caml_major_window; i++) caml_major_ring[i] += p;
}
caml_stat_major_words += caml_allocated_words;
caml_allocated_words = 0;
caml_dependent_allocated = 0;
caml_extra_heap_resources = 0.0;
if (caml_major_slice_end_hook != NULL) (*caml_major_slice_end_hook) ();
return computed_work;
}
/* The minor heap must be empty when this function is called;
the minor heap is empty when this function returns.
*/
/* This does not call caml_compact_heap_maybe because the estimations of
/* This does not call [caml_compact_heap_maybe] because the estimates of
free and live memory are only valid for a cycle done incrementally.
Besides, this function is called by caml_compact_heap_maybe.
Besides, this function itself is called by [caml_compact_heap_maybe].
*/
void caml_finish_major_cycle (void)
{
@ -491,27 +686,12 @@ void caml_finish_major_cycle (void)
caml_allocated_words = 0;
}
/* Make sure the request is at least Heap_chunk_min and round it up
to a multiple of the page size.
The argument and result are both numbers of words.
/* Call this function to make sure [bsz] is greater than or equal
to both [Heap_chunk_min] and the current heap increment.
*/
static asize_t clip_heap_chunk_size (asize_t request)
asize_t caml_clip_heap_chunk_wsz (asize_t wsz)
{
if (request < Heap_chunk_min){
request = Heap_chunk_min;
}
return
Wsize_bsize (((Bsize_wsize (request) + Page_size - 1)
>> Page_log) << Page_log);
}
/* Compute the heap increment, make sure the request is at least that big,
then call clip_heap_chunk_size, then make sure the result is >= request.
The argument and result are both numbers of words.
*/
asize_t caml_round_heap_chunk_wsz (asize_t request)
{
asize_t result = request;
asize_t result = wsz;
uintnat incr;
/* Compute the heap increment as a word size. */
@ -524,11 +704,8 @@ asize_t caml_round_heap_chunk_wsz (asize_t request)
if (result < incr){
result = incr;
}
result = clip_heap_chunk_size (result);
if (result < request){
caml_raise_out_of_memory ();
return 0; /* not reached */
if (result < Heap_chunk_min){
result = Heap_chunk_min;
}
return result;
}
@ -536,21 +713,25 @@ asize_t caml_round_heap_chunk_wsz (asize_t request)
/* [heap_size] is a number of bytes */
void caml_init_major_heap (asize_t heap_size)
{
caml_stat_heap_wsz = Wsize_bsize (clip_heap_chunk_size (heap_size));
int i;
caml_stat_heap_wsz = caml_clip_heap_chunk_wsz (Wsize_bsize (heap_size));
caml_stat_top_heap_wsz = caml_stat_heap_wsz;
Assert (Bsize_wsize (caml_stat_heap_wsz) % Page_size == 0);
caml_heap_start =
(char *) caml_alloc_for_heap (Bsize_wsize (caml_stat_heap_wsz));
if (caml_heap_start == NULL)
caml_fatal_error ("Fatal error: not enough memory for the initial heap.\n");
caml_fatal_error ("Fatal error: cannot allocate initial major heap.\n");
Chunk_next (caml_heap_start) = NULL;
caml_stat_heap_wsz = Wsize_bsize (Chunk_size (caml_heap_start));
caml_stat_heap_chunks = 1;
caml_stat_top_heap_wsz = caml_stat_heap_wsz;
if (caml_page_table_add(In_heap, caml_heap_start,
caml_heap_start + Bsize_wsize (caml_stat_heap_wsz))
!= 0) {
caml_fatal_error ("Fatal error: not enough memory "
"for the initial page table.\n");
caml_fatal_error ("Fatal error: cannot allocate "
"initial page table.\n");
}
caml_fl_init_merge ();
@ -566,4 +747,21 @@ void caml_init_major_heap (asize_t heap_size)
heap_is_pure = 1;
caml_allocated_words = 0;
caml_extra_heap_resources = 0.0;
for (i = 0; i < Max_major_window; i++) caml_major_ring[i] = 0.0;
}
void caml_set_major_window (int w){
uintnat total = 0;
int i;
if (w == caml_major_window) return;
CAMLassert (w <= Max_major_window);
/* Collect the current work-to-do from the buckets. */
for (i = 0; i < caml_major_window; i++){
total += caml_major_ring[i];
}
/* Redistribute to the new buckets. */
for (i = 0; i < w; i++){
caml_major_ring[i] = total / w;
}
caml_major_window = w;
}

111
byterun/memory.c
View File

@ -30,6 +30,18 @@
#define inline _inline
#endif
int caml_huge_fallback_count = 0;
/* Number of times that mmapping big pages fails and we fell back to small
pages. This counter is available to the program through
[Gc.huge_fallback_count].
*/
uintnat caml_use_huge_pages = 0;
/* True iff the program allocates heap chunks by mmapping huge pages.
This is set when parsing [OCAMLRUNPARAM] and must stay constant
after that.
*/
extern uintnat caml_percent_free; /* major_gc.c */
/* Page table management */
@ -221,25 +233,56 @@ int caml_page_table_remove(int kind, void * start, void * end)
return 0;
}
/* Initialize the [alloc_for_heap] system.
This function must be called exactly once, and it must be called
before the first call to [alloc_for_heap].
It returns 0 on success and -1 on failure.
*/
int caml_init_alloc_for_heap (void)
{
return 0;
}
/* Allocate a block of the requested size, to be passed to
[caml_add_to_heap] later.
[request] must be a multiple of [Page_size], it is a number of bytes.
[caml_alloc_for_heap] returns NULL if the request cannot be satisfied.
The returned pointer is a hp, but the header must be initialized by
the caller.
[request] will be rounded up to some implementation-dependent size.
The caller must use [Chunk_size] on the result to recover the actual
size.
Return NULL if the request cannot be satisfied. The returned pointer
is a hp, but the header (and the contents) must be initialized by the
caller.
*/
char *caml_alloc_for_heap (asize_t request)
{
char *mem;
void *block;
Assert (request % Page_size == 0);
mem = caml_aligned_malloc (request + sizeof (heap_chunk_head),
sizeof (heap_chunk_head), &block);
if (mem == NULL) return NULL;
mem += sizeof (heap_chunk_head);
Chunk_size (mem) = request;
Chunk_block (mem) = block;
return mem;
if (caml_use_huge_pages){
#ifdef HAS_HUGE_PAGES
uintnat size = Round_mmap_size (sizeof (heap_chunk_head) + request);
void *block;
char *mem;
block = mmap (NULL, size, PROT_READ | PROT_WRITE,
MAP_PRIVATE | MAP_ANONYMOUS | MAP_HUGETLB, -1, 0);
if (block == MAP_FAILED) return NULL;
mem = (char *) block + sizeof (heap_chunk_head);
Chunk_size (mem) = size - sizeof (heap_chunk_head);
Chunk_block (mem) = block;
return mem;
#else
return NULL;
#endif
}else{
char *mem;
void *block;
request = ((request + Page_size - 1) >> Page_log) << Page_log;
mem = caml_aligned_malloc (request + sizeof (heap_chunk_head),
sizeof (heap_chunk_head), &block);
if (mem == NULL) return NULL;
mem += sizeof (heap_chunk_head);
Chunk_size (mem) = request;
Chunk_block (mem) = block;
return mem;
}
}
/* Use this function to free a block allocated with [caml_alloc_for_heap]
@ -247,7 +290,15 @@ char *caml_alloc_for_heap (asize_t request)
*/
void caml_free_for_heap (char *mem)
{
free (Chunk_block (mem));
if (caml_use_huge_pages){
#ifdef HAS_HUGE_PAGES
munmap (Chunk_block (mem), Chunk_size (mem) + sizeof (heap_chunk_head));
#else
CAMLassert (0);
#endif
}else{
free (Chunk_block (mem));
}
}
/* Take a chunk of memory as argument, which must be the result of a
@ -263,10 +314,9 @@ void caml_free_for_heap (char *mem)
*/
int caml_add_to_heap (char *m)
{
Assert (Chunk_size (m) % Page_size == 0);
#ifdef DEBUG
/* Should check the contents of the block. */
#endif /* debug */
#endif /* DEBUG */
caml_gc_message (0x04, "Growing heap to %luk bytes\n",
(Bsize_wsize (caml_stat_heap_wsz) + Chunk_size (m)) / 1024);
@ -314,14 +364,14 @@ static value *expand_heap (mlsize_t request)
asize_t over_request, malloc_request, remain;
Assert (request <= Max_wosize);
over_request = Whsize_wosize (request + request / 100 * caml_percent_free);
malloc_request = caml_round_heap_chunk_wsz (over_request);
over_request = request + request / 100 * caml_percent_free;
malloc_request = caml_clip_heap_chunk_wsz (over_request);
mem = (value *) caml_alloc_for_heap (Bsize_wsize (malloc_request));
if (mem == NULL){
caml_gc_message (0x04, "No room for growing heap\n", 0);
return NULL;
}
remain = malloc_request;
remain = Wsize_bsize (Chunk_size (mem));
prev = hp = mem;
/* FIXME find a way to do this with a call to caml_make_free_blocks */
while (Wosize_whsize (remain) > Max_wosize){
@ -451,7 +501,8 @@ static inline value caml_alloc_shr_aux (mlsize_t wosize, tag_t tag,
Assert (Hd_hp (hp) == Make_header (wosize, tag, caml_allocation_color (hp)));
caml_allocated_words += Whsize_wosize (wosize);
if (caml_allocated_words > caml_minor_heap_wsz){
caml_urge_major_slice ();
CAML_INSTR_INT ("request_major/alloc_shr@", 1);
caml_request_major_slice ();
}
#ifdef DEBUG
{
@ -512,13 +563,15 @@ CAMLexport void caml_adjust_gc_speed (mlsize_t res, mlsize_t max)
if (res > max) res = max;
caml_extra_heap_resources += (double) res / (double) max;
if (caml_extra_heap_resources > 1.0){
CAML_INSTR_INT ("request_major/adjust_gc_speed_1@", 1);
caml_extra_heap_resources = 1.0;
caml_urge_major_slice ();
caml_request_major_slice ();
}
if (caml_extra_heap_resources
> (double) caml_minor_heap_wsz / 2.0
/ (double) caml_stat_heap_wsz) {
caml_urge_major_slice ();
CAML_INSTR_INT ("request_major/adjust_gc_speed_2@", 1);
caml_request_major_slice ();
}
}
@ -535,10 +588,7 @@ CAMLexport CAMLweakdef void caml_initialize (value *fp, value val)
CAMLassert(Is_in_heap(fp));
*fp = val;
if (Is_block (val) && Is_young (val)) {
if (caml_ref_table.ptr >= caml_ref_table.limit){
caml_realloc_ref_table (&caml_ref_table);
}
*caml_ref_table.ptr++ = fp;
Add_to_ref_table (caml_ref_table, fp);
}
}
@ -586,12 +636,7 @@ CAMLexport CAMLweakdef void caml_modify (value *fp, value val)
}
/* Check for condition 1. */
if (Is_block(val) && Is_young(val)) {
/* Add [fp] to remembered set */
if (caml_ref_table.ptr >= caml_ref_table.limit){
CAMLassert (caml_ref_table.ptr == caml_ref_table.limit);
caml_realloc_ref_table (&caml_ref_table);
}
*caml_ref_table.ptr++ = fp;
Add_to_ref_table (caml_ref_table, fp);
}
}
}

199
byterun/minor_gc.c
View File

@ -27,10 +27,36 @@
#include "caml/signals.h"
#include "caml/weak.h"
/* Pointers into the minor heap.
[caml_young_base]
The [malloc] block that contains the heap.
[caml_young_start] ... [caml_young_end]
The whole range of the minor heap: all young blocks are inside
this interval.
[caml_young_alloc_start]...[caml_young_alloc_end]
The allocation arena: newly-allocated blocks are carved from
this interval.
[caml_young_alloc_mid] is the mid-point of this interval.
[caml_young_ptr], [caml_young_trigger], [caml_young_limit]
These pointers are all inside the allocation arena.
- [caml_young_ptr] is where the next allocation will take place.
- [caml_young_trigger] is how far we can allocate before triggering
[caml_gc_dispatch]. Currently, it is either [caml_young_alloc_start]
or the mid-point of the allocation arena.
- [caml_young_limit] is the pointer that is compared to
[caml_young_ptr] for allocation. It is either
[caml_young_alloc_end] if a signal is pending and we are in
native code, or [caml_young_trigger].
*/
asize_t caml_minor_heap_wsz;
static void *caml_young_base = NULL;
CAMLexport value *caml_young_start = NULL, *caml_young_end = NULL;
CAMLexport value *caml_young_alloc_start = NULL,
*caml_young_alloc_mid = NULL,
*caml_young_alloc_end = NULL;
CAMLexport value *caml_young_ptr = NULL, *caml_young_limit = NULL;
CAMLexport value *caml_young_trigger = NULL;
CAMLexport struct caml_ref_table
caml_ref_table = { NULL, NULL, NULL, NULL, NULL, 0, 0},
@ -40,10 +66,6 @@ CAMLexport struct caml_ref_table
int caml_in_minor_collection = 0;
#ifdef DEBUG
static unsigned long minor_gc_counter = 0;
#endif
/* [sz] and [rsv] are numbers of entries */
void caml_alloc_table (struct caml_ref_table *tbl, asize_t sz, asize_t rsv)
{
@ -75,32 +97,73 @@ static void clear_table (struct caml_ref_table *tbl)
tbl->limit = tbl->threshold;
}
/* [size] is a number of bytes */
void caml_set_minor_heap_size (asize_t size)
void caml_set_minor_heap_size (asize_t bsz)
{
char *new_heap;
void *new_heap_base;
Assert (size >= Bsize_wsize(Minor_heap_min));
Assert (size <= Bsize_wsize(Minor_heap_max));
Assert (size % sizeof (value) == 0);
if (caml_young_ptr != caml_young_end) caml_minor_collection ();
Assert (caml_young_ptr == caml_young_end);
new_heap = caml_aligned_malloc(size, 0, &new_heap_base);
Assert (bsz >= Bsize_wsize(Minor_heap_min));
Assert (bsz <= Bsize_wsize(Minor_heap_max));
Assert (bsz % sizeof (value) == 0);
if (caml_young_ptr != caml_young_alloc_end){
CAML_INSTR_INT ("force_minor/set_minor_heap_size@", 1);
caml_requested_minor_gc = 0;
caml_young_trigger = caml_young_alloc_mid;
caml_young_limit = caml_young_trigger;
caml_empty_minor_heap ();
}
CAMLassert (caml_young_ptr == caml_young_alloc_end);
#ifdef MMAP_INTERVAL
{
static uintnat minor_heap_mapped_bsz = 0;
uintnat new_mapped_bsz;
new_mapped_bsz = Round_mmap_size (bsz);
void *block;
CAMLassert (caml_young_start != NULL);
if (new_mapped_bsz > minor_heap_mapped_bsz){
uintnat addbsz = new_mapped_bsz - minor_heap_mapped_bsz;
new_heap = (char *) caml_young_start - addbsz;
block = caml_mmap_heap (new_heap, addbsz, PROT_READ | PROT_WRITE,
MAP_FIXED);
if (block != new_heap){
if (minor_heap_mapped_bsz == 0){
caml_fatal_error ("cannot initialize minor heap: mmap failed\n");
}else{
caml_raise_out_of_memory ();
}
}
new_heap_base = new_heap;
}else if (new_mapped_bsz < minor_heap_mapped_bsz){
uintnat subbsz = minor_heap_mapped_bsz - new_mapped_bsz;
(void) caml_mmap_heap (caml_young_start, subbsz, PROT_NONE,
MAP_FIXED | MAP_NORESERVE);
new_heap_base = new_heap = (char *) caml_young_start + subbsz;
}else{
new_heap_base = new_heap = caml_young_base;
}
}
#else
new_heap = caml_aligned_malloc(bsz, 0, &new_heap_base);
if (new_heap == NULL) caml_raise_out_of_memory();
if (caml_page_table_add(In_young, new_heap, new_heap + size) != 0)
if (caml_page_table_add(In_young, new_heap, new_heap + bsz) != 0)
caml_raise_out_of_memory();
if (caml_young_start != NULL){
caml_page_table_remove(In_young, caml_young_start, caml_young_end);
free (caml_young_base);
}
#endif
caml_young_base = new_heap_base;
caml_young_start = (value *) new_heap;
caml_young_end = (value *) (new_heap + size);
caml_young_limit = caml_young_start;
caml_young_ptr = caml_young_end;
caml_minor_heap_wsz = Wsize_bsize (size);
caml_young_end = (value *) (new_heap + bsz);
caml_young_alloc_start = caml_young_start;
caml_young_alloc_mid = caml_young_alloc_start + Wsize_bsize (bsz) / 2;
caml_young_alloc_end = caml_young_end;
caml_young_trigger = caml_young_alloc_start;
caml_young_limit = caml_young_trigger;
caml_young_ptr = caml_young_alloc_end;
caml_minor_heap_wsz = Wsize_bsize (bsz);
reset_table (&caml_ref_table);
reset_table (&caml_weak_ref_table);
@ -232,16 +295,20 @@ void caml_empty_minor_heap (void)
value **r;
uintnat prev_alloc_words;
if (caml_young_ptr != caml_young_end){
if (caml_young_ptr != caml_young_alloc_end){
if (caml_minor_gc_begin_hook != NULL) (*caml_minor_gc_begin_hook) ();
CAML_INSTR_SETUP (tmr, "minor");
prev_alloc_words = caml_allocated_words;
caml_in_minor_collection = 1;
caml_gc_message (0x02, "<", 0);
caml_oldify_local_roots();
CAML_INSTR_TIME (tmr, "minor/local_roots");
for (r = caml_ref_table.base; r < caml_ref_table.ptr; r++){
caml_oldify_one (**r, *r);
}
CAML_INSTR_TIME (tmr, "minor/ref_table");
caml_oldify_mopup ();
CAML_INSTR_TIME (tmr, "minor/copy");
for (r = caml_weak_ref_table.base; r < caml_weak_ref_table.ptr; r++){
if (Is_block (**r) && Is_young (**r)){
if (Hd_val (**r) == 0){
@ -258,18 +325,22 @@ void caml_empty_minor_heap (void)
final_fun((value)*r);
}
}
if (caml_young_ptr < caml_young_start) caml_young_ptr = caml_young_start;
caml_stat_minor_words += caml_young_end - caml_young_ptr;
caml_young_ptr = caml_young_end;
caml_young_limit = caml_young_start;
CAML_INSTR_TIME (tmr, "minor/update_weak");
CAMLassert (caml_young_ptr >= caml_young_alloc_start);
caml_stat_minor_words += caml_young_alloc_end - caml_young_ptr;
caml_gc_clock += (double) (caml_young_alloc_end - caml_young_ptr)
/ caml_minor_heap_wsz;
caml_young_ptr = caml_young_alloc_end;
clear_table (&caml_ref_table);
clear_table (&caml_weak_ref_table);
clear_table (&caml_finalize_table);
caml_gc_message (0x02, ">", 0);
caml_in_minor_collection = 0;
caml_stat_promoted_words += caml_allocated_words - prev_alloc_words;
++ caml_stat_minor_collections;
caml_final_empty_young ();
CAML_INSTR_TIME (tmr, "minor/finalized");
caml_stat_promoted_words += caml_allocated_words - prev_alloc_words;
CAML_INSTR_INT ("minor/promoted#", caml_allocated_words - prev_alloc_words);
++ caml_stat_minor_collections;
if (caml_minor_gc_end_hook != NULL) (*caml_minor_gc_end_hook) ();
}else{
caml_final_empty_young ();
@ -277,34 +348,81 @@ void caml_empty_minor_heap (void)
#ifdef DEBUG
{
value *p;
for (p = caml_young_start; p < caml_young_end; ++p){
for (p = caml_young_alloc_start; p < caml_young_alloc_end; ++p){
*p = Debug_free_minor;
}
++ minor_gc_counter;
}
#endif
}
/* Do a minor collection and a slice of major collection, call finalisation
#ifdef CAML_INSTR
extern uintnat caml_instr_alloc_jump;
#endif
/* Do a minor collection or a slice of major collection, call finalisation
functions, etc.
Leave the minor heap empty.
Leave enough room in the minor heap to allocate at least one object.
*/
CAMLexport void caml_gc_dispatch (void)
{
value *trigger = caml_young_trigger; /* save old value of trigger */
#ifdef CAML_INSTR
CAML_INSTR_SETUP(tmr, "dispatch");
CAML_INSTR_TIME (tmr, "overhead");
CAML_INSTR_INT ("alloc/jump#", caml_instr_alloc_jump);
caml_instr_alloc_jump = 0;
#endif
if (trigger == caml_young_alloc_start || caml_requested_minor_gc){
/* The minor heap is full, we must do a minor collection. */
/* reset the pointers first because the end hooks might allocate */
caml_requested_minor_gc = 0;
caml_young_trigger = caml_young_alloc_mid;
caml_young_limit = caml_young_trigger;
caml_empty_minor_heap ();
if (caml_gc_phase == Phase_idle) caml_major_collection_slice (-1);
CAML_INSTR_TIME (tmr, "dispatch/minor");
caml_final_do_calls ();
CAML_INSTR_TIME (tmr, "dispatch/finalizers");
while (caml_young_ptr - caml_young_alloc_start < Max_young_whsize){
/* The finalizers or the hooks have filled up the minor heap, we must
repeat the minor collection. */
caml_requested_minor_gc = 0;
caml_young_trigger = caml_young_alloc_mid;
caml_young_limit = caml_young_trigger;
caml_empty_minor_heap ();
if (caml_gc_phase == Phase_idle) caml_major_collection_slice (-1);
CAML_INSTR_TIME (tmr, "dispatch/finalizers_minor");
}
}
if (trigger != caml_young_alloc_start || caml_requested_major_slice){
/* The minor heap is half-full, do a major GC slice. */
caml_requested_major_slice = 0;
caml_young_trigger = caml_young_alloc_start;
caml_young_limit = caml_young_trigger;
caml_major_collection_slice (-1);
CAML_INSTR_TIME (tmr, "dispatch/major");
}
}
/* For backward compatibility with Lablgtk: do a minor collection to
ensure that the minor heap is empty.
*/
CAMLexport void caml_minor_collection (void)
{
caml_empty_minor_heap ();
caml_major_collection_slice (0);
caml_force_major_slice = 0;
caml_final_do_calls ();
caml_empty_minor_heap ();
caml_requested_minor_gc = 1;
caml_gc_dispatch ();
}
CAMLexport value caml_check_urgent_gc (value extra_root)
{
CAMLparam1 (extra_root);
if (caml_force_major_slice) caml_minor_collection();
if (caml_requested_major_slice || caml_requested_minor_gc){
CAML_INSTR_INT ("force_minor/check_urgent_gc@", 1);
caml_gc_dispatch();
}
CAMLreturn (extra_root);
}
@ -316,13 +434,14 @@ void caml_realloc_ref_table (struct caml_ref_table *tbl)
if (tbl->base == NULL){
caml_alloc_table (tbl, caml_minor_heap_wsz / 8, 256);
}else if (tbl->limit == tbl->threshold){
CAML_INSTR_INT ("request_minor/realloc_ref_table@", 1);
caml_gc_message (0x08, "ref_table threshold crossed\n", 0);
tbl->limit = tbl->end;
caml_urge_major_slice ();
}else{ /* This will almost never happen with the bytecode interpreter. */
caml_request_minor_gc ();
}else{
asize_t sz;
asize_t cur_ptr = tbl->ptr - tbl->base;
Assert (caml_force_major_slice);
CAMLassert (caml_requested_minor_gc);
tbl->size *= 2;
sz = (tbl->size + tbl->reserve) * sizeof (value *);

81
byterun/misc.c
View File

@ -17,6 +17,7 @@
#include "caml/config.h"
#include "caml/misc.h"
#include "caml/memory.h"
#include "caml/version.h"
caml_timing_hook caml_major_slice_begin_hook = NULL;
caml_timing_hook caml_major_slice_end_hook = NULL;
@ -49,7 +50,7 @@ uintnat caml_verb_gc = 0;
void caml_gc_message (int level, char *msg, uintnat arg)
{
if (level < 0 || (caml_verb_gc & level) != 0){
if ((caml_verb_gc & level) != 0){
fprintf (stderr, msg, arg);
fflush (stderr);
}
@ -195,3 +196,81 @@ int caml_runtime_warnings_active(void)
}
return 1;
}
#ifdef CAML_INSTR
/* Timers for profiling GC and allocation (experimental, Linux-only) */
#include <limits.h>
#include <sys/types.h>
#include <unistd.h>
struct CAML_INSTR_BLOCK *CAML_INSTR_LOG = NULL;
intnat CAML_INSTR_STARTTIME, CAML_INSTR_STOPTIME;
#define Get_time(p,i) ((p)->ts[(i)].tv_nsec + 1000000000 * (p)->ts[(i)].tv_sec)
void CAML_INSTR_INIT (void)
{
char *s;
CAML_INSTR_STARTTIME = 0;
s = getenv ("OCAML_INSTR_START");
if (s != NULL) CAML_INSTR_STARTTIME = atol (s);
CAML_INSTR_STOPTIME = LONG_MAX;
s = getenv ("OCAML_INSTR_STOP");
if (s != NULL) CAML_INSTR_STOPTIME = atol (s);
}
void CAML_INSTR_ATEXIT (void)
{
int i;
struct CAML_INSTR_BLOCK *p, *prev, *next;
FILE *f = NULL;
char *fname;
fname = getenv ("OCAML_INSTR_FILE");
if (fname != NULL){
char *mode = "a";
char buf [1000];
char *name = fname;
if (name[0] == '@'){
snprintf (buf, sizeof(buf), "%s.%d", name + 1, getpid ());
name = buf;
}
if (name[0] == '+'){
mode = "a";
name = name + 1;
}else if (name [0] == '>' || name[0] == '-'){
mode = "w";
name = name + 1;
}
f = fopen (name, mode);
}
if (f != NULL){
/* reverse the list */
prev = NULL;
p = CAML_INSTR_LOG;
while (p != NULL){
next = p->next;
p->next = prev;
prev = p;
p = next;
}
CAML_INSTR_LOG = prev;
fprintf (f, "==== OCAML INSTRUMENTATION DATA %s\n", OCAML_VERSION_STRING);
for (p = CAML_INSTR_LOG; p != NULL; p = p->next){
for (i = 0; i < p->index; i++){
fprintf (f, "@@ %19ld %19ld %s\n",
Get_time (p, i), Get_time(p, i+1), p->tag[i+1]);
}
if (p->tag[0][0] != '\000'){
fprintf (f, "@@ %19ld %19ld %s\n",
Get_time (p, 0), Get_time(p, p->index), p->tag[0]);
}
}
fclose (f);
}
}
#endif /* CAML_INSTR */

10
byterun/obj.c
View File

@ -111,9 +111,13 @@ CAMLprim value caml_obj_dup(value arg)
to 0 or greater than the current size.
algorithm:
Change the length field of the header. Make up a white object
Change the length field of the header. Make up a black object
with the leftover part of the object: this is needed in the major
heap and harmless in the minor heap.
heap and harmless in the minor heap. The object cannot be white
because there may still be references to it in the ref table. By
using a black object we ensure that the ref table will be emptied
before the block is reallocated (since there must be a minor
collection within each major cycle).
[newsize] is a value encoding a number of words.
*/
@ -147,7 +151,7 @@ CAMLprim value caml_obj_truncate (value v, value newsize)
look like a pointer because there may be some references to it in
ref_table. */
Field (v, new_wosize) =
Make_header (Wosize_whsize (wosize-new_wosize), 1, Caml_white);
Make_header (Wosize_whsize (wosize-new_wosize), Abstract_tag, Caml_black);
Hd_val (v) = Make_header (new_wosize, tag, color);
return Val_unit;
}

39
byterun/roots.c
View File

@ -27,7 +27,7 @@ CAMLexport struct caml__roots_block *caml_local_roots = NULL;
CAMLexport void (*caml_scan_roots_hook) (scanning_action f) = NULL;
/* FIXME should rename to [caml_oldify_young_roots] and synchronise with
/* FIXME should rename to [caml_oldify_minor_roots] and synchronise with
asmrun/roots.c */
/* Call [caml_oldify_one] on (at least) all the roots that point to the minor
heap. */
@ -60,23 +60,54 @@ void caml_oldify_local_roots (void)
/* Call [caml_darken] on all roots */
void caml_darken_all_roots (void)
void caml_darken_all_roots_start (void)
{
caml_do_roots (caml_darken);
caml_do_roots (caml_darken, 1);
}
void caml_do_roots (scanning_action f)
uintnat caml_incremental_roots_count = 1;
intnat caml_darken_all_roots_slice (intnat work)
{
return 0;
}
/* Note, in byte-code there is only one global root, so [do_globals] is
ignored and [caml_darken_all_roots_slice] does nothing. */
void caml_do_roots (scanning_action f, int do_globals)
{
CAML_INSTR_SETUP (tmr, "major_roots");
/* Global variables */
f(caml_global_data, &caml_global_data);
CAML_INSTR_TIME (tmr, "major_roots/global");
/* The stack and the local C roots */
caml_do_local_roots(f, caml_extern_sp, caml_stack_high, caml_local_roots);
CAML_INSTR_TIME (tmr, "major_roots/local");
/* Global C roots */
caml_scan_global_roots(f);
CAML_INSTR_TIME (tmr, "major_roots/C");
/* 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");
}
CAMLexport void caml_do_local_roots (scanning_action f, value *stack_low,

22
byterun/signals.c
View File

@ -67,7 +67,7 @@ void caml_record_signal(int signal_number)
#ifndef NATIVE_CODE
caml_something_to_do = 1;
#else
caml_young_limit = caml_young_end;
caml_young_limit = caml_young_alloc_end;
#endif
}
@ -157,15 +157,16 @@ void caml_execute_signal(int signal_number, int in_signal_handler)
/* Arrange for a garbage collection to be performed as soon as possible */
int volatile caml_force_major_slice = 0;
int volatile caml_requested_major_slice = 0;
int volatile caml_requested_minor_gc = 0;
void caml_urge_major_slice (void)
void caml_request_major_slice (void)
{
caml_force_major_slice = 1;
caml_requested_major_slice = 1;
#ifndef NATIVE_CODE
caml_something_to_do = 1;
#else
caml_young_limit = caml_young_end;
caml_young_limit = caml_young_alloc_end;
/* This is only moderately effective on ports that cache [caml_young_limit]
in a register, since [caml_modify] is called directly, not through
[caml_c_call], so it may take a while before the register is reloaded
@ -173,6 +174,17 @@ void caml_urge_major_slice (void)
#endif
}
void caml_request_minor_gc (void)
{
caml_requested_minor_gc = 1;
#ifndef NATIVE_CODE
caml_something_to_do = 1;
#else
caml_young_limit = caml_young_alloc_end;
/* Same remark as above in [caml_request_major_slice]. */
#endif
}
/* OS-independent numbering of signals */
#ifndef SIGABRT

10
byterun/startup.c
View File

@ -287,9 +287,13 @@ CAMLexport void caml_main(char **argv)
caml_external_raise = NULL;
/* Determine options and position of bytecode file */
#ifdef DEBUG
caml_verb_gc = 0xBF;
caml_verb_gc = 0x3F;
#endif
caml_parse_ocamlrunparam();
#ifdef DEBUG
caml_gc_message (-1, "### OCaml runtime: debug mode ###\n", 0);
#endif
pos = 0;
/* First, try argv[0] (when ocamlrun is called by a bytecode program) */
@ -326,7 +330,7 @@ CAMLexport void caml_main(char **argv)
/* Initialize the abstract machine */
caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz,
caml_init_heap_chunk_sz, caml_init_percent_free,
caml_init_max_percent_free);
caml_init_max_percent_free, caml_init_major_window);
caml_init_stack (caml_init_max_stack_wsz);
caml_init_atom_table();
caml_init_backtrace();
@ -410,7 +414,7 @@ CAMLexport void caml_startup_code(
/* Initialize the abstract machine */
caml_init_gc (caml_init_minor_heap_wsz, caml_init_heap_wsz,
caml_init_heap_chunk_sz, caml_init_percent_free,
caml_init_max_percent_free);
caml_init_max_percent_free, caml_init_major_window);
caml_init_stack (caml_init_max_stack_wsz);
caml_init_atom_table();
caml_init_backtrace();

3
byterun/startup_aux.c
View File

@ -42,6 +42,7 @@ uintnat caml_init_minor_heap_wsz = Minor_heap_def;
uintnat caml_init_heap_chunk_sz = Heap_chunk_def;
uintnat caml_init_heap_wsz = Init_heap_def;
uintnat caml_init_max_stack_wsz = Max_stack_def;
uintnat caml_init_major_window = Major_window_def;
extern int caml_parser_trace;
uintnat caml_trace_level = 0;
@ -73,6 +74,7 @@ void caml_parse_ocamlrunparam(void)
case 'a': scanmult (opt, &p); caml_set_allocation_policy (p); break;
case 'b': scanmult (opt, &p); caml_record_backtrace(Val_bool (p)); break;
case 'h': scanmult (opt, &caml_init_heap_wsz); break;
case 'H': scanmult (opt, &caml_use_huge_pages); break;
case 'i': scanmult (opt, &caml_init_heap_chunk_sz); break;
case 'l': scanmult (opt, &caml_init_max_stack_wsz); break;
case 'o': scanmult (opt, &caml_init_percent_free); break;
@ -82,6 +84,7 @@ void caml_parse_ocamlrunparam(void)
case 's': scanmult (opt, &caml_init_minor_heap_wsz); break;
case 't': scanmult (opt, &caml_trace_level); break;
case 'v': scanmult (opt, &caml_verb_gc); break;
case 'w': scanmult (opt, &caml_init_major_window); break;
case 'W': scanmult (opt, &caml_runtime_warnings); break;
}
while (*opt != '\0'){

6
byterun/sys.c
View File

@ -44,14 +44,15 @@
#include "caml/alloc.h"
#include "caml/debugger.h"
#include "caml/fail.h"
#include "caml/gc_ctrl.h"
#include "caml/instruct.h"
#include "caml/io.h"
#include "caml/misc.h"
#include "caml/mlvalues.h"
#include "caml/osdeps.h"
#include "caml/signals.h"
#include "caml/stacks.h"
#include "caml/sys.h"
#include "caml/gc_ctrl.h"
#include "caml/io.h"
static char * error_message(void)
{
@ -135,6 +136,7 @@ CAMLprim value caml_sys_exit(value retcode)
#ifndef NATIVE_CODE
caml_debugger(PROGRAM_EXIT);
#endif
CAML_INSTR_ATEXIT ();
exit(Int_val(retcode));
return Val_unit;
}

6
byterun/weak.c
View File

@ -51,11 +51,7 @@ static void do_set (value ar, mlsize_t offset, value v)
value old = Field (ar, offset);
Field (ar, offset) = v;
if (!(Is_block (old) && Is_young (old))){
if (caml_weak_ref_table.ptr >= caml_weak_ref_table.limit){
CAMLassert (caml_weak_ref_table.ptr == caml_weak_ref_table.limit);
caml_realloc_ref_table (&caml_weak_ref_table);
}
*caml_weak_ref_table.ptr++ = &Field (ar, offset);
Add_to_ref_table (caml_weak_ref_table, &Field (ar, offset));
}
}else{
Field (ar, offset) = v;

49
config/auto-aux/mmap-huge.c Normal file
View File

@ -0,0 +1,49 @@
/***********************************************************************/
/* */
/* OCaml */
/* */
/* Damien Doligez, Jane Street Group, LLC */
/* */
/* Copyright 2015 Institut National de Recherche en Informatique et */
/* en Automatique. All rights reserved. This file is distributed */
/* under the terms of the GNU Library General Public License, with */
/* the special exception on linking described in file ../../LICENSE. */
/* */
/***********************************************************************/
#include <sys/mman.h>
#include <stdio.h>
#include <stdlib.h>
#define huge_page_size (4 * 1024 * 1024)
/* Test for the possible availability of huge pages. Answer yes
if the OS knows about huge pages, even if they are not available
on the build machine at configure time, because (on Linux) huge
pages can be activated and deactivated easily while the system
is running.
*/
int main (int argc, char *argv[]){
void *block;
char *p;
int i, res;
block = mmap (NULL, huge_page_size, PROT_READ | PROT_WRITE,
MAP_PRIVATE | MAP_ANONYMOUS | MAP_HUGETLB,
-1, 0);
if (block == MAP_FAILED){
block = mmap (NULL, huge_page_size, PROT_READ | PROT_WRITE,
MAP_PRIVATE | MAP_ANONYMOUS,
-1, 0);
}
if (block == MAP_FAILED){
perror ("mmap");
return 3;
}
/*printf ("block = %p\n", block);*/
p = (char *) block;
for (i = 0; i < huge_page_size; i += 4096){
p[i] = (char) i;
}
return 0;
}

18
configure vendored
View File

@ -40,6 +40,7 @@ dl_defs=''
verbose=no
with_curses=yes
debugruntime=noruntimed
with_instrumented_runtime=false
with_sharedlibs=yes
partialld="ld -r"
with_debugger=ocamldebugger
@ -144,6 +145,8 @@ while : ; do
verbose=yes;;
-with-debug-runtime|--with-debug-runtime)
debugruntime=runtimed;;
-with-instrumented-runtime|--with-instrumented-runtime)
with_instrumented_runtime=true;;
-no-debugger|--no-debugger)
with_debugger="";;
-no-ocamldoc|--no-ocamldoc)
@ -1687,6 +1690,16 @@ if $no_naked_pointers; then
echo "#define NO_NAKED_POINTERS" >> m.h
fi
# Check for mmap support for huge pages and contiguous heap
if sh ./runtest mmap-huge.c; then
has_huge_pages=true
echo "#define HAS_HUGE_PAGES" >>s.h
echo "#define HUGE_PAGE_SIZE (4 * 1024 * 1024)" >>s.h
inf "mmap supports huge pages"
else
has_huge_pages=false
fi
# Finish generated files
cclibs="$cclibs $mathlib"
@ -1755,6 +1768,7 @@ if $shared_libraries_supported; then
else
echo "SHARED=noshared" >>Makefile
fi
echo "RUNTIMEI=${with_instrumented_runtime}" >>Makefile
echo "WITH_DEBUGGER=${with_debugger}" >>Makefile
echo "WITH_OCAMLDOC=${with_ocamldoc}" >>Makefile
echo "WITH_OCAMLBUILD=${with_ocamlbuild}" >>Makefile
@ -1845,6 +1859,10 @@ if test "$debugruntime" = "runtimed"; then
inf "Debug runtime will be compiled and installed"
fi
if $with_instrumented_runtime; then
inf "Instrumented runtime will be compiled and installed"
fi
inf "Additional libraries supported:"
inf " $otherlibraries"

2
debugger/.depend
View File

@ -16,8 +16,8 @@ int64ops.cmi :
lexer.cmi : parser.cmi
loadprinter.cmi : ../parsing/longident.cmi dynlink.cmi
parameters.cmi :
parser_aux.cmi : primitives.cmi ../parsing/longident.cmi
parser.cmi : parser_aux.cmi ../parsing/longident.cmi
parser_aux.cmi : primitives.cmi ../parsing/longident.cmi
pattern_matching.cmi : ../typing/typedtree.cmi parser_aux.cmi debugcom.cmi
pos.cmi : ../bytecomp/instruct.cmi
primitives.cmi : $(UNIXDIR)/unix.cmi

6
lex/.depend
View File

@ -3,8 +3,8 @@ compact.cmi : lexgen.cmi
cset.cmi :
lexer.cmi : parser.cmi
lexgen.cmi : syntax.cmi
outputbis.cmi : syntax.cmi lexgen.cmi common.cmi
output.cmi : syntax.cmi lexgen.cmi compact.cmi common.cmi
outputbis.cmi : syntax.cmi lexgen.cmi common.cmi
parser.cmi : syntax.cmi
syntax.cmi : cset.cmi
table.cmi :
@ -22,10 +22,10 @@ main.cmo : syntax.cmi parser.cmi outputbis.cmi output.cmi lexgen.cmi \
lexer.cmi cset.cmi compact.cmi common.cmi
main.cmx : syntax.cmx parser.cmx outputbis.cmx output.cmx lexgen.cmx \
lexer.cmx cset.cmx compact.cmx common.cmx
outputbis.cmo : lexgen.cmi common.cmi outputbis.cmi
outputbis.cmx : lexgen.cmx common.cmx outputbis.cmi
output.cmo : lexgen.cmi compact.cmi common.cmi output.cmi
output.cmx : lexgen.cmx compact.cmx common.cmx output.cmi
outputbis.cmo : lexgen.cmi common.cmi outputbis.cmi
outputbis.cmx : lexgen.cmx common.cmx outputbis.cmi
parser.cmo : syntax.cmi cset.cmi parser.cmi
parser.cmx : syntax.cmx cset.cmx parser.cmi
syntax.cmo : cset.cmi syntax.cmi

50
ocamlbuild/.depend
View File

@ -8,9 +8,9 @@ exit_codes.cmi :
fda.cmi : slurp.cmi
findlib.cmi : signatures.cmi command.cmi
flags.cmi : tags.cmi command.cmi
glob.cmi : signatures.cmi glob_ast.cmi bool.cmi
glob_ast.cmi : bool.cmi
glob_lexer.cmi : glob_ast.cmi
glob.cmi : signatures.cmi glob_ast.cmi bool.cmi
hooks.cmi :
hygiene.cmi : slurp.cmi
lexers.cmi : loc.cmi glob.cmi
@ -20,17 +20,17 @@ main.cmi :
my_std.cmi : signatures.cmi
my_unix.cmi :
ocaml_arch.cmi : signatures.cmi command.cmi
ocamlbuild_executor.cmi :
ocamlbuildlight.cmi :
ocamlbuild.cmi :
ocamlbuild_plugin.cmi :
ocamlbuild_unix_plugin.cmi :
ocamlbuild_where.cmi :
ocaml_compiler.cmi : tags.cmi rule.cmi pathname.cmi command.cmi
ocaml_dependencies.cmi : pathname.cmi
ocaml_specific.cmi :
ocaml_tools.cmi : tags.cmi rule.cmi pathname.cmi command.cmi
ocaml_utils.cmi : tags.cmi pathname.cmi command.cmi
ocamlbuild.cmi :
ocamlbuild_executor.cmi :
ocamlbuild_plugin.cmi :
ocamlbuild_unix_plugin.cmi :
ocamlbuild_where.cmi :
ocamlbuildlight.cmi :
options.cmi : slurp.cmi signatures.cmi command.cmi
param_tags.cmi : tags.cmi loc.cmi
pathname.cmi : signatures.cmi
@ -75,12 +75,12 @@ findlib.cmx : my_unix.cmx my_std.cmx lexers.cmx const.cmx command.cmx \
findlib.cmi
flags.cmo : tags.cmi param_tags.cmi log.cmi command.cmi bool.cmi flags.cmi
flags.cmx : tags.cmx param_tags.cmx log.cmx command.cmx bool.cmx flags.cmi
glob.cmo : my_std.cmi glob_lexer.cmi glob_ast.cmi bool.cmi glob.cmi
glob.cmx : my_std.cmx glob_lexer.cmx glob_ast.cmx bool.cmx glob.cmi
glob_ast.cmo : bool.cmi glob_ast.cmi
glob_ast.cmx : bool.cmx glob_ast.cmi
glob_lexer.cmo : glob_ast.cmi bool.cmi glob_lexer.cmi
glob_lexer.cmx : glob_ast.cmx bool.cmx glob_lexer.cmi
glob.cmo : my_std.cmi glob_lexer.cmi glob_ast.cmi bool.cmi glob.cmi
glob.cmx : my_std.cmx glob_lexer.cmx glob_ast.cmx bool.cmx glob.cmi
hooks.cmo : hooks.cmi
hooks.cmx : hooks.cmi
hygiene.cmo : slurp.cmi shell.cmi pathname.cmi options.cmi my_std.cmi \
@ -111,22 +111,6 @@ my_unix.cmo : my_std.cmi my_unix.cmi
my_unix.cmx : my_std.cmx my_unix.cmi
ocaml_arch.cmo : pathname.cmi my_std.cmi command.cmi ocaml_arch.cmi
ocaml_arch.cmx : pathname.cmx my_std.cmx command.cmx ocaml_arch.cmi
ocamlbuild_config.cmo :
ocamlbuild_config.cmx :
ocamlbuild_executor.cmo : ocamlbuild_executor.cmi
ocamlbuild_executor.cmx : ocamlbuild_executor.cmi
ocamlbuildlight.cmo : ocamlbuildlight.cmi
ocamlbuildlight.cmx : ocamlbuildlight.cmi
ocamlbuild.cmo : ocamlbuild_unix_plugin.cmi ocamlbuild.cmi
ocamlbuild.cmx : ocamlbuild_unix_plugin.cmx ocamlbuild.cmi
ocamlbuild_plugin.cmo : ocamlbuild_plugin.cmi
ocamlbuild_plugin.cmx : ocamlbuild_plugin.cmi
ocamlbuild_unix_plugin.cmo : ocamlbuild_executor.cmi my_unix.cmi my_std.cmi \
exit_codes.cmi ocamlbuild_unix_plugin.cmi
ocamlbuild_unix_plugin.cmx : ocamlbuild_executor.cmx my_unix.cmx my_std.cmx \
exit_codes.cmx ocamlbuild_unix_plugin.cmi
ocamlbuild_where.cmo : ocamlbuild_config.cmo ocamlbuild_where.cmi
ocamlbuild_where.cmx : ocamlbuild_config.cmx ocamlbuild_where.cmi
ocaml_compiler.cmo : tools.cmi tags.cmi rule.cmi resource.cmi pathname.cmi \
options.cmi ocaml_utils.cmi ocaml_dependencies.cmi ocaml_arch.cmi \
my_std.cmi log.cmi command.cmi ocaml_compiler.cmi
@ -157,6 +141,22 @@ ocaml_utils.cmo : tools.cmi tags.cmi pathname.cmi param_tags.cmi options.cmi \
ocaml_utils.cmx : tools.cmx tags.cmx pathname.cmx param_tags.cmx options.cmx \
my_std.cmx log.cmx lexers.cmx flags.cmx const.cmx command.cmx \
ocaml_utils.cmi
ocamlbuild.cmo : ocamlbuild_unix_plugin.cmi ocamlbuild.cmi
ocamlbuild.cmx : ocamlbuild_unix_plugin.cmx ocamlbuild.cmi
ocamlbuild_config.cmo :
ocamlbuild_config.cmx :
ocamlbuild_executor.cmo : ocamlbuild_executor.cmi
ocamlbuild_executor.cmx : ocamlbuild_executor.cmi
ocamlbuild_plugin.cmo : ocamlbuild_plugin.cmi
ocamlbuild_plugin.cmx : ocamlbuild_plugin.cmi
ocamlbuild_unix_plugin.cmo : ocamlbuild_executor.cmi my_unix.cmi my_std.cmi \
exit_codes.cmi ocamlbuild_unix_plugin.cmi
ocamlbuild_unix_plugin.cmx : ocamlbuild_executor.cmx my_unix.cmx my_std.cmx \
exit_codes.cmx ocamlbuild_unix_plugin.cmi
ocamlbuild_where.cmo : ocamlbuild_config.cmo ocamlbuild_where.cmi
ocamlbuild_where.cmx : ocamlbuild_config.cmx ocamlbuild_where.cmi
ocamlbuildlight.cmo : ocamlbuildlight.cmi
ocamlbuildlight.cmx : ocamlbuildlight.cmi
options.cmo : shell.cmi ocamlbuild_where.cmi ocamlbuild_config.cmo \
my_std.cmi log.cmi lexers.cmi const.cmo command.cmi options.cmi
options.cmx : shell.cmx ocamlbuild_where.cmx ocamlbuild_config.cmx \

26
ocamldoc/.depend
View File

@ -1,3 +1,11 @@
odoc.cmo : ../typing/typedtree.cmi odoc_messages.cmo odoc_info.cmi \
odoc_global.cmi odoc_gen.cmi odoc_config.cmi odoc_args.cmi \
odoc_analyse.cmi ../utils/misc.cmi ../utils/config.cmi \
../utils/clflags.cmi
odoc.cmx : ../typing/typedtree.cmx odoc_messages.cmx odoc_info.cmx \
odoc_global.cmx odoc_gen.cmx odoc_config.cmx odoc_args.cmx \
odoc_analyse.cmx ../utils/misc.cmx ../utils/config.cmx \
../utils/clflags.cmx
odoc_analyse.cmo : ../utils/warnings.cmi ../typing/types.cmi \
../typing/typemod.cmi ../typing/typedtree.cmi ../parsing/syntaxerr.cmi \
../driver/pparse.cmi ../parsing/parse.cmi odoc_types.cmi odoc_text.cmi \
@ -44,8 +52,6 @@ odoc_class.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \
odoc_parameter.cmo odoc_name.cmi
odoc_class.cmx : ../typing/types.cmx odoc_value.cmx odoc_types.cmx \
odoc_parameter.cmx odoc_name.cmx
odoc_comments_global.cmo : odoc_comments_global.cmi
odoc_comments_global.cmx : odoc_comments_global.cmi
odoc_comments.cmo : odoc_types.cmi odoc_text.cmi odoc_see_lexer.cmo \
odoc_parser.cmi odoc_misc.cmi odoc_messages.cmo odoc_merge.cmi \
odoc_lexer.cmo odoc_global.cmi odoc_cross.cmi odoc_comments_global.cmi \
@ -54,6 +60,8 @@ odoc_comments.cmx : odoc_types.cmx odoc_text.cmx odoc_see_lexer.cmx \
odoc_parser.cmx odoc_misc.cmx odoc_messages.cmx odoc_merge.cmx \
odoc_lexer.cmx odoc_global.cmx odoc_cross.cmx odoc_comments_global.cmx \
odoc_comments.cmi
odoc_comments_global.cmo : odoc_comments_global.cmi
odoc_comments_global.cmx : odoc_comments_global.cmi
odoc_config.cmo : ../utils/config.cmi odoc_config.cmi
odoc_config.cmx : ../utils/config.cmx odoc_config.cmi
odoc_control.cmo :
@ -144,14 +152,6 @@ odoc_misc.cmo : ../typing/types.cmi ../typing/predef.cmi ../typing/path.cmi \
odoc_misc.cmx : ../typing/types.cmx ../typing/predef.cmx ../typing/path.cmx \
odoc_types.cmx odoc_messages.cmx ../parsing/longident.cmx \
../typing/ctype.cmx ../typing/btype.cmx odoc_misc.cmi
odoc.cmo : ../typing/typedtree.cmi odoc_messages.cmo odoc_info.cmi \
odoc_global.cmi odoc_gen.cmi odoc_config.cmi odoc_args.cmi \
odoc_analyse.cmi ../utils/misc.cmi ../utils/config.cmi \
../utils/clflags.cmi
odoc.cmx : ../typing/typedtree.cmx odoc_messages.cmx odoc_info.cmx \
odoc_global.cmx odoc_gen.cmx odoc_config.cmx odoc_args.cmx \
odoc_analyse.cmx ../utils/misc.cmx ../utils/config.cmx \
../utils/clflags.cmx
odoc_module.cmo : ../typing/types.cmi odoc_value.cmo odoc_types.cmi \
odoc_type.cmo odoc_name.cmi odoc_extension.cmo odoc_exception.cmo \
odoc_class.cmo
@ -214,12 +214,12 @@ odoc_texi.cmo : ../typing/types.cmi odoc_to_text.cmo odoc_messages.cmo \
odoc_info.cmi ../parsing/asttypes.cmi
odoc_texi.cmx : ../typing/types.cmx odoc_to_text.cmx odoc_messages.cmx \
odoc_info.cmx ../parsing/asttypes.cmi
odoc_text_lexer.cmo : odoc_text_parser.cmi odoc_misc.cmi
odoc_text_lexer.cmx : odoc_text_parser.cmx odoc_misc.cmx
odoc_text.cmo : odoc_types.cmi odoc_text_parser.cmi odoc_text_lexer.cmo \
odoc_text.cmi
odoc_text.cmx : odoc_types.cmx odoc_text_parser.cmx odoc_text_lexer.cmx \
odoc_text.cmi
odoc_text_lexer.cmo : odoc_text_parser.cmi odoc_misc.cmi
odoc_text_lexer.cmx : odoc_text_parser.cmx odoc_misc.cmx
odoc_text_parser.cmo : odoc_types.cmi odoc_misc.cmi odoc_text_parser.cmi
odoc_text_parser.cmx : odoc_types.cmx odoc_misc.cmx odoc_text_parser.cmi
odoc_to_text.cmo : odoc_module.cmo odoc_messages.cmo odoc_info.cmi
@ -238,8 +238,8 @@ odoc_analyse.cmi : odoc_module.cmo odoc_global.cmi
odoc_args.cmi : odoc_gen.cmi
odoc_ast.cmi : ../typing/types.cmi ../typing/typedtree.cmi \
../parsing/parsetree.cmi odoc_sig.cmi odoc_name.cmi odoc_module.cmo
odoc_comments_global.cmi :
odoc_comments.cmi : odoc_types.cmi odoc_module.cmo
odoc_comments_global.cmi :
odoc_config.cmi :
odoc_cross.cmi : odoc_types.cmi odoc_module.cmo
odoc_dag2html.cmi : odoc_info.cmi

43
otherlibs/bigarray/.depend
View File

@ -1,27 +1,28 @@
bigarray_stubs.o: bigarray_stubs.c ../../byterun/caml/alloc.h \
../../byterun/caml/misc.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/mlvalues.h bigarray.h ../../byterun/caml/config.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/custom.h \
../../byterun/caml/fail.h ../../byterun/caml/intext.h \
../../byterun/caml/io.h ../../byterun/caml/hash.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
../../byterun/caml/signals.h
../../byterun/caml/misc.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/mlvalues.h bigarray.h ../../byterun/caml/config.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/custom.h \
../../byterun/caml/fail.h ../../byterun/caml/intext.h \
../../byterun/caml/io.h ../../byterun/caml/hash.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
../../byterun/caml/signals.h
mmap_unix.o: mmap_unix.c bigarray.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/config.h \
../../byterun/caml/misc.h ../../byterun/caml/custom.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
../../byterun/caml/io.h ../../byterun/caml/sys.h \
../../byterun/caml/signals.h
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/config.h \
../../byterun/caml/misc.h ../../byterun/caml/custom.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/fail.h \
../../byterun/caml/io.h ../../byterun/caml/sys.h \
../../byterun/caml/signals.h
mmap_win32.o: mmap_win32.c bigarray.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/config.h \
../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/custom.h \
../../byterun/caml/fail.h ../../byterun/caml/sys.h ../unix/unixsupport.h
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/config.h \
../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/custom.h \
../../byterun/caml/fail.h ../../byterun/caml/sys.h \
../unix/unixsupport.h
bigarray.cmi :
bigarray.cmo : bigarray.cmi
bigarray.cmx : bigarray.cmi

186
otherlibs/graph/.depend
View File

@ -1,74 +1,118 @@
color.o: color.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h
draw.o: draw.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h \
../../byterun/caml/alloc.h ../../byterun/caml/mlvalues.h
dump_img.o: dump_img.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h image.h \
../../byterun/caml/alloc.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h
events.o: events.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h \
../../byterun/caml/alloc.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/signals.h
fill.o: fill.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/major_gc.h \
../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
../../byterun/caml/address_class.h
image.o: image.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h image.h \
../../byterun/caml/alloc.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/custom.h
make_img.o: make_img.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h image.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/major_gc.h \
../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
../../byterun/caml/address_class.h
open.o: open.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h \
../../byterun/caml/alloc.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/callback.h ../../byterun/caml/fail.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h
point_col.o: point_col.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h
sound.o: sound.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h
subwindow.o: subwindow.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h
text.o: text.c libgraph.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/misc.h \
../../byterun/caml/alloc.h ../../byterun/caml/mlvalues.h
color.o: color.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h
draw.o: draw.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
../../byterun/caml/mlvalues.h
dump_img.o: dump_img.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h image.h ../../byterun/caml/alloc.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
../../byterun/caml/address_class.h
events.o: events.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/signals.h
fill.o: fill.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h ../../byterun/caml/memory.h \
../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h
image.o: image.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h image.h ../../byterun/caml/alloc.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/custom.h
make_img.o: make_img.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h image.h ../../byterun/caml/memory.h \
../../byterun/caml/gc.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h
open.o: open.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/callback.h \
../../byterun/caml/fail.h ../../byterun/caml/memory.h \
../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
../../byterun/caml/address_class.h
point_col.o: point_col.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h
sound.o: sound.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h
subwindow.o: subwindow.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h
text.o: text.c libgraph.h \
\
\
\
../../byterun/caml/mlvalues.h ../../byterun/caml/compatibility.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/misc.h \
../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
../../byterun/caml/mlvalues.h
graphics.cmi :
graphicsX11.cmi :
graphics.cmo : graphics.cmi

26
otherlibs/num/.depend
View File

@ -1,23 +1,23 @@
bng.o: bng.c bng.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/compatibility.h bng_amd64.c bng_digit.c
bng_amd64.o: bng_amd64.c
bng_arm64.o: bng_arm64.c
bng.o: bng.c bng.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/compatibility.h bng_amd64.c bng_digit.c
bng_digit.o: bng_digit.c
bng_ia32.o: bng_ia32.c
bng_ppc.o: bng_ppc.c
bng_sparc.o: bng_sparc.c
nat_stubs.o: nat_stubs.c ../../byterun/caml/alloc.h \
../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/config.h ../../byterun/caml/custom.h \
../../byterun/caml/intext.h ../../byterun/caml/io.h \
../../byterun/caml/fail.h ../../byterun/caml/hash.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
../../byterun/caml/mlvalues.h bng.h nat.h
../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/config.h ../../byterun/caml/custom.h \
../../byterun/caml/intext.h ../../byterun/caml/io.h \
../../byterun/caml/fail.h ../../byterun/caml/hash.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
../../byterun/caml/mlvalues.h bng.h nat.h
arith_flags.cmi :
arith_status.cmi :
big_int.cmi : nat.cmi

14
otherlibs/str/.depend
View File

@ -1,11 +1,11 @@
strstubs.o: strstubs.c ../../byterun/caml/mlvalues.h \
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
../../byterun/caml/address_class.h ../../byterun/caml/fail.h
../../byterun/caml/compatibility.h ../../byterun/caml/config.h \
../../byterun/caml/../../config/m.h ../../byterun/caml/../../config/s.h \
../../byterun/caml/misc.h ../../byterun/caml/alloc.h \
../../byterun/caml/mlvalues.h ../../byterun/caml/memory.h \
../../byterun/caml/gc.h ../../byterun/caml/major_gc.h \
../../byterun/caml/freelist.h ../../byterun/caml/minor_gc.h \
../../byterun/caml/address_class.h ../../byterun/caml/fail.h
str.cmi :
str.cmo : str.cmi
str.cmx : str.cmi

26
otherlibs/systhreads/.depend
View File

@ -1,18 +1,16 @@
st_stubs.o: st_stubs.c ../../byterun/caml/alloc.h \
../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/backtrace.h ../../byterun/caml/exec.h \
../../byterun/caml/callback.h ../../byterun/caml/custom.h \
../../byterun/caml/fail.h ../../byterun/caml/io.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
../../byterun/caml/misc.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/printexc.h ../../byterun/caml/roots.h \
../../byterun/caml/memory.h ../../byterun/caml/signals.h \
../../byterun/caml/stacks.h ../../byterun/caml/sys.h threads.h \
st_posix.h
../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/backtrace.h ../../byterun/caml/exec.h \
../../byterun/caml/callback.h ../../byterun/caml/custom.h \
../../byterun/caml/fail.h ../../byterun/caml/io.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
../../byterun/caml/printexc.h ../../byterun/caml/roots.h \
../../byterun/caml/signals.h ../../byterun/caml/stacks.h \
../../byterun/caml/sys.h threads.h st_posix.h
condition.cmi : mutex.cmi
event.cmi :
mutex.cmi :

26
otherlibs/threads/.depend
View File

@ -1,17 +1,17 @@
scheduler.o: scheduler.c ../../byterun/caml/alloc.h \
../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/backtrace.h ../../byterun/caml/exec.h \
../../byterun/caml/callback.h ../../byterun/caml/config.h \
../../byterun/caml/fail.h ../../byterun/caml/io.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
../../byterun/caml/misc.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/printexc.h ../../byterun/caml/roots.h \
../../byterun/caml/memory.h ../../byterun/caml/signals.h \
../../byterun/caml/stacks.h ../../byterun/caml/sys.h
../../byterun/caml/compatibility.h ../../byterun/caml/misc.h \
../../byterun/caml/config.h ../../byterun/caml/../../config/m.h \
../../byterun/caml/../../config/s.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/backtrace.h ../../byterun/caml/exec.h \
../../byterun/caml/callback.h ../../byterun/caml/config.h \
../../byterun/caml/fail.h ../../byterun/caml/io.h \
../../byterun/caml/memory.h ../../byterun/caml/gc.h \
../../byterun/caml/major_gc.h ../../byterun/caml/freelist.h \
../../byterun/caml/minor_gc.h ../../byterun/caml/address_class.h \
../../byterun/caml/misc.h ../../byterun/caml/mlvalues.h \
../../byterun/caml/printexc.h ../../byterun/caml/roots.h \
../../byterun/caml/memory.h ../../byterun/caml/signals.h \
../../byterun/caml/stacks.h ../../byterun/caml/sys.h
condition.cmi : mutex.cmi
event.cmi :
marshal.cmi :

1100
otherlibs/unix/.depend
View File

File diff suppressed because it is too large Load Diff

14
stdlib/Makefile
View File

@ -45,16 +45,18 @@ installopt-prof:
stdlib.p.cmxa: $(OBJS:.cmo=.p.cmx)
$(CAMLOPT) -a -o stdlib.p.cmxa $(OBJS:.cmo=.p.cmx)
camlheader target_camlheader camlheaderd target_camlheaderd camlheader_ur: \
camlheader target_camlheader camlheader_ur \
camlheaderd target_camlheaderd \
camlheaderi target_camlheaderi: \
header.c ../config/Makefile
if $(SHARPBANGSCRIPTS); then \
echo '#!$(BINDIR)/ocamlrun' > camlheader && \
echo '#!$(TARGET_BINDIR)/ocamlrun' > target_camlheader && \
echo '#!$(BINDIR)/ocamlrund' > camlheaderd && \
echo '#!$(TARGET_BINDIR)/ocamlrund' > target_camlheaderd && \
for suff in '' d i; do \
echo '#!$(BINDIR)/ocamlrun'$$suff > camlheader$$suff && \
echo '#!$(TARGET_BINDIR)/ocamlrun'$$suff > target_camlheader$$suff; \
done && \
echo '#!' | tr -d '\012' > camlheader_ur; \
else \
for suff in '' d; do \
for suff in '' d i; do \
$(BYTECC) $(BYTECCCOMPOPTS) $(BYTECCLINKOPTS) \
-DRUNTIME_NAME='"$(BINDIR)/ocamlrun'$$suff'"' \
header.c -o tmpheader$(EXE) && \

6
stdlib/Makefile.nt
View File

@ -34,5 +34,11 @@ camlheaderd target_camlheaderd: headernt.c ../config/Makefile
mv tmpheader.exe camlheaderd
cp camlheaderd target_camlheaderd
camlheaderi: headernt.c ../config/Makefile
$(BYTECC) $(BYTECCCOMPOPTS) -c -I../byterun \
-DRUNTIME_NAME='"ocamlruni"' headernt.c
$(MKEXE) -o tmpheader.exe headernt.$(O) $(EXTRALIBS)
mv tmpheader.exe camlheaderi
# TODO: do not call flexlink to build tmpheader.exe (we don't need
# the export table)

31
stdlib/Makefile.shared
View File

@ -25,8 +25,8 @@ CAMLOPT=$(CAMLRUN) $(OPTCOMPILER)
CAMLDEP=$(CAMLRUN) ../tools/ocamldep
OBJS=camlinternalFormatBasics.cmo pervasives.cmo $(OTHERS)
OTHERS=array.cmo list.cmo char.cmo bytes.cmo string.cmo sys.cmo \
sort.cmo marshal.cmo obj.cmo \
OTHERS=list.cmo char.cmo bytes.cmo string.cmo sys.cmo \
sort.cmo marshal.cmo obj.cmo array.cmo \
int32.cmo int64.cmo nativeint.cmo \
lexing.cmo parsing.cmo \
set.cmo map.cmo stack.cmo queue.cmo \
@ -43,20 +43,32 @@ OTHERS=array.cmo list.cmo char.cmo bytes.cmo string.cmo sys.cmo \
all: stdlib.cma std_exit.cmo camlheader target_camlheader camlheader_ur
ifeq "$(RUNTIMED)" "runtimed"
all: camlheaderd
endif
ifeq "$(RUNTIMEI)" "true"
all: camlheaderi
endif
INSTALL_LIBDIR=$(DESTDIR)$(LIBDIR)
install: install-$(RUNTIMED)
install::
cp stdlib.cma std_exit.cmo *.cmi *.cmt *.cmti *.mli *.ml \
camlheader_ur \
$(INSTALL_LIBDIR)
cp target_camlheader $(INSTALL_LIBDIR)/camlheader
install-noruntimed:
.PHONY: install-noruntimed
ifeq "$(RUNTIMED)" "runtimed"
install::
cp target_camlheaderd $(INSTALL_LIBDIR)
endif
ifeq "$(RUNTIMEI)" "true"
install::
cp target_camlheaderi $(INSTALL_LIBDIR)
endif
install-runtimed: target_camlheaderd
cp target_camlheaderd $(INSTALL_LIBDIR)/camlheaderd
.PHONY: install-runtimed
stdlib.cma: $(OBJS)
$(CAMLC) -a -o stdlib.cma $(OBJS)
@ -71,7 +83,7 @@ clean::
rm -f sys.ml
clean::
rm -f camlheader target_camlheader camlheader_ur target_camlheaderd
rm -f camlheader target_camlheader camlheader_ur target_camlheader[di]
.SUFFIXES: .mli .ml .cmi .cmo .cmx .p.cmx
@ -104,6 +116,7 @@ $(OTHERS:.cmo=.p.cmx) std_exit.p.cmx: pervasives.cmx
clean::
rm -f *.cm* *.$(O) *.$(A)
rm -f *~
rm -f camlheader*
include .depend

32
stdlib/gc.ml
View File

@ -38,6 +38,7 @@ type control = {
mutable max_overhead : int;
mutable stack_limit : int;
mutable allocation_policy : int;
window_size : int;
};;
external stat : unit -> stat = "caml_gc_stat";;
@ -50,26 +51,35 @@ external major_slice : int -> int = "caml_gc_major_slice";;
external major : unit -> unit = "caml_gc_major";;
external full_major : unit -> unit = "caml_gc_full_major";;
external compact : unit -> unit = "caml_gc_compaction";;
external get_minor_free : unit -> int = "caml_get_minor_free" [@@noalloc]
external get_bucket : int -> int = "caml_get_major_bucket" [@@noalloc]
external get_credit : unit -> int = "caml_get_major_credit" [@@noalloc]
external huge_fallback_count : unit -> int = "caml_gc_huge_fallback_count"
open Printf;;
let print_stat c =
let st = stat () in
fprintf c "minor_words: %.0f\n" st.minor_words;
fprintf c "promoted_words: %.0f\n" st.promoted_words;
fprintf c "major_words: %.0f\n" st.major_words;
fprintf c "minor_collections: %d\n" st.minor_collections;
fprintf c "major_collections: %d\n" st.major_collections;
fprintf c "heap_words: %d\n" st.heap_words;
fprintf c "heap_chunks: %d\n" st.heap_chunks;
fprintf c "top_heap_words: %d\n" st.top_heap_words;
fprintf c "live_words: %d\n" st.live_words;
fprintf c "compactions: %d\n" st.compactions;
fprintf c "\n";
let l1 = String.length (sprintf "%.0f" st.minor_words) in
fprintf c "minor_words: %*.0f\n" l1 st.minor_words;
fprintf c "promoted_words: %*.0f\n" l1 st.promoted_words;
fprintf c "major_words: %*.0f\n" l1 st.major_words;
fprintf c "\n";
let l2 = String.length (sprintf "%d" st.top_heap_words) in
fprintf c "top_heap_words: %*d\n" l2 st.top_heap_words;
fprintf c "heap_words: %*d\n" l2 st.heap_words;
fprintf c "live_words: %*d\n" l2 st.live_words;
fprintf c "free_words: %*d\n" l2 st.free_words;
fprintf c "largest_free: %*d\n" l2 st.largest_free;
fprintf c "fragments: %*d\n" l2 st.fragments;
fprintf c "\n";
fprintf c "live_blocks: %d\n" st.live_blocks;
fprintf c "free_words: %d\n" st.free_words;
fprintf c "free_blocks: %d\n" st.free_blocks;
fprintf c "largest_free: %d\n" st.largest_free;
fprintf c "fragments: %d\n" st.fragments;
fprintf c "compactions: %d\n" st.compactions;
fprintf c "heap_chunks: %d\n" st.heap_chunks;
;;
let allocated_bytes () =

35
stdlib/gc.mli
View File

@ -141,6 +141,12 @@ type control =
first-fit policy, which can be slower in some cases but
can be better for programs with fragmentation problems.
Default: 0. @since 3.11.0 *)
window_size : int;
(** The size of the window used by the major GC for smoothing
out variations in its workload. This is an integer between
1 and 50.
Default: 1. @since 4.03.0 *)
}
(** The GC parameters are given as a [control] record. Note that
these parameters can also be initialised by setting the
@ -173,9 +179,13 @@ external minor : unit -> unit = "caml_gc_minor"
(** Trigger a minor collection. *)
external major_slice : int -> int = "caml_gc_major_slice";;
(** Do a minor collection and a slice of major collection. The argument
is the size of the slice, 0 to use the automatically-computed
slice size. In all cases, the result is the computed slice size. *)
(** [major_slice n]
Do a minor collection and a slice of major collection. [n] is the
size of the slice: the GC will do enough work to free (on average)
[n] words of memory. If [n] = 0, the GC will try to do enough work
to ensure that the next slice has no work to do.
Return an approximation of the work that the next slice will have
to do. *)
external major : unit -> unit = "caml_gc_major"
(** Do a minor collection and finish the current major collection cycle. *)
@ -198,6 +208,25 @@ val allocated_bytes : unit -> float
started. It is returned as a [float] to avoid overflow problems
with [int] on 32-bit machines. *)
external get_minor_free : unit -> int = "caml_get_minor_free" [@@noalloc]
(** Return the current size of the free space inside the minor heap. *)
external get_bucket : int -> int = "caml_get_major_bucket" [@@noalloc]
(** [get_bucket n] returns the current size of the [n]-th future bucket
of the GC smoothing system. The unit is one millionth of a full GC.
Raise [Invalid_argument] if [n] is negative, return 0 if n is larger
than the smoothing window. *)
external get_credit : unit -> int = "caml_get_major_credit" [@@noalloc]
(** [get_credit ()] returns the current size of the "work done in advance"
counter of the GC smoothing system. The unit is one millionth of a
full GC. *)
external huge_fallback_count : unit -> int = "caml_gc_huge_fallback_count"
(** Return the number of times we tried to map huge pages and had to fall
back to small pages. This is always 0 if [OCAMLRUNPARAM] contains [H=1].
@since 4.03.0 *)
val finalise : ('a -> unit) -> 'a -> unit
(** [finalise f v] registers [f] as a finalisation function for [v].
[v] must be heap-allocated. [f] will be called with [v] as

6
stdlib/obj.ml
View File

@ -25,8 +25,10 @@ external set_tag : t -> int -> unit = "caml_obj_set_tag"
external size : t -> int = "%obj_size"
external field : t -> int -> t = "%obj_field"
external set_field : t -> int -> t -> unit = "%obj_set_field"
let double_field x i = Array.get (obj x : float array) i
let set_double_field x i v = Array.set (obj x : float array) i v
external array_get: 'a array -> int -> 'a = "%array_safe_get"
external array_set: 'a array -> int -> 'a -> unit = "%array_safe_set"
let double_field x i = array_get (obj x : float array) i
let set_double_field x i v = array_set (obj x : float array) i v
external new_block : int -> int -> t = "caml_obj_block"
external dup : t -> t = "caml_obj_dup"
external truncate : t -> int -> unit = "caml_obj_truncate"

11
stdlib/sys.mli
View File

@ -119,6 +119,17 @@ val max_array_length : int
array is [max_array_length/2] on 32-bit machines and
[max_array_length] on 64-bit machines. *)
external runtime_variant : unit -> string = "caml_runtime_variant"
(** Return the name of the runtime variant the program is running on.
This is normally the argument given to [-runtime-variant] at compile
time, but for byte-code it can be changed after compilation.
@since 4.03.0 *)
external runtime_parameters : unit -> string = "caml_runtime_parameters"
(** Return the value of the runtime parameters, in the same format
as the contents of the [OCAMLRUNPARAM] environment variable.
@since 4.03.0 *)
(** {6 Signal handling} *)

2
stdlib/sys.mlp
View File

@ -37,6 +37,8 @@ let win32 = win32 ()
let cygwin = cygwin ()
let max_array_length = max_wosize ()
let max_string_length = word_size / 8 * max_array_length - 1;;
external runtime_variant : unit -> string = "caml_runtime_variant"
external runtime_parameters : unit -> string = "caml_runtime_parameters"
external file_exists: string -> bool = "caml_sys_file_exists"
external is_directory : string -> bool = "caml_sys_is_directory"

4
tools/.depend
View File

@ -56,10 +56,10 @@ ocamldep.cmx : ../driver/pparse.cmx ../parsing/parsetree.cmi \
../parsing/parser.cmx ../parsing/parse.cmx ../utils/misc.cmx \
../parsing/longident.cmx ../parsing/location.cmx ../parsing/lexer.cmx \
depend.cmx ../utils/config.cmx ../driver/compenv.cmx ../utils/clflags.cmx
ocamlmklibconfig.cmo :
ocamlmklibconfig.cmx :
ocamlmklib.cmo : ocamlmklibconfig.cmo
ocamlmklib.cmx : ocamlmklibconfig.cmx
ocamlmklibconfig.cmo :
ocamlmklibconfig.cmx :
ocamlmktop.cmo : ../utils/ccomp.cmi
ocamlmktop.cmx : ../utils/ccomp.cmx
ocamloptp.cmo : ../driver/main_args.cmi

5
tools/Makefile.shared
View File

@ -312,6 +312,11 @@ cmpbyt: $(CMPBYT)
clean::
rm -f cmpbyt
ifeq "$(RUNTIMEI)" "true"
install::
cp ocaml-instr-graph ocaml-instr-report $(INSTALL_BINDIR)/
endif
# Common stuff
.SUFFIXES:

109
tools/ocaml-instr-graph Executable file
View File

@ -0,0 +1,109 @@
#!/bin/bash
#########################################################################
# #
# OCaml #
# #
# Damien Doligez, Jane Street Group, LLC #
# #
# Copyright 2015 Institut National de Recherche en Informatique et #
# en Automatique. All rights reserved. This file is distributed #
# under the terms of the Q Public License version 1.0. #
# #
#########################################################################
# Use this script on OCAML_INSTR_FILE files
usage () {
echo 'usage: ocaml-instr-graph file [options]'
echo ' options:'
echo ' -d names plot the data for names (default major,minor,coll,dispatch)'
echo ' -t title set the graph title'
echo ' -m n clip the values to n (default 1G)'
echo ' -rt n set the range for times to 0..n'
echo ' -rn n set the range for counts to 0..n'
echo ' -from t start at time t'
echo ' -to t stop at time t'
echo ' -help display this help message and exit'
}
datafile=
curves=,
title=
titleset=false
max=1000000000
ranget=
rangen=
from=0
to=1e19
while [[ $# > 0 ]]; do
case $1 in
-d) curves=$curves$2,; shift 2;;
-t) title=$2; titleset=true; shift 2;;
-m) max=$2; shift 2;;
-rt) ranget="set yrange [0:$2]"; shift 2;;
-rn) rangen="set y2range [0:$2]"; shift 2;;
-from) from=$2; shift 2;;
-to) to=$2; shift 2;;
-help) usage; exit 0;;
*) datafile=$1; shift 1;;
esac
done
if [[ "$curves" = , ]]; then
curves=,major,minor,coll,dispatch,
fi
if ! $titleset; then
title=$datafile
fi
tmpfile=/tmp/ocaml-instr-graph.$$
rm -f $tmpfile-*
awk -v curves="$curves" -v clip=$max -v tmpfile="$tmpfile" -v from=$from \
-v to=$to '
function output (filename){
time = ($2 - starttime) / 1e9;
if (time < from || time >= to) return;
if (index(curves, "," filename ",") != 0){
gsub (/\//,":",filename);
if (filename ~ /#/){
point = $3;
}else{
point = ($3 - $2) / 1000;
}
if (point > clip) point = clip;
printf ("%.6f %.3f\n", time, point) >> tmpfile "-" filename;
}
}
BEGIN {starttime = 9e18;}
$1 != "@@" { next; }
$2 < starttime { starttime = $2 }
{ output($4); }
' $datafile
( echo set title \"$title\"
echo set key left top
echo set ytics nomirror
echo 'set format y "%gus"'
echo "$ranget"
echo "$rangen"
echo set y2tics nomirror
echo 'set format x "%gs"'
printf "plot "
for curve in ${curves//,/ }; do
f=$tmpfile-${curve//\//:}
if [ -f $f ]; then
case $f in
*#) printf "\"%s\" using 1:2 axes x1y2 title '%s', " "$f" "$curve";;
*) printf "\"%s\" using 1:2 title '%s', " "$f" "$curve";;
esac
fi
done
printf "\n"
) | gnuplot -p
rm -f $tmpfile-*

159
tools/ocaml-instr-report Executable file
View File

@ -0,0 +1,159 @@
#!/bin/awk -f
#########################################################################
# #
# OCaml #
# #
# Damien Doligez, Jane Street Group, LLC #
# #
# Copyright 2014 Institut National de Recherche en Informatique et #
# en Automatique. All rights reserved. This file is distributed #
# under the terms of the Q Public License version 1.0. #
# #
#########################################################################
# usage:
# ocaml-instr-report { file ... }
# generate a report from the data files (or stdin if no file is given)
function short(n, kind, i, r){
for (i = 0; i < 5; i++){
if (n < 1000) break;
n /= 1000;
}
r = sprintf ("%f", n);
if (index(r, ".") == 3){
r = substr(r, 1, 2);
}else{
r = substr(r, 1, 3);
}
return sprintf("%s%s", r, units[kind,i]);
}
function add(limit){
lim[nscales] = limit;
scale["t",nscales] = short(limit, "t");
scale["n",nscales] = short(limit, "n");
++ nscales;
}
# kind is "t" (for timer) or "n" (for number)
# events are simply a special kind of timer
BEGIN {
units["t",0] = "ns";
units["t",1] = "us";
units["t",2] = "ms";
units["t",3] = "s";
units["t",4] = "ks";
units["t",5] = "Ms";
units["n",0] = "";
units["n",1] = "k";
units["n",2] = "M";
units["n",3] = "G";
units["n",4] = "T";
units["n",5] = "P";
nscales=0;
add(0);
for (mul = 100; mul < 10000000000; mul *= 10){
add(mul);
add(2.2 * mul);
add(4.7 * mul);
}
}
function store(value, tag) {
++ total[tag];
for (i = 0; i < nscales; i++){
if (value <= lim[i]){
++ bin[tag, lim[i]];
val[tag, lim[i]] = value;
return;
}
}
++ bin[tag, "off-scale"];
val[tag, "off-scale"] = value;
}
$1 == "@@" && $4 ~ /@/ { total[$4] += $3; }
$1 == "@@" && $4 ~ /#/ { store($3, $4); }
$1 == "@@" { store($3 - $2, $4); }
function display(n, val, kind, i) {
graph_width = 35;
if (n > 0){
for (i = 0; i < log (n) / log (2); i++){
printf("#");
}
if (n == 1){
printf(" %-6d", n);
printf ("%-*s", graph_width - 7 - i,
sprintf("(%s)", short(val, kind)));
}else{
printf(" %-*d", graph_width - 1 - i, n);
}
}else{
printf("%*s", graph_width, "");
}
}
END {
n = asorti(total,tags);
total_alloc = 0;
for (i = 1; i <= n; i++){
t = tags[i];
if (t ~ /^alloc/) total_alloc += total[t];
}
for (i = 1; i <= n; i++){
t = tags[i];
if (t ~ /#/){
kind = "n"; # number
}else if (t ~ /@/){
kind = "e"; # event
}else{
kind = "t"; # timer
}
if (kind == "e"){
printf ("==== %-12s:%9d", t, total[t]);
if (t ~ /^alloc/){
cumul += total[t] / total_alloc;
printf(" (%6.2f%%)", cumul * 100);
}
printf ("\n");
continue;
}else{
printf ("==== %s: %d\n", t, total[t]);
}
num = bin[t,0];
found = num;
if (num == total[t] && kind == "t"){
/* nothing */
}else if (num > 0){
printf (" 0: ");
display(bin[t,0], val[t, 0], kind);
printf ("%6.2f%%\n", found * 100 / total[t]);
}
for (j = 1; j < nscales; j++){
if (found == total[t]) break;
num = bin [t, lim[j]];
found += num;
if (found > 0){
printf ("%5s..%-5s: ", scale[kind,j-1], scale[kind,j]);
display(num, val[t, lim[j]], kind);
printf ("%6.2f%%\n", found * 100 / total[t]);
}
}
num = bin[t, "off-scale"];
if (num != 0){
printf (" off scale : ");
display(bin[t, "off-scale"], val[t, "off-scale"]);
printf ("\n");
}
printf ("====\n");
}
}