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         (void)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         PERL_UNUSED_VAR(items);
  49         RETVAL = newSVpvn(
  50                    (char *)&cxstack[cxstack_ix].blk_sub.retop, sizeof(OP *)
  51                  );
  52     OUTPUT:
  53         RETVAL