reap.h

   1 /* This file is part of the indirect Perl module.
   2  * See http://search.cpan.org/dist/indirect/ */
   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 */