1 /* This file is part of the autovivification Perl module.
2 * See http://search.cpan.org/dist/autovivification/ */
4 /* This header provides a specialized version of Scope::Upper::reap that can be
5 * called directly from XS.
6 * See http://search.cpan.org/dist/Scope-Upper/ for details. */
11 #define REAP_DESTRUCTOR_SIZE 3
16 void (*cb)(pTHX_ void *);
21 STATIC void reap_pop(pTHX_ void *);
23 STATIC void reap_pop(pTHX_ void *ud_) {
25 I32 depth, *origin, mark, base;
30 base = origin[depth - 1];
33 PL_savestack_ix = mark;
36 PL_savestack_ix = base;
38 if ((ud->depth = --depth) > 0) {
39 SAVEDESTRUCTOR_X(reap_pop, ud);
41 void (*cb)(pTHX_ void *) = ud->cb;
44 PerlMemShared_free(ud->origin);
45 PerlMemShared_free(ud);
47 SAVEDESTRUCTOR_X(cb, cb_ud);
51 STATIC void reap(pTHX_ I32 depth, void (*cb)(pTHX_ void *), void *cb_ud) {
52 #define reap(D, CB, UD) reap(aTHX_ (D), (CB), (UD))
56 if (depth > PL_scopestack_ix)
57 depth = PL_scopestack_ix;
59 ud = PerlMemShared_malloc(sizeof *ud);
61 ud->origin = PerlMemShared_malloc((depth + 1) * sizeof *ud->origin);
66 for (i = depth; i >= 1; --i) {
67 I32 j = PL_scopestack_ix - i;
68 ud->origin[depth - i] = PL_scopestack[j];
69 PL_scopestack[j] += REAP_DESTRUCTOR_SIZE;
71 ud->origin[depth] = PL_savestack_ix;
73 while (PL_savestack_ix + REAP_DESTRUCTOR_SIZE
74 <= PL_scopestack[PL_scopestack_ix - 1]) {
75 save_pptr(&ud->dummy);
78 SAVEDESTRUCTOR_X(reap_pop, ud);