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 char *pvindex; 9 10 #define BGET_FREAD(argp, len, nelem) \ 11 bl_read(bstate->bs_fdata,(char*)(argp),(len),(nelem)) 12 #define BGET_FGETC() bl_getc(bstate->bs_fdata) 13 14 /* all this should be made endianness-agnostic */ 15 16 #define BGET_U8(arg) arg = BGET_FGETC() 17 #define BGET_U16(arg) \ 18 BGET_FREAD(&arg, sizeof(U16), 1) 19 #define BGET_U32(arg) \ 20 BGET_FREAD(&arg, sizeof(U32), 1) 21 #define BGET_UV(arg) \ 22 BGET_FREAD(&arg, sizeof(UV), 1) 23 #define BGET_PADOFFSET(arg) \ 24 BGET_FREAD(&arg, sizeof(PADOFFSET), 1) 25 #define BGET_long(arg) \ 26 BGET_FREAD(&arg, sizeof(long), 1) 27 28 #define BGET_I32(arg) BGET_U32(arg) 29 #define BGET_IV(arg) BGET_UV(arg) 30 31 #define BGET_PV(arg) STMT_START { \ 32 BGET_U32(arg); \ 33 if (arg) { \ 34 New(666, bstate->bs_pv.xpv_pv, arg, char); \ 35 bl_read(bstate->bs_fdata, bstate->bs_pv.xpv_pv, arg, 1); \ 36 bstate->bs_pv.xpv_len = arg; \ 37 bstate->bs_pv.xpv_cur = arg - 1; \ 38 } else { \ 39 bstate->bs_pv.xpv_pv = 0; \ 40 bstate->bs_pv.xpv_len = 0; \ 41 bstate->bs_pv.xpv_cur = 0; \ 42 } \ 43 } STMT_END 44 45 #ifdef BYTELOADER_LOG_COMMENTS 46 # define BGET_comment_t(arg) \ 47 STMT_START { \ 48 char buf[1024]; \ 49 int i = 0; \ 50 do { \ 51 arg = BGET_FGETC(); \ 52 buf[i++] = (char)arg; \ 53 } while (arg != '\n' && arg != EOF); \ 54 buf[i] = '\0'; \ 55 PerlIO_printf(PerlIO_stderr(), "%s", buf); \ 56 } STMT_END 57 #else 58 # define BGET_comment_t(arg) \ 59 do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF) 60 #endif 61 62 63 #define BGET_op_tr_array(arg) do { \ 64 unsigned short *ary, len; \ 65 BGET_U16(len); \ 66 New(666, ary, len, unsigned short); \ 67 BGET_FREAD(ary, sizeof(unsigned short), len); \ 68 arg = (char *) ary; \ 69 } while (0) 70 71 #define BGET_pvcontents(arg) arg = bstate->bs_pv.xpv_pv 72 #define BGET_strconst(arg) STMT_START { \ 73 for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \ 74 arg = PL_tokenbuf; \ 75 } STMT_END 76 77 #define BGET_NV(arg) STMT_START { \ 78 char *str; \ 79 BGET_strconst(str); \ 80 arg = Atof(str); \ 81 } STMT_END 82 83 #define BGET_objindex(arg, type) STMT_START { \ 84 BGET_U32(ix); \ 85 arg = (type)bstate->bs_obj_list[ix]; \ 86 } STMT_END 87 #define BGET_svindex(arg) BGET_objindex(arg, svindex) 88 #define BGET_opindex(arg) BGET_objindex(arg, opindex) 89 #define BGET_pvindex(arg) STMT_START { \ 90 BGET_objindex(arg, pvindex); \ 91 arg = arg ? savepv(arg) : arg; \ 92 } STMT_END 93 94 #define BSET_ldspecsv(sv, arg) sv = specialsv_list[arg] 95 #define BSET_ldspecsvx(sv, arg) STMT_START { \ 96 BSET_ldspecsv(sv, arg); \ 97 BSET_OBJ_STOREX(sv); \ 98 } STMT_END 99 100 #define BSET_stpv(pv, arg) STMT_START { \ 101 BSET_OBJ_STORE(pv, arg); \ 102 SAVEFREEPV(pv); \ 103 } STMT_END 104 105 #define BSET_sv_refcnt_add(svrefcnt, arg) svrefcnt += arg 106 #define BSET_gp_refcnt_add(gprefcnt, arg) gprefcnt += arg 107 #define BSET_gp_share(sv, arg) STMT_START { \ 108 gp_free((GV*)sv); \ 109 GvGP(sv) = GvGP(arg); \ 110 } STMT_END 111 112 #define BSET_gv_fetchpv(sv, arg) sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV) 113 #define BSET_gv_fetchpvx(sv, arg) STMT_START { \ 114 BSET_gv_fetchpv(sv, arg); \ 115 BSET_OBJ_STOREX(sv); \ 116 } STMT_END 117 118 #define BSET_gv_stashpv(sv, arg) sv = (SV*)gv_stashpv(arg, TRUE) 119 #define BSET_gv_stashpvx(sv, arg) STMT_START { \ 120 BSET_gv_stashpv(sv, arg); \ 121 BSET_OBJ_STOREX(sv); \ 122 } STMT_END 123 124 #define BSET_sv_magic(sv, arg) sv_magic(sv, Nullsv, arg, 0, 0) 125 #define BSET_mg_name(mg, arg) mg->mg_ptr = arg; mg->mg_len = bstate->bs_pv.xpv_cur 126 #define BSET_mg_namex(mg, arg) \ 127 (mg->mg_ptr = (char*)SvREFCNT_inc((SV*)arg), \ 128 mg->mg_len = HEf_SVKEY) 129 #define BSET_sv_upgrade(sv, arg) (void)SvUPGRADE(sv, arg) 130 #define BSET_xpv(sv) do { \ 131 SvPV_set(sv, bstate->bs_pv.xpv_pv); \ 132 SvCUR_set(sv, bstate->bs_pv.xpv_cur); \ 133 SvLEN_set(sv, bstate->bs_pv.xpv_len); \ 134 } while (0) 135 #define BSET_av_extend(sv, arg) av_extend((AV*)sv, arg) 136 137 #define BSET_av_push(sv, arg) av_push((AV*)sv, arg) 138 #define BSET_av_pushx(sv, arg) (AvARRAY(sv)[++AvFILLp(sv)] = arg) 139 #define BSET_hv_store(sv, arg) \ 140 hv_store((HV*)sv, bstate->bs_pv.xpv_pv, bstate->bs_pv.xpv_cur, arg, 0) 141 #define BSET_pv_free(pv) Safefree(pv.xpv_pv) 142 143 144 #ifdef USE_ITHREADS 145 146 /* copied after the code in newPMOP() */ 147 #define BSET_pregcomp(o, arg) \ 148 STMT_START { \ 149 SV* repointer; \ 150 REGEXP* rx = arg ? \ 151 CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.xpv_cur, cPMOPx(o)) : \ 152 Null(REGEXP*); \ 153 if(av_len((AV*) PL_regex_pad[0]) > -1) { \ 154 repointer = av_pop((AV*)PL_regex_pad[0]); \ 155 cPMOPx(o)->op_pmoffset = SvIV(repointer); \ 156 SvREPADTMP_off(repointer); \ 157 sv_setiv(repointer,PTR2IV(rx)); \ 158 } else { \ 159 repointer = newSViv(PTR2IV(rx)); \ 160 av_push(PL_regex_padav,SvREFCNT_inc(repointer)); \ 161 cPMOPx(o)->op_pmoffset = av_len(PL_regex_padav); \ 162 PL_regex_pad = AvARRAY(PL_regex_padav); \ 163 } \ 164 } STMT_END 165 166 #else 167 #define BSET_pregcomp(o, arg) \ 168 STMT_START { \ 169 PM_SETRE(((PMOP*)o), (arg ? \ 170 CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.xpv_cur, cPMOPx(o)): \ 171 Null(REGEXP*))); \ 172 } STMT_END 173 174 #endif /* USE_THREADS */ 175 176 177 #define BSET_newsv(sv, arg) \ 178 switch(arg) { \ 179 case SVt_PVAV: \ 180 sv = (SV*)newAV(); \ 181 break; \ 182 case SVt_PVHV: \ 183 sv = (SV*)newHV(); \ 184 break; \ 185 default: \ 186 sv = NEWSV(0,0); \ 187 SvUPGRADE(sv, (arg)); \ 188 } 189 #define BSET_newsvx(sv, arg) STMT_START { \ 190 BSET_newsv(sv, arg & SVTYPEMASK); \ 191 SvFLAGS(sv) = arg; \ 192 BSET_OBJ_STOREX(sv); \ 193 } STMT_END 194 195 #define BSET_newop(o, arg) NewOpSz(666, o, arg) 196 #define BSET_newopx(o, arg) STMT_START { \ 197 register int sz = arg & 0x7f; \ 198 register OP* newop; \ 199 BSET_newop(newop, sz); \ 200 /* newop->op_next = o; XXX */ \ 201 o = newop; \ 202 arg >>=7; \ 203 BSET_op_type(o, arg); \ 204 BSET_OBJ_STOREX(o); \ 205 } STMT_END 206 207 #define BSET_newopn(o, arg) STMT_START { \ 208 OP *oldop = o; \ 209 BSET_newop(o, arg); \ 210 oldop->op_next = o; \ 211 } STMT_END 212 213 #define BSET_ret(foo) STMT_START { \ 214 Safefree(bstate->bs_obj_list); \ 215 return 0; \ 216 } STMT_END 217 218 #define BSET_op_pmstashpv(op, arg) PmopSTASHPV_set(op, arg) 219 220 /* 221 * stolen from toke.c: better if that was a function. 222 * in toke.c there are also #ifdefs for dosish systems and i/o layers 223 */ 224 225 #if defined(HAS_FCNTL) && defined(F_SETFD) 226 #define set_clonex(fp) \ 227 STMT_START { \ 228 int fd = PerlIO_fileno(fp); \ 229 fcntl(fd,F_SETFD,fd >= 3); \ 230 } STMT_END 231 #else 232 #define set_clonex(fp) 233 #endif 234 235 #define BSET_data(dummy,arg) \ 236 STMT_START { \ 237 GV *gv; \ 238 char *pname = "main"; \ 239 if (arg == 'D') \ 240 pname = HvNAME(PL_curstash ? PL_curstash : PL_defstash); \ 241 gv = gv_fetchpv(Perl_form(aTHX_ "%s::DATA", pname), TRUE, SVt_PVIO);\ 242 GvMULTI_on(gv); \ 243 if (!GvIO(gv)) \ 244 GvIOp(gv) = newIO(); \ 245 IoIFP(GvIOp(gv)) = PL_rsfp; \ 246 set_clonex(PL_rsfp); \ 247 /* Mark this internal pseudo-handle as clean */ \ 248 IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT; \ 249 if (PL_preprocess) \ 250 IoTYPE(GvIOp(gv)) = IoTYPE_PIPE; \ 251 else if ((PerlIO*)PL_rsfp == PerlIO_stdin()) \ 252 IoTYPE(GvIOp(gv)) = IoTYPE_STD; \ 253 else \ 254 IoTYPE(GvIOp(gv)) = IoTYPE_RDONLY; \ 255 Safefree(bstate->bs_obj_list); \ 256 return 1; \ 257 } STMT_END 258 259 /* stolen from op.c */ 260 #define BSET_load_glob(foo, gv) \ 261 STMT_START { \ 262 GV *glob_gv; \ 263 ENTER; \ 264 Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT, \ 265 newSVpvn("File::Glob", 10), Nullsv, Nullsv, Nullsv); \ 266 glob_gv = gv_fetchpv("File::Glob::csh_glob", FALSE, SVt_PVCV); \ 267 GvCV(gv) = GvCV(glob_gv); \ 268 SvREFCNT_inc((SV*)GvCV(gv)); \ 269 GvIMPORTED_CV_on(gv); \ 270 LEAVE; \ 271 } STMT_END 272 273 /* 274 * Kludge special-case workaround for OP_MAPSTART 275 * which needs the ppaddr for OP_GREPSTART. Blech. 276 */ 277 #define BSET_op_type(o, arg) STMT_START { \ 278 o->op_type = arg; \ 279 if (arg == OP_MAPSTART) \ 280 arg = OP_GREPSTART; \ 281 o->op_ppaddr = PL_ppaddr[arg]; \ 282 } STMT_END 283 #define BSET_op_ppaddr(o, arg) Perl_croak(aTHX_ "op_ppaddr not yet implemented") 284 #define BSET_curpad(pad, arg) STMT_START { \ 285 PL_comppad = (AV *)arg; \ 286 pad = AvARRAY(arg); \ 287 } STMT_END 288 289 #ifdef USE_ITHREADS 290 #define BSET_cop_file(cop, arg) CopFILE_set(cop,arg) 291 #define BSET_cop_stashpv(cop, arg) CopSTASHPV_set(cop,arg) 292 #else 293 /* this works now that Sarathy's changed the CopFILE_set macro to do the SvREFCNT_inc() 294 -- BKS 6-2-2000 */ 295 /* that really meant the actual CopFILEGV_set */ 296 #define BSET_cop_filegv(cop, arg) CopFILEGV_set(cop,arg) 297 #define BSET_cop_stash(cop,arg) CopSTASH_set(cop,(HV*)arg) 298 #endif 299 300 /* this is simply stolen from the code in newATTRSUB() */ 301 #define BSET_push_begin(ary,cv) \ 302 STMT_START { \ 303 I32 oldscope = PL_scopestack_ix; \ 304 ENTER; \ 305 SAVECOPFILE(&PL_compiling); \ 306 SAVECOPLINE(&PL_compiling); \ 307 if (!PL_beginav) \ 308 PL_beginav = newAV(); \ 309 av_push(PL_beginav, (SV*)cv); \ 310 GvCV(CvGV(cv)) = 0; /* cv has been hijacked */\ 311 call_list(oldscope, PL_beginav); \ 312 PL_curcop = &PL_compiling; \ 313 PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);\ 314 LEAVE; \ 315 } STMT_END 316 #define BSET_push_init(ary,cv) \ 317 STMT_START { \ 318 av_unshift((PL_initav ? PL_initav : \ 319 (PL_initav = newAV(), PL_initav)), 1); \ 320 av_store(PL_initav, 0, cv); \ 321 } STMT_END 322 #define BSET_push_end(ary,cv) \ 323 STMT_START { \ 324 av_unshift((PL_endav ? PL_endav : \ 325 (PL_endav = newAV(), PL_endav)), 1); \ 326 av_store(PL_endav, 0, cv); \ 327 } STMT_END 328 #define BSET_OBJ_STORE(obj, ix) \ 329 ((I32)ix > bstate->bs_obj_list_fill ? \ 330 bset_obj_store(aTHX_ bstate, obj, (I32)ix) : \ 331 (bstate->bs_obj_list[ix] = obj), \ 332 bstate->bs_ix = ix+1) 333 #define BSET_OBJ_STOREX(obj) \ 334 (bstate->bs_ix > bstate->bs_obj_list_fill ? \ 335 bset_obj_store(aTHX_ bstate, obj, bstate->bs_ix) : \ 336 (bstate->bs_obj_list[bstate->bs_ix] = obj), \ 337 bstate->bs_ix++) 338 339 #define BSET_signal(cv, name) \ 340 mg_set(*hv_store(GvHV(gv_fetchpv("SIG", TRUE, SVt_PVHV)), \ 341 name, strlen(name), cv, 0)) 342 343 /* NOTE: the bytecode header only sanity-checks the bytecode. If a script cares about 344 * what version of Perl it's being called under, it should do a 'use 5.006_001' or 345 * equivalent. However, since the header includes checks requiring an exact match in 346 * ByteLoader versions (we can't guarantee forward compatibility), you don't 347 * need to specify one: 348 * use ByteLoader; 349 * is all you need. 350 * -- BKS, June 2000 351 */ 352 353 #define HEADER_FAIL(f) \ 354 Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f) 355 #define HEADER_FAIL1(f, arg1) \ 356 Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f, arg1) 357 #define HEADER_FAIL2(f, arg1, arg2) \ 358 Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f, arg1, arg2) 359 360 #define BYTECODE_HEADER_CHECK \ 361 STMT_START { \ 362 U32 sz = 0; \ 363 strconst str; \ 364 \ 365 BGET_U32(sz); /* Magic: 'PLBC' */ \ 366 if (sz != 0x43424c50) { \ 367 HEADER_FAIL1("bad magic (want 0x43424c50, got %#x)", (int)sz); \ 368 } \ 369 BGET_strconst(str); /* archname */ \ 370 if (strNE(str, ARCHNAME)) { \ 371 HEADER_FAIL2("wrong architecture (want %s, you have %s)",str,ARCHNAME); \ 372 } \ 373 BGET_strconst(str); /* ByteLoader version */ \ 374 if (strNE(str, VERSION)) { \ 375 HEADER_FAIL2("mismatched ByteLoader versions (want %s, you have %s)", \ 376 str, VERSION); \ 377 } \ 378 BGET_U32(sz); /* ivsize */ \ 379 if (sz != IVSIZE) { \ 380 HEADER_FAIL("different IVSIZE"); \ 381 } \ 382 BGET_U32(sz); /* ptrsize */ \ 383 if (sz != PTRSIZE) { \ 384 HEADER_FAIL("different PTRSIZE"); \ 385 } \ 386 } STMT_END 387