rpms/ocaml
5
0
Fork 0
Code Issues Pull Requests Releases Activity
db6ffb193e
ocaml/0006-Retain-debug-information-about-allocation-sizes-for-.patch
Richard W.M. Jones db6ffb193e Fix RISC-V backend.
2020-04-11 18:59:33 +01:00

621 lines
22 KiB
Diff
Raw Blame History

From dac12e5db7f4ca4a32b0eccea1d16d27f9df86d2 Mon Sep 17 00:00:00 2001
From: Stephen Dolan <sdolan@janestreet.com>
Date: Tue, 16 Jul 2019 16:24:01 +0100
Subject: [PATCH 6/8] Retain debug information about allocation sizes, for
statmemprof.
This code is adapted from jhjourdan's 2c93ca1e711. Comballoc is
extended to keep track of allocation sizes and debug info for each
allocation, and the frame table format is modified to store them.
The native code GC-entry logic is changed to match bytecode, by
calling the garbage collector at most once per allocation.
amd64 only, for now.
(cherry picked from commit 34f97941ec302129f516c926c9ef65e4d68b8121)
---
asmcomp/amd64/emit.mlp | 30 ++++++++-----------
asmcomp/comballoc.ml | 55 +++++++++++++++++++---------------
asmcomp/emitaux.ml | 22 ++++++++++++++
asmcomp/emitaux.mli | 1 +
asmcomp/mach.ml | 6 +++-
asmcomp/mach.mli | 11 ++++++-
asmcomp/selectgen.ml | 8 +++--
asmcomp/spacetime_profiling.ml | 1 +
runtime/amd64.S | 53 ++++----------------------------
runtime/backtrace_nat.c | 16 ++++++++--
runtime/caml/stack.h | 10 +++++--
runtime/minor_gc.c | 5 ++++
runtime/roots_nat.c | 5 ++++
runtime/signals_nat.c | 37 +++++++++++------------
14 files changed, 143 insertions(+), 117 deletions(-)
diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp
index 69cc48b6d..6c3950a6d 100644
--- a/asmcomp/amd64/emit.mlp
+++ b/asmcomp/amd64/emit.mlp
@@ -299,13 +299,7 @@ let emit_call_gc gc =
assert Config.spacetime;
spacetime_before_uninstrumented_call ~node_ptr ~index
end;
- begin match gc.gc_size with
- | 16 -> emit_call "caml_call_gc1"
- | 24 -> emit_call "caml_call_gc2"
- | 32 -> emit_call "caml_call_gc3"
- | n -> I.add (int n) r15;
- emit_call "caml_call_gc"
- end;
+ emit_call "caml_call_gc";
def_label gc.gc_frame;
I.jmp (label gc.gc_return_lbl)
@@ -667,21 +661,21 @@ let emit_instr fallthrough i =
| Double | Double_u ->
I.movsd (arg i 0) (addressing addr REAL8 i 1)
end
- | Lop(Ialloc { bytes = n; label_after_call_gc; spacetime_index; }) ->
- if !fastcode_flag then begin
- let lbl_redo = new_label() in
- def_label lbl_redo;
+ | Lop(Ialloc { bytes = n; label_after_call_gc; spacetime_index; dbginfo }) ->
+ let dbginfo =
+ if not !Clflags.debug && not Config.spacetime then
+ List.map (fun d -> { d with alloc_dbg = Debuginfo.none }) dbginfo
+ else dbginfo in
+ if !fastcode_flag then begin
I.sub (int n) r15;
I.cmp (domain_field Domainstate.Domain_young_limit) r15;
let lbl_call_gc = new_label() in
- let dbg =
- if not Config.spacetime then Debuginfo.none
- else i.dbg
- in
let lbl_frame =
- record_frame_label ?label:label_after_call_gc i.live (Dbg_other dbg)
+ record_frame_label ?label:label_after_call_gc i.live (Dbg_alloc dbginfo)
in
I.jb (label lbl_call_gc);
+ let lbl_after_alloc = new_label() in
+ def_label lbl_after_alloc;
I.lea (mem64 NONE 8 R15) (res i 0);
let gc_spacetime =
if not Config.spacetime then None
@@ -690,7 +684,7 @@ let emit_instr fallthrough i =
call_gc_sites :=
{ gc_size = n;
gc_lbl = lbl_call_gc;
- gc_return_lbl = lbl_redo;
+ gc_return_lbl = lbl_after_alloc;
gc_frame = lbl_frame;
gc_spacetime; } :: !call_gc_sites
end else begin
@@ -708,7 +702,7 @@ let emit_instr fallthrough i =
end;
let label =
record_frame_label ?label:label_after_call_gc i.live
- (Dbg_other i.dbg)
+ (Dbg_alloc dbginfo)
in
def_label label;
I.lea (mem64 NONE 8 R15) (res i 0)
diff --git a/asmcomp/comballoc.ml b/asmcomp/comballoc.ml
index 29ee15b36..b8ebcf374 100644
--- a/asmcomp/comballoc.ml
+++ b/asmcomp/comballoc.ml
@@ -17,34 +17,41 @@
open Mach
+type pending_alloc =
+ { reg: Reg.t; (* register holding the result of the last allocation *)
+ dbginfos: alloc_dbginfo list; (* debug info for each pending allocation *)
+ totalsz: int } (* amount to be allocated in this block *)
+
type allocation_state =
No_alloc
- | Pending_alloc of
- { reg: Reg.t; (* register holding the result of the last allocation *)
- totalsz: int } (* amount to be allocated in this block *)
-
-let allocated_size = function
- No_alloc -> 0
- | Pending_alloc {totalsz; _} -> totalsz
+ | Pending_alloc of pending_alloc
let rec combine i allocstate =
match i.desc with
Iend | Ireturn | Iexit _ | Iraise _ ->
- (i, allocated_size allocstate)
- | Iop(Ialloc { bytes = sz; _ }) ->
+ (i, allocstate)
+ | Iop(Ialloc { bytes = sz; dbginfo; _ }) ->
begin match allocstate with
- | Pending_alloc {reg; totalsz}
+ | Pending_alloc {reg; dbginfos; totalsz}
when totalsz + sz < Config.max_young_wosize * Arch.size_addr ->
let (next, totalsz) =
combine i.next
- (Pending_alloc { reg = i.res.(0); totalsz = totalsz + sz }) in
+ (Pending_alloc { reg = i.res.(0);
+ dbginfos = dbginfo @ dbginfos;
+ totalsz = totalsz + sz }) in
(instr_cons_debug (Iop(Iintop_imm(Iadd, -sz)))
[| reg |] i.res i.dbg next,
totalsz)
| No_alloc | Pending_alloc _ ->
- let (next, totalsz) =
+ let (next, state) =
combine i.next
- (Pending_alloc { reg = i.res.(0); totalsz = sz }) in
+ (Pending_alloc { reg = i.res.(0);
+ dbginfos = dbginfo;
+ totalsz = sz }) in
+ let totalsz, dbginfo =
+ match state with
+ | No_alloc -> 0, dbginfo
+ | Pending_alloc { totalsz; dbginfos; _ } -> totalsz, dbginfos in
let next =
let offset = totalsz - sz in
if offset = 0 then next
@@ -52,40 +59,40 @@ let rec combine i allocstate =
i.res i.dbg next
in
(instr_cons_debug (Iop(Ialloc {bytes = totalsz; spacetime_index = 0;
- label_after_call_gc = None; }))
- i.arg i.res i.dbg next, allocated_size allocstate)
+ dbginfo; label_after_call_gc = None; }))
+ i.arg i.res i.dbg next, allocstate)
end
| Iop(Icall_ind _ | Icall_imm _ | Iextcall _ |
Itailcall_ind _ | Itailcall_imm _) ->
let newnext = combine_restart i.next in
(instr_cons_debug i.desc i.arg i.res i.dbg newnext,
- allocated_size allocstate)
+ allocstate)
| Iop _ ->
- let (newnext, sz) = combine i.next allocstate in
- (instr_cons_debug i.desc i.arg i.res i.dbg newnext, sz)
+ let (newnext, s') = combine i.next allocstate in
+ (instr_cons_debug i.desc i.arg i.res i.dbg newnext, s')
| Iifthenelse(test, ifso, ifnot) ->
let newifso = combine_restart ifso in
let newifnot = combine_restart ifnot in
let newnext = combine_restart i.next in
(instr_cons (Iifthenelse(test, newifso, newifnot)) i.arg i.res newnext,
- allocated_size allocstate)
+ allocstate)
| Iswitch(table, cases) ->
let newcases = Array.map combine_restart cases in
let newnext = combine_restart i.next in
(instr_cons (Iswitch(table, newcases)) i.arg i.res newnext,
- allocated_size allocstate)
+ allocstate)
| Icatch(rec_flag, handlers, body) ->
- let (newbody, sz) = combine body allocstate in
+ let (newbody, s') = combine body allocstate in
let newhandlers =
List.map (fun (io, handler) -> io, combine_restart handler) handlers in
let newnext = combine_restart i.next in
(instr_cons (Icatch(rec_flag, newhandlers, newbody))
- i.arg i.res newnext, sz)
+ i.arg i.res newnext, s')
| Itrywith(body, handler) ->
- let (newbody, sz) = combine body allocstate in
+ let (newbody, s') = combine body allocstate in
let newhandler = combine_restart handler in
let newnext = combine_restart i.next in
- (instr_cons (Itrywith(newbody, newhandler)) i.arg i.res newnext, sz)
+ (instr_cons (Itrywith(newbody, newhandler)) i.arg i.res newnext, s')
and combine_restart i =
let (newi, _) = combine i No_alloc in newi
diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml
index 9e7221096..8ed63af28 100644
--- a/asmcomp/emitaux.ml
+++ b/asmcomp/emitaux.ml
@@ -106,6 +106,7 @@ let emit_float32_directive directive x =
(* Record live pointers at call points *)
type frame_debuginfo =
+ | Dbg_alloc of Mach.alloc_dbginfo list
| Dbg_raise of Debuginfo.t
| Dbg_other of Debuginfo.t
@@ -173,6 +174,10 @@ let emit_frames a =
match fd.fd_debuginfo with
| Dbg_other d | Dbg_raise d ->
if Debuginfo.is_none d then 0 else 1
+ | Dbg_alloc dbgs ->
+ if List.for_all (fun d ->
+ Debuginfo.is_none d.Mach.alloc_dbg) dbgs
+ then 2 else 3
in
a.efa_code_label fd.fd_lbl;
a.efa_16 (fd.fd_frame_size + flags);
@@ -187,6 +192,23 @@ let emit_frames a =
| Dbg_raise dbg ->
a.efa_align 4;
a.efa_label_rel (label_debuginfos true dbg) Int32.zero
+ | Dbg_alloc dbg ->
+ assert (List.length dbg < 256);
+ a.efa_8 (List.length dbg);
+ List.iter (fun Mach.{alloc_words;_} ->
+ (* Possible allocations range between 2 and 257 *)
+ assert (2 <= alloc_words &&
+ alloc_words - 1 <= Config.max_young_wosize &&
+ Config.max_young_wosize <= 256);
+ a.efa_8 (alloc_words - 2)) dbg;
+ if flags = 3 then begin
+ a.efa_align 4;
+ List.iter (fun Mach.{alloc_dbg; _} ->
+ if Debuginfo.is_none alloc_dbg then
+ a.efa_32 Int32.zero
+ else
+ a.efa_label_rel (label_debuginfos false alloc_dbg) Int32.zero) dbg
+ end
end;
a.efa_align Arch.size_addr
in
diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli
index a4a60e07c..1a8982a07 100644
--- a/asmcomp/emitaux.mli
+++ b/asmcomp/emitaux.mli
@@ -39,6 +39,7 @@ val emit_debug_info_gen :
(file_num:int -> line:int -> col:int -> unit) -> unit
type frame_debuginfo =
+ | Dbg_alloc of Mach.alloc_dbginfo list
| Dbg_raise of Debuginfo.t
| Dbg_other of Debuginfo.t
diff --git a/asmcomp/mach.ml b/asmcomp/mach.ml
index ab69e0ca3..8df94d039 100644
--- a/asmcomp/mach.ml
+++ b/asmcomp/mach.ml
@@ -39,6 +39,10 @@ type test =
| Ioddtest
| Ieventest
+type alloc_dbginfo =
+ { alloc_words : int;
+ alloc_dbg : Debuginfo.t }
+
type operation =
Imove
| Ispill
@@ -55,7 +59,7 @@ type operation =
| Iload of Cmm.memory_chunk * Arch.addressing_mode
| Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
| Ialloc of { bytes : int; label_after_call_gc : label option;
- spacetime_index : int; }
+ dbginfo : alloc_dbginfo list; spacetime_index : int; }
| Iintop of integer_operation
| Iintop_imm of integer_operation * int
| Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf
diff --git a/asmcomp/mach.mli b/asmcomp/mach.mli
index 5df79585c..fd3e033bf 100644
--- a/asmcomp/mach.mli
+++ b/asmcomp/mach.mli
@@ -46,6 +46,15 @@ type test =
| Ioddtest
| Ieventest
+type alloc_dbginfo =
+ { alloc_words : int;
+ alloc_dbg : Debuginfo.t }
+(** Due to Comballoc, a single Ialloc instruction may combine several
+ unrelated allocations. Their Debuginfo.t (which may differ) are stored
+ as a list of alloc_dbginfo. This list is in order of increasing memory
+ address, which is the reverse of the original allocation order. Later
+ allocations are consed to the front of this list by Comballoc. *)
+
type operation =
Imove
| Ispill
@@ -63,7 +72,7 @@ type operation =
| Istore of Cmm.memory_chunk * Arch.addressing_mode * bool
(* false = initialization, true = assignment *)
| Ialloc of { bytes : int; label_after_call_gc : label option;
- spacetime_index : int; }
+ dbginfo : alloc_dbginfo list; spacetime_index : int; }
(** For Spacetime only, Ialloc instructions take one argument, being the
pointer to the trie node for the current function. *)
| Iintop of integer_operation
diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml
index b024dfe7d..d5f54b699 100644
--- a/asmcomp/selectgen.ml
+++ b/asmcomp/selectgen.ml
@@ -419,7 +419,8 @@ method mark_instr = function
(* Default instruction selection for operators *)
method select_allocation bytes =
- Ialloc { bytes; spacetime_index = 0; label_after_call_gc = None; }
+ Ialloc { bytes; label_after_call_gc = None;
+ dbginfo = []; spacetime_index = 0; }
method select_allocation_args _env = [| |]
method select_checkbound () =
@@ -775,8 +776,11 @@ method emit_expr (env:environment) exp =
| Ialloc { bytes = _; spacetime_index; label_after_call_gc; } ->
let rd = self#regs_for typ_val in
let bytes = size_expr env (Ctuple new_args) in
+ assert (bytes mod Arch.size_addr = 0);
+ let alloc_words = bytes / Arch.size_addr in
let op =
- Ialloc { bytes; spacetime_index; label_after_call_gc; }
+ Ialloc { bytes; spacetime_index; label_after_call_gc;
+ dbginfo = [{alloc_words; alloc_dbg = dbg}] }
in
let args = self#select_allocation_args env in
self#insert_debug env (Iop op) dbg args rd;
diff --git a/asmcomp/spacetime_profiling.ml b/asmcomp/spacetime_profiling.ml
index a61cd1c43..62e182ab9 100644
--- a/asmcomp/spacetime_profiling.ml
+++ b/asmcomp/spacetime_profiling.ml
@@ -396,6 +396,7 @@ class virtual instruction_selection = object (self)
in
Mach.Ialloc {
bytes;
+ dbginfo = [];
label_after_call_gc = Some label;
spacetime_index = index;
}
diff --git a/runtime/amd64.S b/runtime/amd64.S
index 77a4f85aa..03c1f4e81 100644
--- a/runtime/amd64.S
+++ b/runtime/amd64.S
@@ -425,111 +425,70 @@ ENDFUNCTION(G(caml_call_gc))
FUNCTION(G(caml_alloc1))
CFI_STARTPROC
-LBL(caml_alloc1):
subq $16, %r15
cmpq Caml_state(young_limit), %r15
jb LBL(100)
ret
LBL(100):
- addq $16, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8); */
call LBL(caml_call_gc)
/* addq $8, %rsp; CFI_ADJUST (-8); */
LEAVE_FUNCTION
- jmp LBL(caml_alloc1)
+ ret
CFI_ENDPROC
ENDFUNCTION(G(caml_alloc1))
FUNCTION(G(caml_alloc2))
CFI_STARTPROC
-LBL(caml_alloc2):
subq $24, %r15
cmpq Caml_state(young_limit), %r15
jb LBL(101)
ret
LBL(101):
- addq $24, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8); */
call LBL(caml_call_gc)
/* addq $8, %rsp; CFI_ADJUST (-8); */
LEAVE_FUNCTION
- jmp LBL(caml_alloc2)
+ ret
CFI_ENDPROC
ENDFUNCTION(G(caml_alloc2))
FUNCTION(G(caml_alloc3))
CFI_STARTPROC
-LBL(caml_alloc3):
subq $32, %r15
cmpq Caml_state(young_limit), %r15
jb LBL(102)
ret
LBL(102):
- addq $32, %r15
RECORD_STACK_FRAME(0)
ENTER_FUNCTION
/* subq $8, %rsp; CFI_ADJUST (8) */
call LBL(caml_call_gc)
/* addq $8, %rsp; CFI_ADJUST (-8) */
LEAVE_FUNCTION
- jmp LBL(caml_alloc3)
+ ret
CFI_ENDPROC
ENDFUNCTION(G(caml_alloc3))
FUNCTION(G(caml_allocN))
CFI_STARTPROC
-LBL(caml_allocN):
- pushq %rax; CFI_ADJUST(8) /* save desired size */
subq %rax, %r15
cmpq Caml_state(young_limit), %r15
jb LBL(103)
- addq $8, %rsp; CFI_ADJUST (-8) /* drop desired size */
ret
LBL(103):
- addq 0(%rsp), %r15
- CFI_ADJUST(8)
- RECORD_STACK_FRAME(8)
-#ifdef WITH_FRAME_POINTERS
- /* ensure 16 byte alignment by subq + enter using 16-bytes, PR#7417 */
- subq $8, %rsp; CFI_ADJUST (8)
+ RECORD_STACK_FRAME(0)
ENTER_FUNCTION
-#endif
call LBL(caml_call_gc)
-#ifdef WITH_FRAME_POINTERS
- /* ensure 16 byte alignment by leave + addq using 16-bytes PR#7417 */
LEAVE_FUNCTION
- addq $8, %rsp; CFI_ADJUST (-8)
-#endif
- popq %rax; CFI_ADJUST(-8) /* recover desired size */
- jmp LBL(caml_allocN)
+ ret
CFI_ENDPROC
ENDFUNCTION(G(caml_allocN))
-
-/* Reset the allocation pointer and invoke the GC */
-
-FUNCTION(G(caml_call_gc1))
-CFI_STARTPROC
- addq $16, %r15
- jmp GCALL(caml_call_gc)
-CFI_ENDPROC
-
-FUNCTION(G(caml_call_gc2))
-CFI_STARTPROC
- addq $24, %r15
- jmp GCALL(caml_call_gc)
-CFI_ENDPROC
-
-FUNCTION(G(caml_call_gc3))
-CFI_STARTPROC
- addq $32, %r15
- jmp GCALL(caml_call_gc)
-CFI_ENDPROC
-
-
+
/* Call a C function from OCaml */
FUNCTION(G(caml_c_call))
diff --git a/runtime/backtrace_nat.c b/runtime/backtrace_nat.c
index acf31d644..ee18f2a00 100644
--- a/runtime/backtrace_nat.c
+++ b/runtime/backtrace_nat.c
@@ -146,8 +146,20 @@ debuginfo caml_debuginfo_extract(backtrace_slot slot)
}
/* Recover debugging info */
infoptr = (unsigned char*)&d->live_ofs[d->num_live];
- /* align to 32 bits */
- infoptr = Align_to(infoptr, uint32_t);
+ if (d->frame_size & 2) {
+ /* skip alloc_lengths */
+ infoptr += *infoptr + 1;
+ /* align to 32 bits */
+ infoptr = Align_to(infoptr, uint32_t);
+ /* we know there's at least one valid debuginfo,
+ but it may not be the one for the first alloc */
+ while (*(uint32_t*)infoptr == 0) {
+ infoptr += sizeof(uint32_t);
+ }
+ } else {
+ /* align to 32 bits */
+ infoptr = Align_to(infoptr, uint32_t);
+ }
/* read offset to debuginfo */
debuginfo_offset = *(uint32_t*)infoptr;
return (debuginfo)(infoptr + debuginfo_offset);
diff --git a/runtime/caml/stack.h b/runtime/caml/stack.h
index 30a18d274..44a881e41 100644
--- a/runtime/caml/stack.h
+++ b/runtime/caml/stack.h
@@ -89,9 +89,15 @@ typedef struct {
unsigned short num_live;
unsigned short live_ofs[1 /* num_live */];
/*
+ If frame_size & 2, then allocation info follows:
+ unsigned char num_allocs;
+ unsigned char alloc_lengths[num_alloc];
+
If frame_size & 1, then debug info follows:
- uint32_t debug_info_offset;
- Debug info is stored as a relative offset to a debuginfo structure. */
+ uint32_t debug_info_offset[num_debug];
+
+ Debug info is stored as relative offsets to debuginfo structures.
+ num_debug is num_alloc if frame_size & 2, otherwise 1. */
} frame_descr;
/* Used to compute offsets in frame tables.
diff --git a/runtime/minor_gc.c b/runtime/minor_gc.c
index e4dacfc51..4b3634275 100644
--- a/runtime/minor_gc.c
+++ b/runtime/minor_gc.c
@@ -509,6 +509,11 @@ void caml_alloc_small_dispatch (tag_t tag, intnat wosize, int flags)
callbacks. */
CAML_INSTR_INT ("force_minor/alloc_small@", 1);
caml_gc_dispatch ();
+#if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
+ if (caml_young_ptr == caml_young_alloc_end) {
+ caml_spacetime_automatic_snapshot();
+ }
+#endif
}
/* Re-do the allocation: we now have enough space in the minor heap. */
diff --git a/runtime/roots_nat.c b/runtime/roots_nat.c
index f61e56d90..b98555838 100644
--- a/runtime/roots_nat.c
+++ b/runtime/roots_nat.c
@@ -83,6 +83,11 @@ static frame_descr * next_frame_descr(frame_descr * d) {
CAMLassert(d->retaddr >= 4096);
/* Skip to end of live_ofs */
p = (unsigned char*)&d->live_ofs[d->num_live];
+ /* Skip alloc_lengths if present */
+ if (d->frame_size & 2) {
+ num_allocs = *p;
+ p += num_allocs + 1;
+ }
/* Skip debug info if present */
if (d->frame_size & 1) {
/* Align to 32 bits */
diff --git a/runtime/signals_nat.c b/runtime/signals_nat.c
index 017298394..075db46e3 100644
--- a/runtime/signals_nat.c
+++ b/runtime/signals_nat.c
@@ -69,29 +69,26 @@ extern char caml_system__code_begin, caml_system__code_end;
void caml_garbage_collection(void)
{
- /* TEMPORARY: if we have just sampled an allocation in native mode,
- we simply renew the sample to ignore it. Otherwise, renewing now
- will not have any effect on the sampling distribution, because of
- the memorylessness of the Bernoulli process.
-
- FIXME: if the sampling rate is 1, this leads to infinite loop,
- because we are using a binomial distribution in [memprof.c]. This
- will go away when the sampling of natively allocated blocks will
- be correctly implemented.
- */
- caml_memprof_renew_minor_sample();
- if (Caml_state->requested_major_slice || Caml_state->requested_minor_gc ||
- Caml_state->young_ptr - Caml_state->young_trigger < Max_young_whsize){
- caml_gc_dispatch ();
+ frame_descr* d;
+ uintnat h;
+ h = Hash_retaddr(Caml_state->last_return_address);
+ while (1) {
+ d = caml_frame_descriptors[h];
+ if (d->retaddr == Caml_state->last_return_address) break;
+ h = (h + 1) & caml_frame_descriptors_mask;
}
-#ifdef WITH_SPACETIME
- if (Caml_state->young_ptr == Caml_state->young_alloc_end) {
- caml_spacetime_automatic_snapshot();
- }
-#endif
+ /* Must be an allocation frame */
+ CAMLassert(d && d->frame_size != 0xFFFF && (d->frame_size & 2));
+
+ unsigned char* alloc_len = (unsigned char*)(&d->live_ofs[d->num_live]);
+ int nallocs = *alloc_len++;
+ int allocsz = 0;
+ for (int i = 0; i < nallocs; i++) allocsz += alloc_len[i] + 2;
+ allocsz -= 1;
- caml_raise_if_exception(caml_do_pending_actions_exn());
+ caml_alloc_small_dispatch(0 /* FIXME */, allocsz,
+ /* CAML_DO_TRACK | */ CAML_FROM_CAML);
}
DECLARE_SIGNAL_HANDLER(handle_signal)
--
2.24.1
Reference in New Issue View Git Blame Copy Permalink