This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
{Dos,}Glob.xs: Skip freeing during global destruction
[perl5.git] / ext / File-DosGlob / DosGlob.xs
1 #define PERL_NO_GET_CONTEXT
2
3 #include "EXTERN.h"
4 #include "perl.h"
5 #include "XSUB.h"
6
7 #define MY_CXT_KEY "File::Glob::_guts" XS_VERSION
8
9 typedef struct {
10     HV *                x_DG_ENTRIES;
11     Perl_ophook_t       x_DG_OLD_OPHOOK;
12 } my_cxt_t;
13
14 START_MY_CXT
15
16 static void
17 glob_ophook(pTHX_ OP *o)
18 {
19   if (PL_dirty) return;
20   {
21     dMY_CXT;
22     if (!MY_CXT.x_DG_ENTRIES)
23         MY_CXT.x_DG_ENTRIES = get_hv("File::DosGlob::entries", 0);
24     if (MY_CXT.x_DG_ENTRIES)
25         hv_delete(MY_CXT.x_DG_ENTRIES, (char *)&o, sizeof(OP *),G_DISCARD);
26     if (MY_CXT.x_DG_OLD_OPHOOK) MY_CXT.x_DG_OLD_OPHOOK(aTHX_ o);
27   }
28 }
29
30 MODULE = File::DosGlob          PACKAGE = File::DosGlob
31
32 PROTOTYPES: DISABLE
33
34 BOOT:
35 {
36     MY_CXT_INIT;
37     {
38         dMY_CXT;
39         MY_CXT.x_DG_ENTRIES = NULL;
40         MY_CXT.x_DG_OLD_OPHOOK = PL_opfreehook;
41         PL_opfreehook = glob_ophook;
42     }
43 }
44
45 SV *
46 _callsite(...)
47     CODE:
48         RETVAL = newSVpvn(
49                    (char *)&cxstack[cxstack_ix].blk_sub.retop, sizeof(OP *)
50                  );
51     OUTPUT:
52         RETVAL