ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Guard/Guard.xs
(Generate patch)

Comparing Guard/Guard.xs (file contents):
Revision 1.1 by root, Sat Dec 13 17:37:22 2008 UTC vs.
Revision 1.5 by root, Sat Dec 13 21:47:07 2008 UTC

1#define PERL_NO_GET_CONTEXT 1#define PERL_NO_GET_CONTEXT
2 2
3#include "EXTERN.h" 3#include "EXTERN.h"
4#include "perl.h" 4#include "perl.h"
5#include "XSUB.h" 5#include "XSUB.h"
6
7static HV *guard_stash;
6 8
7static SV * 9static SV *
8guard_get_cv (pTHX_ SV *cb_sv) 10guard_get_cv (pTHX_ SV *cb_sv)
9{ 11{
10 HV *st; 12 HV *st;
… …
20static void 22static void
21exec_guard_cb (pTHX_ SV *cb) 23exec_guard_cb (pTHX_ SV *cb)
22{ 24{
23 dSP; 25 dSP;
24 SV *saveerr = SvOK (ERRSV) ? sv_mortalcopy (ERRSV) : 0; 26 SV *saveerr = SvOK (ERRSV) ? sv_mortalcopy (ERRSV) : 0;
27 SV *savedie = PL_diehook;
25 28
29 PL_diehook = 0;
30
26 PUSHSTACKi(PERLSI_DESTROY); 31 PUSHSTACKi (PERLSI_DESTROY);
27 32
28 PUSHMARK (SP); 33 PUSHMARK (SP);
29 PUTBACK; 34 PUTBACK;
30 call_sv (cb, G_VOID | G_DISCARD | G_EVAL); 35 call_sv (cb, G_VOID | G_DISCARD | G_EVAL);
31 SPAGAIN; 36 SPAGAIN;
… …
35 PUSHMARK (SP); 40 PUSHMARK (SP);
36 PUTBACK; 41 PUTBACK;
37 call_sv (get_sv ("Guard::DIED", 1), G_VOID | G_DISCARD | G_EVAL | G_KEEPERR); 42 call_sv (get_sv ("Guard::DIED", 1), G_VOID | G_DISCARD | G_EVAL | G_KEEPERR);
38 SPAGAIN; 43 SPAGAIN;
39 44
40 sv_setsv (ERRSV, &PL_sv_undef); 45 sv_setpvn (ERRSV, "", 0);
41 } 46 }
42 47
43 if (saveerr) 48 if (saveerr)
44 sv_setsv (ERRSV, saveerr); 49 sv_setsv (ERRSV, saveerr);
50
51 {
52 SV *oldhook = PL_diehook;
53 PL_diehook = savedie;
54 SvREFCNT_dec (oldhook);
55 }
45 56
46 POPSTACK; 57 POPSTACK;
47} 58}
48 59
49static void 60static void
… …
63 guard_free 74 guard_free
64}; 75};
65 76
66MODULE = Guard PACKAGE = Guard 77MODULE = Guard PACKAGE = Guard
67 78
79BOOT:
80 guard_stash = gv_stashpv ("Guard", 1);
81
82void
83CLONE (...)
84 PROTOTYPE: @
85 CODE:
86 guard_stash = gv_stashpv ("Guard", 1);
87
68void 88void
69scope_guard (SV *block) 89scope_guard (SV *block)
70 PROTOTYPE: & 90 PROTOTYPE: &
71 CODE: 91 CODE:
72 LEAVE; /* unfortunately, perl sandwiches XS calls into ENTER/LEAVE */ 92 LEAVE; /* unfortunately, perl sandwiches XS calls into ENTER/LEAVE */
… …
81 SV *cv = guard_get_cv (aTHX_ block); 101 SV *cv = guard_get_cv (aTHX_ block);
82 SV *guard = NEWSV (0, 0); 102 SV *guard = NEWSV (0, 0);
83 SvUPGRADE (guard, SVt_PVMG); 103 SvUPGRADE (guard, SVt_PVMG);
84 sv_magicext (guard, cv, PERL_MAGIC_ext, &guard_vtbl, 0, 0); 104 sv_magicext (guard, cv, PERL_MAGIC_ext, &guard_vtbl, 0, 0);
85 RETVAL = newRV_noinc (guard); 105 RETVAL = newRV_noinc (guard);
106 SvOBJECT_on (guard);
107 ++PL_sv_objcount;
108 SvSTASH_set (guard, (HV*)SvREFCNT_inc ((SV *)guard_stash));
86} 109}
87 OUTPUT: 110 OUTPUT:
88 RETVAL 111 RETVAL
89 112
90void 113void

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines