Cleanup.xs

   1 /* This file is part of the Thread::Cleanup Perl module.
   2  * See http://search.cpan.org/dist/Thread-Cleanup/ */
   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 #ifndef ENTER_with_name
  13 # define ENTER_with_name(N) ENTER
  14 #endif
  15
  16 #ifndef LEAVE_with_name
  17 # define LEAVE_with_name(N) LEAVE
  18 #endif
  19
  20 STATIC void tc_callback(pTHX_ void *);
  21
  22 STATIC void tc_callback(pTHX_ void *ud) {
  23  int *level = ud;
  24  SV *id;
  25
  26  if (*level) {
  27   *level = 0;
  28   LEAVE;
  29   SAVEDESTRUCTOR_X(tc_callback, level);
  30   ENTER;
  31  } else {
  32   dSP;
  33
  34   PerlMemShared_free(level);
  35
  36   ENTER;
  37   SAVETMPS;
  38
  39   PUSHMARK(SP);
  40   PUTBACK;
  41
  42   call_pv(__PACKAGE__ "::_CLEANUP", G_VOID | G_EVAL);
  43
  44   PUTBACK;
  45
  46   FREETMPS;
  47   LEAVE;
  48  }
  49 }
  50
  51 MODULE = Thread::Cleanup            PACKAGE = Thread::Cleanup
  52
  53 PROTOTYPES: DISABLE
  54
  55 void
  56 CLONE(...)
  57 PREINIT:
  58  int *level;
  59 CODE:
  60  {
  61   level = PerlMemShared_malloc(sizeof *level);
  62   *level = 1;
  63   LEAVE_with_name("sub");
  64   SAVEDESTRUCTOR_X(tc_callback, level);
  65   ENTER_with_name("sub");
  66  }