Cleanup.xs

   1 /* This file is part of the Scope::Upper Perl module.
   2  * See http://search.cpan.org/dist/Scope-Upper/ */
   3
   4 #define PERL_NO_GET_CONTEXT
   5 #include "EXTERN.h"
   6 #include "perl.h"
   7 #include "XSUB.h"
   8
   9 #define __PACKAGE__     "Thread::Cleanup"
  10 #define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)
  11
  12 STATIC void tc_callback(pTHX_ void *);
  13
  14 STATIC void tc_callback(pTHX_ void *ud) {
  15  int *level = ud;
  16  SV *id;
  17
  18  if (*level) {
  19   *level = 0;
  20   LEAVE;
  21   SAVEDESTRUCTOR_X(tc_callback, level);
  22   ENTER;
  23  } else {
  24   dSP;
  25
  26   PerlMemShared_free(level);
  27
  28   ENTER;
  29   SAVETMPS;
  30
  31   PUSHMARK(SP);
  32   PUTBACK;
  33
  34   call_pv(__PACKAGE__ "::_CLEANUP", G_VOID);
  35
  36   SPAGAIN;
  37
  38   FREETMPS;
  39   LEAVE;
  40  }
  41 }
  42
  43 MODULE = Thread::Cleanup            PACKAGE = Thread::Cleanup
  44
  45 PROTOTYPES: DISABLE
  46
  47 void
  48 CLONE(...)
  49 PREINIT:
  50  int *level;
  51 CODE:
  52  {
  53   level = PerlMemShared_malloc(sizeof *level);
  54   *level = 1;
  55   LEAVE;
  56   SAVEDESTRUCTOR_X(tc_callback, level);
  57   ENTER;
  58  }