ext/ByteLoader/bytecode.h

   1 typedef char *pvcontents;
   2 typedef char *strconst;
   3 typedef U32 PV;
   4 typedef char *op_tr_array;
   5 typedef int comment_t;
   6 typedef SV *svindex;
   7 typedef OP *opindex;
   8 typedef IV IV64;
   9
  10 #define BGET_FREAD(argp, len, nelem)    \
  11          bs.pfread((char*)(argp),(len),(nelem),bs.data)
  12 #define BGET_FGETC() bs.pfgetc(bs.data)
  13
  14 #define BGET_U32(arg)   \
  15         BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg)
  16 #define BGET_I32(arg)   \
  17         BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg)
  18 #define BGET_U16(arg)   \
  19         BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg)
  20 #define BGET_U8(arg)    arg = BGET_FGETC()
  21
  22 #define BGET_PV(arg)    STMT_START {    \
  23         BGET_U32(arg);                  \
  24         if (arg)                        \
  25             bs.pfreadpv(arg, bs.data, &bytecode_pv);    \
  26         else {                          \
  27             bytecode_pv.xpv_pv = 0;             \
  28             bytecode_pv.xpv_len = 0;            \
  29             bytecode_pv.xpv_cur = 0;            \
  30         }                               \
  31     } STMT_END
  32
  33 #ifdef BYTELOADER_LOG_COMMENTS
  34 #  define BGET_comment_t(arg) \
  35     STMT_START {                                                        \
  36         char buf[1024];                                                 \
  37         int i = 0;                                                      \
  38         do {                                                            \
  39             arg = BGET_FGETC();                                         \
  40             buf[i++] = (char)arg;                                       \
  41         } while (arg != '\n' && arg != EOF);                            \
  42         buf[i] = '\0';                                                  \
  43         PerlIO_printf(PerlIO_stderr(), "%s", buf);                      \
  44     } STMT_END
  45 #else
  46 #  define BGET_comment_t(arg) \
  47         do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF)
  48 #endif
  49
  50 /*
  51  * In the following, sizeof(IV)*4 is just a way of encoding 32 on 64-bit-IV
  52  * machines such that 32-bit machine compilers don't whine about the shift
  53  * count being too high even though the code is never reached there.
  54  */
  55 #define BGET_IV64(arg) STMT_START {                     \
  56         U32 hi, lo;                                     \
  57         BGET_U32(hi);                                   \
  58         BGET_U32(lo);                                   \
  59         if (sizeof(IV) == 8)                            \
  60             arg = ((IV)hi << (sizeof(IV)*4) | (IV)lo);  \
  61         else if (((I32)hi == -1 && (I32)lo < 0)         \
  62                  || ((I32)hi == 0 && (I32)lo >= 0)) {   \
  63             arg = (I32)lo;                              \
  64         }                                               \
  65         else {                                          \
  66             bytecode_iv_overflows++;                            \
  67             arg = 0;                                    \
  68         }                                               \
  69     } STMT_END
  70
  71 #define BGET_op_tr_array(arg) do {      \
  72         unsigned short *ary;            \
  73         int i;                          \
  74         New(666, ary, 256, unsigned short); \
  75         BGET_FREAD(ary, 256, 2);        \
  76         for (i = 0; i < 256; i++)       \
  77             ary[i] = PerlSock_ntohs(ary[i]);    \
  78         arg = (char *) ary;             \
  79     } while (0)
  80
  81 #define BGET_pvcontents(arg)    arg = bytecode_pv.xpv_pv
  82 #define BGET_strconst(arg) STMT_START { \
  83         for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \
  84         arg = PL_tokenbuf;                      \
  85     } STMT_END
  86
  87 #define BGET_NV(arg) STMT_START {       \
  88         char *str;                      \
  89         BGET_strconst(str);             \
  90         arg = Atof(str);                \
  91     } STMT_END
  92
  93 #define BGET_objindex(arg, type) STMT_START {   \
  94         U32 ix;                                 \
  95         BGET_U32(ix);                           \
  96         arg = (type)bytecode_obj_list[ix];              \
  97     } STMT_END
  98 #define BGET_svindex(arg) BGET_objindex(arg, svindex)
  99 #define BGET_opindex(arg) BGET_objindex(arg, opindex)
 100
 101 #define BSET_ldspecsv(sv, arg) sv = specialsv_list[arg]
 102
 103 #define BSET_sv_refcnt_add(svrefcnt, arg)       svrefcnt += arg
 104 #define BSET_gp_refcnt_add(gprefcnt, arg)       gprefcnt += arg
 105 #define BSET_gp_share(sv, arg) STMT_START {     \
 106         gp_free((GV*)sv);                       \
 107         GvGP(sv) = GvGP(arg);                   \
 108     } STMT_END
 109
 110 #define BSET_gv_fetchpv(sv, arg)        sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV)
 111 #define BSET_gv_stashpv(sv, arg)        sv = (SV*)gv_stashpv(arg, TRUE)
 112 #define BSET_sv_magic(sv, arg)          sv_magic(sv, Nullsv, arg, 0, 0)
 113 #define BSET_mg_pv(mg, arg)     mg->mg_ptr = arg; mg->mg_len = bytecode_pv.xpv_cur
 114 #define BSET_sv_upgrade(sv, arg)        (void)SvUPGRADE(sv, arg)
 115 #define BSET_xpv(sv)    do {    \
 116         SvPV_set(sv, bytecode_pv.xpv_pv);       \
 117         SvCUR_set(sv, bytecode_pv.xpv_cur);     \
 118         SvLEN_set(sv, bytecode_pv.xpv_len);     \
 119     } while (0)
 120 #define BSET_av_extend(sv, arg) av_extend((AV*)sv, arg)
 121
 122 #define BSET_av_push(sv, arg)   av_push((AV*)sv, arg)
 123 #define BSET_hv_store(sv, arg)  \
 124         hv_store((HV*)sv, bytecode_pv.xpv_pv, bytecode_pv.xpv_cur, arg, 0)
 125 #define BSET_pv_free(pv)        Safefree(pv.xpv_pv)
 126 #define BSET_pregcomp(o, arg) \
 127         ((PMOP*)o)->op_pmregexp = arg ? \
 128                 CALLREGCOMP(aTHX_ arg, arg + bytecode_pv.xpv_cur, ((PMOP*)o)) : 0
 129 #define BSET_newsv(sv, arg)     sv = NEWSV(666,0); SvUPGRADE(sv, arg)
 130 #define BSET_newop(o, arg)      ((o = (OP*)safemalloc(optype_size[arg])), \
 131                                  memzero((char*)o,optype_size[arg]))
 132 #define BSET_newopn(o, arg) STMT_START {        \
 133         OP *oldop = o;                          \
 134         BSET_newop(o, arg);                     \
 135         oldop->op_next = o;                     \
 136     } STMT_END
 137
 138 #define BSET_ret(foo) return
 139
 140 /*
 141  * Kludge special-case workaround for OP_MAPSTART
 142  * which needs the ppaddr for OP_GREPSTART. Blech.
 143  */
 144 #define BSET_op_type(o, arg) STMT_START {       \
 145         o->op_type = arg;                       \
 146         if (arg == OP_MAPSTART)                 \
 147             arg = OP_GREPSTART;                 \
 148         o->op_ppaddr = PL_ppaddr[arg];          \
 149     } STMT_END
 150 #define BSET_op_ppaddr(o, arg) Perl_croak(aTHX_ "op_ppaddr not yet implemented")
 151 #define BSET_curpad(pad, arg) STMT_START {      \
 152         PL_comppad = (AV *)arg;                 \
 153         pad = AvARRAY(arg);                     \
 154     } STMT_END
 155 #define BSET_cop_file(cop, arg)         CopFILE_set(cop,arg)
 156 #define BSET_cop_line(cop, arg)         CopLINE_set(cop,arg)
 157 #define BSET_cop_stashpv(cop, arg)      CopSTASHPV_set(cop,arg)
 158
 159 #define BSET_OBJ_STORE(obj, ix)         \
 160         (I32)ix > bytecode_obj_list_fill ?      \
 161         bset_obj_store(aTHXo_ obj, (I32)ix) : (bytecode_obj_list[ix] = obj)