/* This file is part of the Thread::Cleanup Perl module.
 * See http://search.cpan.org/dist/Thread-Cleanup/ */
   
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h" 
#include "XSUB.h"

#define __PACKAGE__     "Thread::Cleanup"
#define __PACKAGE_LEN__ (sizeof(__PACKAGE__)-1)

#define TC_HAS_PERL(R, V, S) (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > (V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S))))))

#undef ENTERn
#if defined(ENTER_with_name) && !TC_HAS_PERL(5, 11, 4)
# define ENTERn(N) ENTER_with_name(N)
#else
# define ENTERn(N) ENTER
#endif

#undef LEAVEn
#if defined(LEAVE_with_name) && !TC_HAS_PERL(5, 11, 4)
# define LEAVEn(N) LEAVE_with_name(N)
#else
# define LEAVEn(N) LEAVE
#endif

STATIC void tc_callback(pTHX_ void *);

STATIC void tc_callback(pTHX_ void *ud) {
 int *level = ud;
 SV *id;

 if (*level) {
  *level = 0;
  LEAVE;
  SAVEDESTRUCTOR_X(tc_callback, level);
  ENTER;
 } else {
  dSP;

  PerlMemShared_free(level);

  ENTER;
  SAVETMPS;

  PUSHMARK(SP);
  PUTBACK;

  call_pv(__PACKAGE__ "::_CLEANUP", G_VOID | G_EVAL);

  PUTBACK;

  FREETMPS;
  LEAVE;
 }
}

MODULE = Thread::Cleanup            PACKAGE = Thread::Cleanup

PROTOTYPES: DISABLE

void
CLONE(...)
PREINIT:
 int *level;
CODE:
 {
  level = PerlMemShared_malloc(sizeof *level);
  *level = 1;
  LEAVEn("sub");
  SAVEDESTRUCTOR_X(tc_callback, level);
  ENTERn("sub");
 }