]> git.vpit.fr Git - perl/modules/Thread-Cleanup.git/blob - Cleanup.xs
Fix for {ENTER,LEAVE}_with_name
[perl/modules/Thread-Cleanup.git] / 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  }