Skip to content

Commit 2c93ca1

Browse files
jhjourdanjhjourdan
committed
Statistical memory profiling.
1 parent 4950410 commit 2c93ca1

63 files changed

Lines changed: 1835 additions & 699 deletions

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

‎.gitignore‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -81,6 +81,7 @@
8181
/asmrun/major_gc.c
8282
/asmrun/md5.c
8383
/asmrun/memory.c
84+
/asmrun/memprof.c
8485
/asmrun/meta.c
8586
/asmrun/minor_gc.c
8687
/asmrun/misc.c

‎Makefile‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -418,6 +418,7 @@ utils/config.ml: utils/config.mlp config/Makefile
418418
-e 's|%%WITH_FRAME_POINTERS%%|$(WITH_FRAME_POINTERS)|' \
419419
-e 's|%%WITH_PROFINFO%%|$(WITH_PROFINFO)|' \
420420
-e 's|%%WITH_SPACETIME%%|$(WITH_SPACETIME)|' \
421+
-e 's|%%WITH_STATMEMPROF%%|$(WITH_STATMEMPROF)|' \
421422
-e 's|%%PROFINFO_WIDTH%%|$(PROFINFO_WIDTH)|' \
422423
-e 's|%%LIBUNWIND_AVAILABLE%%|$(LIBUNWIND_AVAILABLE)|' \
423424
-e 's|%%LIBUNWIND_LINK_FLAGS%%|$(LIBUNWIND_LINK_FLAGS)|' \

‎Makefile.nt‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -397,6 +397,7 @@ utils/config.ml: utils/config.mlp config/Makefile
397397
-e 's|%%WITH_FRAME_POINTERS%%|false|' \
398398
-e 's|%%WITH_PROFINFO%%|$(WITH_PROFINFO)|' \
399399
-e 's|%%WITH_SPACETIME%%|$(WITH_SPACETIME)|' \
400+
-e 's|%%WITH_STATMEMPROF%%|$(WITH_STATMEMPROF)|' \
400401
-e 's|%%PROFINFO_WIDTH%%|$(PROFINFO_WIDTH)|' \
401402
-e 's|%%LIBUNWIND_AVAILABLE%%|false|' \
402403
-e 's|%%LIBUNWIND_LINK_FLAGS%%||' \

‎README.adoc‎

Lines changed: 53 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,56 @@
1-
= README =
1+
= README
2+
3+
== OVERVIEW
4+
5+
This is a patched version of the OCaml compiler and runtime. It
6+
provides a mechanism to statistically profile the heap.
7+
8+
== INSTALLATION
9+
10+
There is a opam switch packaging this patched version of OCaml:
11+
12+
$ opam switch install 4.03.0+statistical-memprof
13+
14+
You may also compile this patched version just as the normal OCaml
15+
compiler.
16+
17+
== QUICK TEST ON YOUR PROJECT
18+
19+
1- Copy the memprofHelpers.ml file in your project
20+
21+
2- Execute the following somewhere in your code:
22+
23+
MemprofHelpers.start 1E-4 20 100
24+
25+
3- Execute your program. When you want a profile of the heap, just
26+
send it the SIGUSR1 signal.
27+
28+
This will create a memory_profile file in the current directory,
29+
containing the current profile of the heap. The file contains, in the
30+
second column, the reverse call stacks at the allocation of the
31+
sampled blocks, and, on the first column, the number of corresponding
32+
samples. The row is masked if it corresponds to less than 100 samples.
33+
34+
A bit more information about the parameters of this function:
35+
36+
- 1st parameter (1E-4) : the sampling rate. Reasonnable values range
37+
from 1E-6 to 1E-2. Lower means less precision but less
38+
overhead. Higher means better precision (i.e., more samples) but
39+
more runtime overhead.
40+
41+
- 2nd parameter (20) : size of the callstack being dumped at each
42+
sample.
43+
44+
- 3rd parameter (100) : threshold below which nothing is printed in
45+
the output file.
46+
47+
== Tuning
48+
49+
If you want more involved sampling schemes, you could
50+
patch/reimplement memprofHelpers.ml. Please refer to the documentation
51+
of the Memprof stdlib module (only in this patched version of OCaml).
52+
53+
= ORIGINAL README FROM OCAML =
254

355
== Overview
456

‎asmcomp/amd64/emit.mlp‎

