]> git.vpit.fr Git - perl/modules/autovivification.git/blob - reap.h
Add BUILD_REQUIRES to WriteMakefile()
[perl/modules/autovivification.git] / reap.h
1 /* This file is part of the autovivification Perl module.
2  * See http://search.cpan.org/dist/autovivification/ */
3
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. */
7
8 #ifndef REAP_H
9 #define REAP_H 1
10
11 #define REAP_DESTRUCTOR_SIZE 3
12
13 typedef struct {
14  I32    depth;
15  I32   *origin;
16  void (*cb)(pTHX_ void *);
17  void  *ud;
18  char  *dummy;
19 } reap_ud;
20
21 STATIC void reap_pop(pTHX_ void *);
22
23 STATIC void reap_pop(pTHX_ void *ud_) {
24  reap_ud *ud = ud_;
25  I32 depth, *origin, mark, base;
26
27  depth  = ud->depth;
28  origin = ud->origin;
29  mark   = origin[depth];
30  base   = origin[depth - 1];
31
32  if (base < mark) {
33   PL_savestack_ix = mark;
34   leave_scope(base);
35  }
36  PL_savestack_ix = base;
37
38  if ((ud->depth = --depth) > 0) {
39   SAVEDESTRUCTOR_X(reap_pop, ud);
40  } else {
41   void (*cb)(pTHX_ void *) = ud->cb;
42   void  *cb_ud             = ud->ud;
43
44   PerlMemShared_free(ud->origin);
45   PerlMemShared_free(ud);
46
47   SAVEDESTRUCTOR_X(cb, cb_ud);
48  }
49 }
50
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))
53  reap_ud *ud;
54  I32 i;
55
56  if (depth > PL_scopestack_ix)
57   depth = PL_scopestack_ix;
58
59  ud         = PerlMemShared_malloc(sizeof *ud);
60  ud->depth  = depth;
61  ud->origin = PerlMemShared_malloc((depth + 1) * sizeof *ud->origin);
62  ud->cb     = cb;
63  ud->ud     = cb_ud;
64  ud->dummy  = NULL;
65
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;
70  }
71  ud->origin[depth] = PL_savestack_ix;
72
73  while (PL_savestack_ix + REAP_DESTRUCTOR_SIZE
74                                        <= PL_scopestack[PL_scopestack_ix - 1]) {
75   save_pptr(&ud->dummy);
76  }
77
78  SAVEDESTRUCTOR_X(reap_pop, ud);
79 }
80
81 #endif /* REAP_H */