ext/ByteLoader/ByteLoader.xs

   1 #define PERL_NO_GET_CONTEXT
   2 #include "EXTERN.h"
   3 #include "perl.h"
   4 #include "XSUB.h"
   5 #include "byterun.h"
   6
   7 #ifdef NEED_FGETC_PROTOTYPE
   8 extern int fgetc();
   9 #endif
  10 #ifdef NEED_FREAD_PROTOTYPE
  11 extern int fread();
  12 #endif
  13
  14 static void
  15 freadpv(U32 len, void *data, XPV *pv)
  16 {
  17     dTHX;
  18     New(666, pv->xpv_pv, len, char);
  19     PerlIO_read((PerlIO*)data, (void*)pv->xpv_pv, len);
  20     pv->xpv_len = len;
  21     pv->xpv_cur = len - 1;
  22 }
  23
  24 static I32
  25 byteloader_filter(pTHXo_ int idx, SV *buf_sv, int maxlen)
  26 {
  27     dTHR;
  28     OP *saveroot = PL_main_root;
  29     OP *savestart = PL_main_start;
  30     struct bytestream bs;
  31
  32     bs.data = PL_rsfp;
  33     bs.pfgetc = (int(*) (void*))fgetc;
  34     bs.pfread = (int(*) (char*,size_t,size_t,void*))fread;
  35     bs.pfreadpv = freadpv;
  36
  37     byterun(aTHXo_ bs);
  38
  39     if (PL_in_eval) {
  40         OP *o;
  41
  42         PL_eval_start = PL_main_start;
  43
  44         o = newSVOP(OP_CONST, 0, newSViv(1));
  45         PL_eval_root = newLISTOP(OP_LINESEQ, 0, PL_main_root, o);
  46         PL_main_root->op_next = o;
  47         PL_eval_root = newUNOP(OP_LEAVEEVAL, 0, PL_eval_root);
  48         o->op_next = PL_eval_root;
  49
  50         PL_main_root = saveroot;
  51         PL_main_start = savestart;
  52     }
  53
  54     return 0;
  55 }
  56
  57 MODULE = ByteLoader             PACKAGE = ByteLoader
  58
  59 PROTOTYPES:     ENABLE
  60
  61 void
  62 import(...)
  63   PPCODE:
  64     filter_add(byteloader_filter, NULL);
  65
  66 void
  67 unimport(...)
  68   PPCODE:
  69     filter_del(byteloader_filter);