Lines changed: 16 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -323,7 +323,9 @@ let bound_error_call = ref 0
323323
let bound_error_label ?label dbg ~spacetime =
324324
if !Clflags.debug || Config.spacetime then begin
325325
let lbl_bound_error = new_label() in
326-
let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in
326+
let lbl_frame =
327+
record_frame_label ?label Reg.Set.empty false (Dbg_other dbg)
328+
in
327329
bound_error_sites :=
328330
{ bd_lbl = lbl_bound_error; bd_frame = lbl_frame;
329331
bd_spacetime = spacetime; } :: !bound_error_sites;
@@ -516,16 +518,16 @@ let emit_instr fallthrough i =
516518
load_symbol_addr s (res i 0)
517519
| Lop(Icall_ind { label_after; }) ->
518520
I.call (arg i 0);
519-
record_frame i.live false i.dbg ~label:label_after
521+
record_frame i.live false (Dbg_other i.dbg) ~label:label_after
520522
| Lop(Icall_imm { func; label_after; }) ->
521523
add_used_symbol func;
522524
emit_call func;
523-
record_frame i.live false i.dbg ~label:label_after
525+
record_frame i.live false (Dbg_other i.dbg) ~label:label_after
524526
| Lop(Itailcall_ind { label_after; }) ->
525527
output_epilogue begin fun () ->
526528
I.jmp (arg i 0);
527529
if Config.spacetime then begin
528-
record_frame Reg.Set.empty false i.dbg ~label:label_after
530+
record_frame Reg.Set.empty false (Dbg_other i.dbg) ~label:label_after
529531
end
530532
end
531533
| Lop(Itailcall_imm { func; label_after; }) ->
@@ -540,14 +542,14 @@ let emit_instr fallthrough i =
540542
end
541543
end;
542544
if Config.spacetime then begin
543-
record_frame Reg.Set.empty false i.dbg ~label:label_after
545+
record_frame Reg.Set.empty false (Dbg_other i.dbg) ~label:label_after
544546
end
545547
| Lop(Iextcall { func; alloc; label_after; }) ->
546548
add_used_symbol func;
547549
if alloc then begin
548550
load_symbol_addr func rax;
549551
emit_call "caml_c_call";
550-
record_frame i.live false i.dbg ~label:label_after;
552+
record_frame i.live false (Dbg_other i.dbg) ~label:label_after;
551553
if system <> S_win64 then begin
552554
(* TODO: investigate why such a diff.
553555
This comes from:
@@ -562,7 +564,7 @@ let emit_instr fallthrough i =
562564
end else begin
563565
emit_call func;
564566
if Config.spacetime then begin
565-
record_frame Reg.Set.empty false i.dbg ~label:label_after
567+
record_frame Reg.Set.empty false (Dbg_other i.dbg) ~label:label_after
566568
end
567569
end
568570
| Lop(Istackoffset n) ->
@@ -611,7 +613,8 @@ let emit_instr fallthrough i =
611613
| Double | Double_u ->
612614
I.movsd (arg i 0) (addressing addr REAL8 i 1)
613615
end
614-
| Lop(Ialloc { words = n; label_after_call_gc; spacetime_index; }) ->
616+
| Lop(Ialloc { words = n; blocks = dbg;
617+
label_after_call_gc; spacetime_index; }) ->
615618
if !fastcode_flag then begin
616619
let lbl_redo = new_label() in
617620
def_label lbl_redo;
@@ -635,12 +638,9 @@ let emit_instr fallthrough i =
635638
end else
636639
I.cmp (mem64_rip QWORD (emit_symbol "caml_young_limit")) r15;
637640
let lbl_call_gc = new_label() in
638-
let dbg =
639-
if not Config.spacetime then Debuginfo.none
640-
else i.dbg
641-
in
642641
let lbl_frame =
643-
record_frame_label ?label:label_after_call_gc i.live false dbg
642+
record_frame_label ?label:label_after_call_gc
643+
i.live false (Dbg_alloc dbg)
644644
in
645645
I.jb (label lbl_call_gc);
646646
I.lea (mem64 NONE 8 R15) (res i 0);
@@ -668,7 +668,7 @@ let emit_instr fallthrough i =
668668
end;
669669
let label =
670670
record_frame_label ?label:label_after_call_gc i.live false
671-
Debuginfo.none
671+
(Dbg_alloc dbg)
672672
in
673673
def_label label;
674674
I.lea (mem64 NONE 8 R15) (res i 0)
@@ -856,7 +856,7 @@ let emit_instr fallthrough i =
856856
begin match k with
857857
| Cmm.Raise_withtrace ->
858858
emit_call "caml_raise_exn";
859-
record_frame Reg.Set.empty true i.dbg
859+
record_frame Reg.Set.empty true (Dbg_other i.dbg)
860860
| Cmm.Raise_notrace ->
861861
I.mov r14 rsp;
862862
I.pop r14;
@@ -1083,7 +1083,7 @@ let end_assembly() =
10831083
efa_data_label = (fun l -> D.qword (ConstLabel (emit_label l)));
10841084
efa_16 = (fun n -> D.word (const n));
10851085
efa_32 = (fun n -> D.long (const_32 n));
1086-
efa_word = (fun n -> D.qword (const n));
1086+
efa_word = (fun n -> D.qword (const_nat n));
10871087
efa_align = D.align;
10881088
efa_label_rel =
10891089
(fun lbl ofs ->

‎asmcomp/arm/emit.mlp‎

Lines changed: 11 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -153,7 +153,9 @@ let bound_error_sites = ref ([] : bound_error_call list)
153153
let bound_error_label ?label dbg =
154154
if !Clflags.debug || !bound_error_sites = [] then begin
155155
let lbl_bound_error = new_label() in
156-
let lbl_frame = record_frame_label ?label Reg.Set.empty false dbg in
156+
let lbl_frame =
157+
record_frame_label ?label Reg.Set.empty false (Dbg_other dbg)
158+
in
157159
bound_error_sites :=
158160
{ bd_lbl = lbl_bound_error;
159161
bd_frame_lbl = lbl_frame } :: !bound_error_sites;
@@ -443,15 +445,15 @@ let emit_instr i =
443445
| Lop(Icall_ind { label_after; }) ->
444446
if !arch >= ARMv5 then begin
445447
` blx {emit_reg i.arg.(0)}\n`;
446-
`{record_frame i.live false i.dbg ~label:label_after}\n`; 1
448+
`{record_frame i.live false (Dbg_other i.dbg) ~label:label_after}\n`; 1
447449
end else begin
448450
` mov lr, pc\n`;
449451
` bx {emit_reg i.arg.(0)}\n`;
450-
`{record_frame i.live false i.dbg ~label:label_after}\n`; 2
452+
`{record_frame i.live false (Dbg_other i.dbg) ~label:label_after}\n`; 2
451453
end
452454
| Lop(Icall_imm { func; label_after; }) ->
453455
` {emit_call func}\n`;
454-
`{record_frame i.live false i.dbg ~label:label_after}\n`; 1
456+
`{record_frame i.live false (Dbg_other i.dbg) ~label:label_after}\n`; 1
455457
| Lop(Itailcall_ind { label_after = _; }) ->
456458
output_epilogue begin fun () ->
457459
if !contains_calls then
@@ -473,7 +475,7 @@ let emit_instr i =
473475
| Lop(Iextcall { func; alloc = true; label_after; }) ->
474476
let ninstr = emit_load_symbol_addr (phys_reg 7 (* r7 *)) func in
475477
` {emit_call "caml_c_call"}\n`;
476-
`{record_frame i.live false i.dbg ~label:label_after}\n`;
478+
`{record_frame i.live false (Dbg_other i.dbg) ~label:label_after}\n`;
477479
1 + ninstr
478480
| Lop(Istackoffset n) ->
479481
assert (n mod 8 = 0);
@@ -543,9 +545,9 @@ let emit_instr i =
543545
| Double_u -> "fstd"
544546
| _ (* 32-bit quantities *) -> "str" in
545547
` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1
546-
| Lop(Ialloc { words = n; label_after_call_gc; }) ->
548+
| Lop(Ialloc { words = n; blocks = dbg; label_after_call_gc; }) ->
547549
let lbl_frame =
548-
record_frame_label i.live false i.dbg ?label:label_after_call_gc
550+
record_frame_label i.live false (Dbg_alloc dbg) ?label:label_after_call_gc
549551
in
550552
if !fastcode_flag then begin
551553
let lbl_redo = new_label() in
@@ -794,7 +796,7 @@ let emit_instr i =
794796
begin match k with
795797
| Cmm.Raise_withtrace ->
796798
` {emit_call "caml_raise_exn"}\n`;
797-
`{record_frame Reg.Set.empty true i.dbg}\n`; 1
799+
`{record_frame Reg.Set.empty true (Dbg_other i.dbg)}\n`; 1
798800
| Cmm.Raise_notrace ->
799801
` mov sp, trap_ptr\n`;
800802
` pop \{trap_ptr, pc}\n`; 2
@@ -948,7 +950,7 @@ let end_assembly () =
948950
` .word {emit_label lbl}\n`);
949951
efa_16 = (fun n -> ` .short {emit_int n}\n`);
950952
efa_32 = (fun n -> ` .long {emit_int32 n}\n`);
951-
efa_word = (fun n -> ` .word {emit_int n}\n`);
953+
efa_word = (fun n -> ` .word {emit_nativeint n}\n`);
952954
efa_align = (fun n -> ` .align {emit_int(Misc.log2 n)}\n`);
953955
efa_label_rel = (fun lbl ofs ->
954956
` .word {emit_label lbl} - . + {emit_int32 ofs}\n`);

‎asmcomp/arm64/emit.mlp‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -140,7 +140,7 @@ let record_frame_label ?label live raise_ dbg =
140140
fd_frame_size = frame_size();
141141
fd_live_offset = !live_offset;
142142
fd_raise = raise_;
143-
fd_debuginfo = dbg } :: !frame_descriptors;
143+
fd_debuginfo = Dbg_other dbg } :: !frame_descriptors;
144144
lbl
145145

146146
let record_frame ?label live raise_ dbg =
@@ -498,7 +498,7 @@ module BR = Branch_relaxation.Make (struct
498498
| Cmm.Raise_notrace -> 4
499499
end
500500

501-
let relax_allocation ~num_words ~label_after_call_gc =
501+
let relax_allocation ~num_words ~blocks ~label_after_call_gc =
502502
Lop (Ispecific (Ifar_alloc { words = num_words; label_after_call_gc; }))
503503

504504
let relax_intop_checkbound ~label_after_error =
@@ -981,7 +981,7 @@ let end_assembly () =
981981
` .quad {emit_label lbl}\n`);
982982
efa_16 = (fun n -> ` .short {emit_int n}\n`);
983983
efa_32 = (fun n -> ` .long {emit_int32 n}\n`);
984-
efa_word = (fun n -> ` .quad {emit_int n}\n`);
984+
efa_word = (fun n -> ` .quad {emit_nativeint n}\n`);
985985
efa_align = (fun n -> ` .align {emit_int(Misc.log2 n)}\n`);
986986
efa_label_rel = (fun lbl ofs ->
987987
` .long {emit_label lbl} - . + {emit_int32 ofs}\n`);

‎asmcomp/branch_relaxation.ml‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -86,8 +86,9 @@ module Make (T : Branch_relaxation_intf.S) = struct
8686
fixup did_fix (pc + T.instr_size instr.desc) instr.next
8787
else
8888
match instr.desc with
89-
| Lop (Ialloc { words = num_words; label_after_call_gc; }) ->
90-
instr.desc <- T.relax_allocation ~num_words ~label_after_call_gc;
89+
| Lop (Ialloc { words = num_words; blocks; label_after_call_gc; }) ->
90+
instr.desc <- T.relax_allocation ~num_words ~blocks
91+
~label_after_call_gc;
9192
fixup true (pc + T.instr_size instr.desc) instr.next
9293
| Lop (Iintop (Icheckbound { label_after_error; })) ->
9394
instr.desc <- T.relax_intop_checkbound ~label_after_error;

‎asmcomp/branch_relaxation_intf.ml‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -62,6 +62,7 @@ module type S = sig
6262
the size of out-of-line code (cf. branch_relaxation.mli). *)
6363
val relax_allocation
6464
: num_words:int
65+
-> blocks:Mach.alloc_info list
6566
-> label_after_call_gc:Cmm.label option
6667
-> Linearize.instruction_desc
6768
val relax_intop_checkbound

‎asmcomp/cmmgen.ml‎

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,6 @@ open Lambda
2424
open Clambda
2525
open Cmm
2626
open Cmx_format
27-
2827
(* Local binding of complex expressions *)
2928

3029
let bind name arg fn =
@@ -661,7 +660,7 @@ let make_alloc_generic set_fn dbg tag wordsize args =
661660
| e1::el -> Csequence(set_fn (Cvar id) (Cconst_int idx) e1,
662661
fill_fields (idx + 2) el) in
663662
Clet(id,
664-
Cop(Cextcall("caml_alloc", typ_val, true, Debuginfo.none, None),
663+
Cop(Cextcall("caml_alloc", typ_val, true, dbg, None),
665664
[Cconst_int wordsize; Cconst_int tag]),
666665
fill_fields 1 args)
667666
end
@@ -1731,7 +1730,7 @@ let rec transl env e =
17311730
and transl_make_array dbg env kind args =
17321731
match kind with
17331732
| Pgenarray ->
1734-
Cop(Cextcall("caml_make_array", typ_val, true, Debuginfo.none, None),
1733+
Cop(Cextcall("caml_make_array", typ_val, true, dbg, None),
17351734
[make_alloc dbg 0 (List.map (transl env) args)])
17361735
| Paddrarray | Pintarray ->
17371736
make_alloc dbg 0 (List.map (transl env) args)

0 commit comments

Comments
 (0)