From: Tom Hughes Date: Wed, 26 May 1999 23:59:49 +0000 (+0100) Subject: ByteLoader mark 2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e8edd1e67bd80dbb476d68f78da80ae76c0eb341;p=p5sagit%2Fp5-mst-13.2.git ByteLoader mark 2 To: perl5-porters@perl.org Message-ID: plus resolve tiny conflict with #3479 plus regen_headers. p4raw-id: //depot/cfgperl@3499 --- diff --git a/MANIFEST b/MANIFEST index c2a06e2..aaf7f11 100644 --- a/MANIFEST +++ b/MANIFEST @@ -60,10 +60,7 @@ apollo/netinet/in.h Apollo DomainOS port: C header file frontend av.c Array value code av.h Array value header beos/nm.c BeOS port -bytecode.h Bytecode header for compiler -bytecode.pl Produces byterun.h, byterun.c and ext/B/Asmdata.pm -byterun.c Runtime support for compiler-generated bytecode -byterun.h Header for byterun.c +bytecode.pl Produces ext/ByteLoader/byterun.h, ext/ByteLoader/byterun.c and ext/B/Asmdata.pm cc_runtime.h Macros need by runtime of compiler-generated code cflags.SH A script that emits C compilation flags per file config_h.SH Produces config.h @@ -189,7 +186,6 @@ ext/B/O.pm Compiler front-end module (-MO=...) ext/B/README Compiler backend README ext/B/TESTS Compiler backend test data ext/B/Todo Compiler backend Todo list -ext/B/byteperl.c Bytecode runner ext/B/defsubs.h.PL Generator for constant subroutines ext/B/ramblings/cc.notes Compiler ramblings: notes on CC backend ext/B/ramblings/curcop.runtime Compiler ramblings: notes on curcop use @@ -201,6 +197,9 @@ ext/B/typemap Compiler backend interface types ext/ByteLoader/ByteLoader.pm Bytecode loader Perl module ext/ByteLoader/ByteLoader.xs Bytecode loader external subroutines ext/ByteLoader/Makefile.PL Bytecode loader makefile writer +ext/ByteLoader/bytecode.h Bytecode header for bytecode loader +ext/ByteLoader/byterun.c Runtime support for bytecode loader +ext/ByteLoader/byterun.h Header for byterun.c ext/DB_File/Changes Berkeley DB extension change log ext/DB_File/DB_File.pm Berkeley DB extension Perl module ext/DB_File/DB_File.xs Berkeley DB extension external subroutines @@ -1325,7 +1324,6 @@ utils/c2ph.PL program to translate dbx stabs to perl utils/h2ph.PL A thing to turn C .h files into perl .ph files utils/h2xs.PL Program to make .xs files from C header files utils/perlbug.PL A simple tool to submit a bug report -utils/perlbc.PL Front-end for bytecode compiler utils/perlcc.PL Front-end for compiler utils/perldoc.PL A simple tool to find & display perl's documentation utils/pl2pm.PL A pl to pm translator diff --git a/Makefile.SH b/Makefile.SH index a740419..0c02a43 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -224,16 +224,16 @@ h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h h3 = opcode.h patchlevel.h perl.h perly.h pp.h proto.h regcomp.h h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h -h5 = bytecode.h byterun.h utf8.h warning.h +h5 = utf8.h warning.h h = $(h1) $(h2) $(h3) $(h4) $(h5) -c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c byterun.c +c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c c2 = perl.c perly.c pp.c pp_hot.c pp_ctl.c pp_sys.c regcomp.c regexec.c utf8.c c3 = gv.c sv.c taint.c toke.c util.c deb.c run.c universal.c globals.c perlio.c c = $(c1) $(c2) $(c3) miniperlmain.c perlmain.c -obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT) byterun$(OBJ_EXT) +obj1 = $(mallocobj) gv$(OBJ_EXT) toke$(OBJ_EXT) perly$(OBJ_EXT) op$(OBJ_EXT) regcomp$(OBJ_EXT) dump$(OBJ_EXT) util$(OBJ_EXT) mg$(OBJ_EXT) obj2 = hv$(OBJ_EXT) av$(OBJ_EXT) run$(OBJ_EXT) pp_hot$(OBJ_EXT) sv$(OBJ_EXT) pp$(OBJ_EXT) scope$(OBJ_EXT) pp_ctl$(OBJ_EXT) pp_sys$(OBJ_EXT) obj3 = doop$(OBJ_EXT) doio$(OBJ_EXT) regexec$(OBJ_EXT) utf8$(OBJ_EXT) taint$(OBJ_EXT) deb$(OBJ_EXT) universal$(OBJ_EXT) globals$(OBJ_EXT) perlio$(OBJ_EXT) @@ -485,9 +485,9 @@ SYMH = perlvars.h intrpvar.h thrdvar.h # pp.sym: opcode.pl # embed.h: embed.pl [* needs pp.sym generated by opcode.pl! *] # embedvar.h: embed.pl [* needs pp.sym generated by opcode.pl! *] -# byterun.h: bytecode.pl -# byterun.c: bytecode.pl -# lib/B/Asmdata.pm: bytecode.pl +# ext/ByteLoader/byterun.h: bytecode.pl +# ext/ByteLoader/byterun.c: bytecode.pl +# ext/B/Asmdata.pm: bytecode.pl # regnodes.h: regcomp.pl # warning.h lib/warning.pm: warning.pl # The correct versions should be already supplied with the perl kit, diff --git a/bytecode.h b/bytecode.h deleted file mode 100644 index b08dc7c..0000000 --- a/bytecode.h +++ /dev/null @@ -1,164 +0,0 @@ -typedef char *pvcontents; -typedef char *strconst; -typedef U32 PV; -typedef char *op_tr_array; -typedef int comment_t; -typedef SV *svindex; -typedef OP *opindex; -typedef IV IV64; - -#ifdef INDIRECT_BGET_MACROS -#define BGET_FREAD(argp, len, nelem) \ - bs.fread((char*)(argp),(len),(nelem),bs.data) -#define BGET_FGETC() bs.fgetc(bs.data) -#else -#define BGET_FREAD(argp, len, nelem) PerlIO_read(fp, (argp), (len)*(nelem)) -#define BGET_FGETC() PerlIO_getc(fp) -#endif /* INDIRECT_BGET_MACROS */ - -#define BGET_U32(arg) \ - BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg) -#define BGET_I32(arg) \ - BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg) -#define BGET_U16(arg) \ - BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg) -#define BGET_U8(arg) arg = BGET_FGETC() - -#if INDIRECT_BGET_MACROS -#define BGET_PV(arg) STMT_START { \ - BGET_U32(arg); \ - if (arg) \ - bs.freadpv(arg, bs.data); \ - else { \ - PL_bytecode_pv.xpv_pv = 0; \ - PL_bytecode_pv.xpv_len = 0; \ - PL_bytecode_pv.xpv_cur = 0; \ - } \ - } STMT_END -#else -#define BGET_PV(arg) STMT_START { \ - BGET_U32(arg); \ - if (arg) { \ - New(666, PL_bytecode_pv.xpv_pv, arg, char); \ - PerlIO_read(fp, PL_bytecode_pv.xpv_pv, arg); \ - PL_bytecode_pv.xpv_len = arg; \ - PL_bytecode_pv.xpv_cur = arg - 1; \ - } else { \ - PL_bytecode_pv.xpv_pv = 0; \ - PL_bytecode_pv.xpv_len = 0; \ - PL_bytecode_pv.xpv_cur = 0; \ - } \ - } STMT_END -#endif /* INDIRECT_BGET_MACROS */ - -#define BGET_comment_t(arg) \ - do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF) - -/* - * In the following, sizeof(IV)*4 is just a way of encoding 32 on 64-bit-IV - * machines such that 32-bit machine compilers don't whine about the shift - * count being too high even though the code is never reached there. - */ -#define BGET_IV64(arg) STMT_START { \ - U32 hi, lo; \ - BGET_U32(hi); \ - BGET_U32(lo); \ - if (sizeof(IV) == 8) \ - arg = ((IV)hi << (sizeof(IV)*4) | lo); \ - else if (((I32)hi == -1 && (I32)lo < 0) \ - || ((I32)hi == 0 && (I32)lo >= 0)) { \ - arg = (I32)lo; \ - } \ - else { \ - PL_bytecode_iv_overflows++; \ - arg = 0; \ - } \ - } STMT_END - -#define BGET_op_tr_array(arg) do { \ - unsigned short *ary; \ - int i; \ - New(666, ary, 256, unsigned short); \ - BGET_FREAD(ary, 256, 2); \ - for (i = 0; i < 256; i++) \ - ary[i] = PerlSock_ntohs(ary[i]); \ - arg = (char *) ary; \ - } while (0) - -#define BGET_pvcontents(arg) arg = PL_bytecode_pv.xpv_pv -#define BGET_strconst(arg) STMT_START { \ - for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \ - arg = PL_tokenbuf; \ - } STMT_END - -#define BGET_double(arg) STMT_START { \ - char *str; \ - BGET_strconst(str); \ - arg = atof(str); \ - } STMT_END - -#define BGET_objindex(arg, type) STMT_START { \ - U32 ix; \ - BGET_U32(ix); \ - arg = (type)PL_bytecode_obj_list[ix]; \ - } STMT_END -#define BGET_svindex(arg) BGET_objindex(arg, svindex) -#define BGET_opindex(arg) BGET_objindex(arg, opindex) - -#define BSET_ldspecsv(sv, arg) sv = PL_specialsv_list[arg] - -#define BSET_sv_refcnt_add(svrefcnt, arg) svrefcnt += arg -#define BSET_gp_refcnt_add(gprefcnt, arg) gprefcnt += arg -#define BSET_gp_share(sv, arg) STMT_START { \ - gp_free((GV*)sv); \ - GvGP(sv) = GvGP(arg); \ - } STMT_END - -#define BSET_gv_fetchpv(sv, arg) sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV) -#define BSET_gv_stashpv(sv, arg) sv = (SV*)gv_stashpv(arg, TRUE) -#define BSET_sv_magic(sv, arg) sv_magic(sv, Nullsv, arg, 0, 0) -#define BSET_mg_pv(mg, arg) mg->mg_ptr = arg; mg->mg_len = PL_bytecode_pv.xpv_cur -#define BSET_sv_upgrade(sv, arg) (void)SvUPGRADE(sv, arg) -#define BSET_xpv(sv) do { \ - SvPV_set(sv, PL_bytecode_pv.xpv_pv); \ - SvCUR_set(sv, PL_bytecode_pv.xpv_cur); \ - SvLEN_set(sv, PL_bytecode_pv.xpv_len); \ - } while (0) -#define BSET_av_extend(sv, arg) av_extend((AV*)sv, arg) - -#define BSET_av_push(sv, arg) av_push((AV*)sv, arg) -#define BSET_hv_store(sv, arg) \ - hv_store((HV*)sv, PL_bytecode_pv.xpv_pv, PL_bytecode_pv.xpv_cur, arg, 0) -#define BSET_pv_free(pv) Safefree(pv.xpv_pv) -#define BSET_pregcomp(o, arg) \ - ((PMOP*)o)->op_pmregexp = arg ? \ - CALLREGCOMP(arg, arg + PL_bytecode_pv.xpv_cur, ((PMOP*)o)) : 0 -#define BSET_newsv(sv, arg) sv = NEWSV(666,0); SvUPGRADE(sv, arg) -#define BSET_newop(o, arg) o = (OP*)safemalloc(PL_optype_size[arg]) -#define BSET_newopn(o, arg) STMT_START { \ - OP *oldop = o; \ - BSET_newop(o, arg); \ - oldop->op_next = o; \ - } STMT_END - -#define BSET_ret(foo) return - -/* - * Kludge special-case workaround for OP_MAPSTART - * which needs the ppaddr for OP_GREPSTART. Blech. - */ -#define BSET_op_type(o, arg) STMT_START { \ - o->op_type = arg; \ - if (arg == OP_MAPSTART) \ - arg = OP_GREPSTART; \ - o->op_ppaddr = PL_ppaddr[arg]; \ - } STMT_END -#define BSET_op_ppaddr(o, arg) croak("op_ppaddr not yet implemented") -#define BSET_curpad(pad, arg) STMT_START { \ - PL_comppad = (AV *)arg; \ - pad = AvARRAY(arg); \ - } STMT_END - -#define BSET_OBJ_STORE(obj, ix) \ - (I32)ix > PL_bytecode_obj_list_fill ? \ - bset_obj_store(obj, (I32)ix) : (PL_bytecode_obj_list[ix] = obj) diff --git a/bytecode.pl b/bytecode.pl index 704d3b1..93457ea 100644 --- a/bytecode.pl +++ b/bytecode.pl @@ -36,7 +36,7 @@ EOT my $perl_header; ($perl_header = $c_header) =~ s{[/ ]?\*/?}{#}g; -unlink "byterun.c", "byterun.h", "ext/B/B/Asmdata.pm"; +unlink "ext/ByteLoader/byterun.c", "ext/ByteLoader/byterun.h", "ext/B/B/Asmdata.pm"; # # Start with boilerplate for Asmdata.pm @@ -62,34 +62,59 @@ EOT # # Boilerplate for byterun.c # -open(BYTERUN_C, ">byterun.c") or die "byterun.c: $!"; +open(BYTERUN_C, ">ext/ByteLoader/byterun.c") or die "ext/ByteLoader/byterun.c: $!"; print BYTERUN_C $c_header, <<'EOT'; #include "EXTERN.h" #include "perl.h" +#include "byterun.h" +#include "bytecode.h" + +static int optype_size[] = { +EOT +my $i = 0; +for ($i = 0; $i < @optype - 1; $i++) { + printf BYTERUN_C " sizeof(%s),\n", $optype[$i], $i; +} +printf BYTERUN_C " sizeof(%s)\n", $optype[$i], $i; +print BYTERUN_C <<'EOT'; +}; + +static SV *specialsv_list[4]; + +static int bytecode_iv_overflows = 0; +static SV *bytecode_sv; +static XPV bytecode_pv; +static void **bytecode_obj_list; +static I32 bytecode_obj_list_fill = -1; void * bset_obj_store(void *obj, I32 ix) { - if (ix > PL_bytecode_obj_list_fill) { - if (PL_bytecode_obj_list_fill == -1) - New(666, PL_bytecode_obj_list, ix + 1, void*); + if (ix > bytecode_obj_list_fill) { + if (bytecode_obj_list_fill == -1) + New(666, bytecode_obj_list, ix + 1, void*); else - Renew(PL_bytecode_obj_list, ix + 1, void*); - PL_bytecode_obj_list_fill = ix; + Renew(bytecode_obj_list, ix + 1, void*); + bytecode_obj_list_fill = ix; } - PL_bytecode_obj_list[ix] = obj; + bytecode_obj_list[ix] = obj; return obj; } -#ifdef INDIRECT_BGET_MACROS void byterun(struct bytestream bs) -#else -void byterun(PerlIO *fp) -#endif /* INDIRECT_BGET_MACROS */ { dTHR; int insn; + +EOT + +for (my $i = 0; $i < @specialsv; $i++) { + print BYTERUN_C " specialsv_list[$i] = $specialsv[$i];\n"; +} + +print BYTERUN_C <<'EOT'; + while ((insn = BGET_FGETC()) != EOF) { switch (insn) { EOT @@ -124,7 +149,7 @@ while () { if ($flags =~ /x/) { print BYTERUN_C "\t\tBSET_$insn($lvalue$optarg);\n"; } elsif ($flags =~ /s/) { - # Store instructions store to PL_bytecode_obj_list[arg]. "lvalue" field is rvalue. + # Store instructions store to bytecode_obj_list[arg]. "lvalue" field is rvalue. print BYTERUN_C "\t\tBSET_OBJ_STORE($lvalue$optarg);\n"; } elsif ($optarg && $lvalue ne "none") { @@ -158,16 +183,14 @@ EOT # # Write the instruction and optype enum constants into byterun.h # -open(BYTERUN_H, ">byterun.h") or die "byterun.h: $!"; +open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!"; print BYTERUN_H $c_header, <<'EOT'; -#ifdef INDIRECT_BGET_MACROS struct bytestream { void *data; int (*fgetc)(void *); - int (*fread)(char *, size_t, size_t, void*); - void (*freadpv)(U32, void*); + int (*fread)(char *, size_t, size_t, void *); + void (*freadpv)(U32, void *, XPV *); }; -#endif /* INDIRECT_BGET_MACROS */ enum { EOT @@ -271,85 +294,85 @@ nop none none #opcode lvalue argtype flags # ret none none x -ldsv PL_bytecode_sv svindex +ldsv bytecode_sv svindex ldop PL_op opindex -stsv PL_bytecode_sv U32 s +stsv bytecode_sv U32 s stop PL_op U32 s -ldspecsv PL_bytecode_sv U8 x -newsv PL_bytecode_sv U8 x +ldspecsv bytecode_sv U8 x +newsv bytecode_sv U8 x newop PL_op U8 x newopn PL_op U8 x newpv none PV -pv_cur PL_bytecode_pv.xpv_cur STRLEN -pv_free PL_bytecode_pv none x -sv_upgrade PL_bytecode_sv char x -sv_refcnt SvREFCNT(PL_bytecode_sv) U32 -sv_refcnt_add SvREFCNT(PL_bytecode_sv) I32 x -sv_flags SvFLAGS(PL_bytecode_sv) U32 -xrv SvRV(PL_bytecode_sv) svindex -xpv PL_bytecode_sv none x -xiv32 SvIVX(PL_bytecode_sv) I32 -xiv64 SvIVX(PL_bytecode_sv) IV64 -xnv SvNVX(PL_bytecode_sv) double -xlv_targoff LvTARGOFF(PL_bytecode_sv) STRLEN -xlv_targlen LvTARGLEN(PL_bytecode_sv) STRLEN -xlv_targ LvTARG(PL_bytecode_sv) svindex -xlv_type LvTYPE(PL_bytecode_sv) char -xbm_useful BmUSEFUL(PL_bytecode_sv) I32 -xbm_previous BmPREVIOUS(PL_bytecode_sv) U16 -xbm_rare BmRARE(PL_bytecode_sv) U8 -xfm_lines FmLINES(PL_bytecode_sv) I32 -xio_lines IoLINES(PL_bytecode_sv) long -xio_page IoPAGE(PL_bytecode_sv) long -xio_page_len IoPAGE_LEN(PL_bytecode_sv) long -xio_lines_left IoLINES_LEFT(PL_bytecode_sv) long -xio_top_name IoTOP_NAME(PL_bytecode_sv) pvcontents -xio_top_gv *(SV**)&IoTOP_GV(PL_bytecode_sv) svindex -xio_fmt_name IoFMT_NAME(PL_bytecode_sv) pvcontents -xio_fmt_gv *(SV**)&IoFMT_GV(PL_bytecode_sv) svindex -xio_bottom_name IoBOTTOM_NAME(PL_bytecode_sv) pvcontents -xio_bottom_gv *(SV**)&IoBOTTOM_GV(PL_bytecode_sv) svindex -xio_subprocess IoSUBPROCESS(PL_bytecode_sv) short -xio_type IoTYPE(PL_bytecode_sv) char -xio_flags IoFLAGS(PL_bytecode_sv) char -xcv_stash *(SV**)&CvSTASH(PL_bytecode_sv) svindex -xcv_start CvSTART(PL_bytecode_sv) opindex -xcv_root CvROOT(PL_bytecode_sv) opindex -xcv_gv *(SV**)&CvGV(PL_bytecode_sv) svindex -xcv_filegv *(SV**)&CvFILEGV(PL_bytecode_sv) svindex -xcv_depth CvDEPTH(PL_bytecode_sv) long -xcv_padlist *(SV**)&CvPADLIST(PL_bytecode_sv) svindex -xcv_outside *(SV**)&CvOUTSIDE(PL_bytecode_sv) svindex -xcv_flags CvFLAGS(PL_bytecode_sv) U8 -av_extend PL_bytecode_sv SSize_t x -av_push PL_bytecode_sv svindex x -xav_fill AvFILLp(PL_bytecode_sv) SSize_t -xav_max AvMAX(PL_bytecode_sv) SSize_t -xav_flags AvFLAGS(PL_bytecode_sv) U8 -xhv_riter HvRITER(PL_bytecode_sv) I32 -xhv_name HvNAME(PL_bytecode_sv) pvcontents -hv_store PL_bytecode_sv svindex x -sv_magic PL_bytecode_sv char x -mg_obj SvMAGIC(PL_bytecode_sv)->mg_obj svindex -mg_private SvMAGIC(PL_bytecode_sv)->mg_private U16 -mg_flags SvMAGIC(PL_bytecode_sv)->mg_flags U8 -mg_pv SvMAGIC(PL_bytecode_sv) pvcontents x -xmg_stash *(SV**)&SvSTASH(PL_bytecode_sv) svindex -gv_fetchpv PL_bytecode_sv strconst x -gv_stashpv PL_bytecode_sv strconst x -gp_sv GvSV(PL_bytecode_sv) svindex -gp_refcnt GvREFCNT(PL_bytecode_sv) U32 -gp_refcnt_add GvREFCNT(PL_bytecode_sv) I32 x -gp_av *(SV**)&GvAV(PL_bytecode_sv) svindex -gp_hv *(SV**)&GvHV(PL_bytecode_sv) svindex -gp_cv *(SV**)&GvCV(PL_bytecode_sv) svindex -gp_filegv *(SV**)&GvFILEGV(PL_bytecode_sv) svindex -gp_io *(SV**)&GvIOp(PL_bytecode_sv) svindex -gp_form *(SV**)&GvFORM(PL_bytecode_sv) svindex -gp_cvgen GvCVGEN(PL_bytecode_sv) U32 -gp_line GvLINE(PL_bytecode_sv) line_t -gp_share PL_bytecode_sv svindex x -xgv_flags GvFLAGS(PL_bytecode_sv) U8 +pv_cur bytecode_pv.xpv_cur STRLEN +pv_free bytecode_pv none x +sv_upgrade bytecode_sv char x +sv_refcnt SvREFCNT(bytecode_sv) U32 +sv_refcnt_add SvREFCNT(bytecode_sv) I32 x +sv_flags SvFLAGS(bytecode_sv) U32 +xrv SvRV(bytecode_sv) svindex +xpv bytecode_sv none x +xiv32 SvIVX(bytecode_sv) I32 +xiv64 SvIVX(bytecode_sv) IV64 +xnv SvNVX(bytecode_sv) double +xlv_targoff LvTARGOFF(bytecode_sv) STRLEN +xlv_targlen LvTARGLEN(bytecode_sv) STRLEN +xlv_targ LvTARG(bytecode_sv) svindex +xlv_type LvTYPE(bytecode_sv) char +xbm_useful BmUSEFUL(bytecode_sv) I32 +xbm_previous BmPREVIOUS(bytecode_sv) U16 +xbm_rare BmRARE(bytecode_sv) U8 +xfm_lines FmLINES(bytecode_sv) I32 +xio_lines IoLINES(bytecode_sv) long +xio_page IoPAGE(bytecode_sv) long +xio_page_len IoPAGE_LEN(bytecode_sv) long +xio_lines_left IoLINES_LEFT(bytecode_sv) long +xio_top_name IoTOP_NAME(bytecode_sv) pvcontents +xio_top_gv *(SV**)&IoTOP_GV(bytecode_sv) svindex +xio_fmt_name IoFMT_NAME(bytecode_sv) pvcontents +xio_fmt_gv *(SV**)&IoFMT_GV(bytecode_sv) svindex +xio_bottom_name IoBOTTOM_NAME(bytecode_sv) pvcontents +xio_bottom_gv *(SV**)&IoBOTTOM_GV(bytecode_sv) svindex +xio_subprocess IoSUBPROCESS(bytecode_sv) short +xio_type IoTYPE(bytecode_sv) char +xio_flags IoFLAGS(bytecode_sv) char +xcv_stash *(SV**)&CvSTASH(bytecode_sv) svindex +xcv_start CvSTART(bytecode_sv) opindex +xcv_root CvROOT(bytecode_sv) opindex +xcv_gv *(SV**)&CvGV(bytecode_sv) svindex +xcv_filegv *(SV**)&CvFILEGV(bytecode_sv) svindex +xcv_depth CvDEPTH(bytecode_sv) long +xcv_padlist *(SV**)&CvPADLIST(bytecode_sv) svindex +xcv_outside *(SV**)&CvOUTSIDE(bytecode_sv) svindex +xcv_flags CvFLAGS(bytecode_sv) U8 +av_extend bytecode_sv SSize_t x +av_push bytecode_sv svindex x +xav_fill AvFILLp(bytecode_sv) SSize_t +xav_max AvMAX(bytecode_sv) SSize_t +xav_flags AvFLAGS(bytecode_sv) U8 +xhv_riter HvRITER(bytecode_sv) I32 +xhv_name HvNAME(bytecode_sv) pvcontents +hv_store bytecode_sv svindex x +sv_magic bytecode_sv char x +mg_obj SvMAGIC(bytecode_sv)->mg_obj svindex +mg_private SvMAGIC(bytecode_sv)->mg_private U16 +mg_flags SvMAGIC(bytecode_sv)->mg_flags U8 +mg_pv SvMAGIC(bytecode_sv) pvcontents x +xmg_stash *(SV**)&SvSTASH(bytecode_sv) svindex +gv_fetchpv bytecode_sv strconst x +gv_stashpv bytecode_sv strconst x +gp_sv GvSV(bytecode_sv) svindex +gp_refcnt GvREFCNT(bytecode_sv) U32 +gp_refcnt_add GvREFCNT(bytecode_sv) I32 x +gp_av *(SV**)&GvAV(bytecode_sv) svindex +gp_hv *(SV**)&GvHV(bytecode_sv) svindex +gp_cv *(SV**)&GvCV(bytecode_sv) svindex +gp_filegv *(SV**)&GvFILEGV(bytecode_sv) svindex +gp_io *(SV**)&GvIOp(bytecode_sv) svindex +gp_form *(SV**)&GvFORM(bytecode_sv) svindex +gp_cvgen GvCVGEN(bytecode_sv) U32 +gp_line GvLINE(bytecode_sv) line_t +gp_share bytecode_sv svindex x +xgv_flags GvFLAGS(bytecode_sv) U8 op_next PL_op->op_next opindex op_sibling PL_op->op_sibling opindex op_ppaddr PL_op->op_ppaddr strconst x diff --git a/embed.h b/embed.h index e413efc..8b2f992 100644 --- a/embed.h +++ b/embed.h @@ -42,7 +42,6 @@ #define block_start Perl_block_start #define boot_core_UNIVERSAL Perl_boot_core_UNIVERSAL #define bset_obj_store Perl_bset_obj_store -#define byterun Perl_byterun #define call_list Perl_call_list #define cando Perl_cando #define cast_i32 Perl_cast_i32 @@ -163,7 +162,6 @@ #define get_op_descs Perl_get_op_descs #define get_op_names Perl_get_op_names #define get_opargs Perl_get_opargs -#define get_specialsv_list Perl_get_specialsv_list #define get_vtbl Perl_get_vtbl #define gp_free Perl_gp_free #define gp_ref Perl_gp_ref @@ -1010,7 +1008,6 @@ #define block_start CPerlObj::Perl_block_start #define boot_core_UNIVERSAL CPerlObj::Perl_boot_core_UNIVERSAL #define bset_obj_store CPerlObj::Perl_bset_obj_store -#define byterun CPerlObj::Perl_byterun #define cache_re CPerlObj::Perl_cache_re #define call_list CPerlObj::Perl_call_list #define call_list_body CPerlObj::Perl_call_list_body @@ -1186,7 +1183,6 @@ #define get_op_descs CPerlObj::Perl_get_op_descs #define get_op_names CPerlObj::Perl_get_op_names #define get_opargs CPerlObj::Perl_get_opargs -#define get_specialsv_list CPerlObj::Perl_get_specialsv_list #define get_vtbl CPerlObj::Perl_get_vtbl #define gp_free CPerlObj::Perl_gp_free #define gp_ref CPerlObj::Perl_gp_ref diff --git a/embedvar.h b/embedvar.h index 41a566f..f9bd011 100644 --- a/embedvar.h +++ b/embedvar.h @@ -154,11 +154,6 @@ #define PL_argvoutgv (PL_curinterp->Iargvoutgv) #define PL_basetime (PL_curinterp->Ibasetime) #define PL_beginav (PL_curinterp->Ibeginav) -#define PL_bytecode_iv_overflows (PL_curinterp->Ibytecode_iv_overflows) -#define PL_bytecode_obj_list (PL_curinterp->Ibytecode_obj_list) -#define PL_bytecode_obj_list_fill (PL_curinterp->Ibytecode_obj_list_fill) -#define PL_bytecode_pv (PL_curinterp->Ibytecode_pv) -#define PL_bytecode_sv (PL_curinterp->Ibytecode_sv) #define PL_cddir (PL_curinterp->Icddir) #define PL_compcv (PL_curinterp->Icompcv) #define PL_compiling (PL_curinterp->Icompiling) @@ -287,11 +282,6 @@ #define PL_Iargvoutgv PL_argvoutgv #define PL_Ibasetime PL_basetime #define PL_Ibeginav PL_beginav -#define PL_Ibytecode_iv_overflows PL_bytecode_iv_overflows -#define PL_Ibytecode_obj_list PL_bytecode_obj_list -#define PL_Ibytecode_obj_list_fill PL_bytecode_obj_list_fill -#define PL_Ibytecode_pv PL_bytecode_pv -#define PL_Ibytecode_sv PL_bytecode_sv #define PL_Icddir PL_cddir #define PL_Icompcv PL_compcv #define PL_Icompiling PL_compiling @@ -757,7 +747,6 @@ #define PL_oldbufptr (PL_Vars.Goldbufptr) #define PL_oldoldbufptr (PL_Vars.Goldoldbufptr) #define PL_op_seqmax (PL_Vars.Gop_seqmax) -#define PL_optype_size (PL_Vars.Goptype_size) #define PL_origalen (PL_Vars.Gorigalen) #define PL_origenviron (PL_Vars.Gorigenviron) #define PL_osname (PL_Vars.Gosname) @@ -769,7 +758,6 @@ #define PL_runops (PL_Vars.Grunops) #define PL_sh_path (PL_Vars.Gsh_path) #define PL_sighandlerp (PL_Vars.Gsighandlerp) -#define PL_specialsv_list (PL_Vars.Gspecialsv_list) #define PL_srand_called (PL_Vars.Gsrand_called) #define PL_subline (PL_Vars.Gsubline) #define PL_subname (PL_Vars.Gsubname) @@ -897,7 +885,6 @@ #define PL_Goldbufptr PL_oldbufptr #define PL_Goldoldbufptr PL_oldoldbufptr #define PL_Gop_seqmax PL_op_seqmax -#define PL_Goptype_size PL_optype_size #define PL_Gorigalen PL_origalen #define PL_Gorigenviron PL_origenviron #define PL_Gosname PL_osname @@ -909,7 +896,6 @@ #define PL_Grunops PL_runops #define PL_Gsh_path PL_sh_path #define PL_Gsighandlerp PL_sighandlerp -#define PL_Gspecialsv_list PL_specialsv_list #define PL_Gsrand_called PL_srand_called #define PL_Gsubline PL_subline #define PL_Gsubname PL_subname diff --git a/ext/B/B.pm b/ext/B/B.pm index 0bfceaf..cdbd3b2 100644 --- a/ext/B/B.pm +++ b/ext/B/B.pm @@ -9,7 +9,7 @@ package B; require DynaLoader; require Exporter; @ISA = qw(Exporter DynaLoader); -@EXPORT_OK = qw(byteload_fh byteload_string minus_c ppname +@EXPORT_OK = qw(minus_c ppname class peekop cast_I32 cstring cchar hash threadsv_names main_root main_start main_cv svref_2object opnumber amagic_generation walkoptree walkoptree_slow walkoptree_exec walksymtable @@ -820,11 +820,6 @@ preceding the first "::". This is used to turn "B::UNOP" into In a perl compiled for threads, this returns a list of the special per-thread threadsv variables. -=item byteload_fh(FILEHANDLE) - -Load the contents of FILEHANDLE as bytecode. See documentation for -the B module in F for how to generate bytecode. - =back =head1 AUTHOR diff --git a/ext/B/B.xs b/ext/B/B.xs index 466091d..36d61f3 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -83,6 +83,8 @@ static char *opclassnames[] = { static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */ +static SV *specialsv_list[4]; + static opclass cc_opclass(OP *o) { @@ -197,8 +199,8 @@ make_sv_object(SV *arg, SV *sv) char *type = 0; IV iv; - for (iv = 0; iv < sizeof(PL_specialsv_list)/sizeof(SV*); iv++) { - if (sv == PL_specialsv_list[iv]) { + for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) { + if (sv == specialsv_list[iv]) { type = "B::SPECIAL"; break; } @@ -311,74 +313,6 @@ cchar(SV *sv) return sstr; } -#ifdef INDIRECT_BGET_MACROS -void freadpv(U32 len, void *data) -{ - New(666, pv.xpv_pv, len, char); - fread(pv.xpv_pv, 1, len, (FILE*)data); - pv.xpv_len = len; - pv.xpv_cur = len - 1; -} - -void byteload_fh(InputStream fp) -{ - struct bytestream bs; - bs.data = fp; - bs.fgetc = (int(*) _((void*)))fgetc; - bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread; - bs.freadpv = freadpv; - byterun(bs); -} - -static int fgetc_fromstring(void *data) -{ - char **strp = (char **)data; - return *(*strp)++; -} - -static int fread_fromstring(char *argp, size_t elemsize, size_t nelem, - void *data) -{ - char **strp = (char **)data; - size_t len = elemsize * nelem; - - memcpy(argp, *strp, len); - *strp += len; - return (int)len; -} - -static void freadpv_fromstring(U32 len, void *data) -{ - char **strp = (char **)data; - - New(666, pv.xpv_pv, len, char); - memcpy(pv.xpv_pv, *strp, len); - pv.xpv_len = len; - pv.xpv_cur = len - 1; - *strp += len; -} - -void byteload_string(char *str) -{ - struct bytestream bs; - bs.data = &str; - bs.fgetc = fgetc_fromstring; - bs.fread = fread_fromstring; - bs.freadpv = freadpv_fromstring; - byterun(bs); -} -#else -void byteload_fh(InputStream fp) -{ - byterun(fp); -} - -void byteload_string(char *str) -{ - croak("Must compile with -DINDIRECT_BGET_MACROS for byteload_string"); -} -#endif /* INDIRECT_BGET_MACROS */ - void walkoptree(SV *opsv, char *method) { @@ -446,7 +380,10 @@ BOOT: { HV *stash = gv_stashpvn("B", 1, TRUE); AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE); - INIT_SPECIALSV_LIST; + specialsv_list[0] = Nullsv; + specialsv_list[1] = &PL_sv_undef; + specialsv_list[2] = &PL_sv_yes; + specialsv_list[3] = &PL_sv_no; #include "defsubs.h" } diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm index 29683b8..42b9199 100644 --- a/ext/B/B/Bytecode.pm +++ b/ext/B/B/Bytecode.pm @@ -894,13 +894,16 @@ C and C are omitted. =head1 EXAMPLES - perl -MO=Bytecode,-O6,-o,foo.plc foo.pl + perl -MO=Bytecode,-O6,-o,foo.plc foo.pl - perl -MO=Bytecode,-S foo.pl > foo.S - assemble foo.S > foo.plc - byteperl foo.plc + perl -MO=Bytecode,-S foo.pl > foo.S + assemble foo.S > foo.plc - perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm +Note that C lives in the C subdirectory of your perl +library directory. The utility called perlcc may also be used to +help make use of this compiler. + + perl -MO=Bytecode,-m,-oFoo.pmc Foo.pm =head1 BUGS diff --git a/ext/B/Makefile.PL b/ext/B/Makefile.PL index ff3694d..9af85c9 100644 --- a/ext/B/Makefile.PL +++ b/ext/B/Makefile.PL @@ -18,7 +18,7 @@ WriteMakefile( VERSION => "a5", MAN3PODS => {}, clean => { - FILES => "perl$e byteperl$e *$o B.c defsubs.h *~" + FILES => "perl$e *$o B.c defsubs.h *~" } ); @@ -33,22 +33,3 @@ sub postamble { B$(OBJ_EXT) : defsubs.h ' } - -# Leave out doing byteperl for now. Probably should be built in the -# core directory or somewhere else rather than here -#sub top_targets { -# my $self = shift; -# my $targets = $self->MM::top_targets(); -# $targets =~ s/^(all ::.*)$/$1 byteperl$e/m; -# return <<"EOT" . $targets; - -# -# byteperl is *not* a standard perl+XSUB executable. It's a special -# program for running standalone bytecode executables. It isn't an XSUB -# at the moment because a standlone Perl program needs to set up curpad -# which is overwritten on exit from an XSUB. -# -#byteperl$e : byteperl$o B$o \$(PERL_SRC)/byterun$o -# \$(CC) ${exeout_flag}byteperl$e byteperl$o B$o byterun$o \$(LDFLAGS) \$(PERL_ARCHLIB)/CORE/$Config{libperl} \$(LIBS) -#EOT -#} diff --git a/ext/ByteLoader/ByteLoader.pm b/ext/ByteLoader/ByteLoader.pm index d11d957..4687010 100644 --- a/ext/ByteLoader/ByteLoader.pm +++ b/ext/ByteLoader/ByteLoader.pm @@ -4,7 +4,7 @@ require DynaLoader; @ISA = qw(DynaLoader); -$VERSION = 0.01; +$VERSION = 0.03; bootstrap ByteLoader $VERSION; @@ -19,10 +19,10 @@ ByteLoader - load byte compiled perl code =head1 SYNOPSIS - use ByteLoader 0.01; + use ByteLoader 0.03; - use ByteLoader 0.01; + use ByteLoader 0.03; =head1 DESCRIPTION diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs index 24c3ae8..ae2e18c 100644 --- a/ext/ByteLoader/ByteLoader.xs +++ b/ext/ByteLoader/ByteLoader.xs @@ -1,17 +1,16 @@ #include "EXTERN.h" #include "perl.h" #include "XSUB.h" +#include "byterun.h" -#ifndef WIN32 -/* this is probably not needed manywhere */ -# include "byterun.c" -#endif - -/* defgv must be accessed differently under threaded perl */ -/* DEFSV et al are in 5.004_56 */ -#ifndef DEFSV -#define DEFSV GvSV(defgv) -#endif +static void +freadpv(U32 len, void *data, XPV *pv) +{ + New(666, pv->xpv_pv, len, char); + fread(pv->xpv_pv, 1, len, (FILE*)data); + pv->xpv_len = len; + pv->xpv_cur = len - 1; +} static I32 #ifdef PERL_OBJECT @@ -23,17 +22,14 @@ byteloader_filter(int idx, SV *buf_sv, int maxlen) dTHR; OP *saveroot = PL_main_root; OP *savestart = PL_main_start; - -#ifdef INDIRECT_BGET_MACROS - struct bytesream bs; + struct bytestream bs; bs.data = PL_rsfp; bs.fgetc = (int(*) _((void*)))fgetc; bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread; bs.freadpv = freadpv; -#else - byterun(PL_rsfp); -#endif + + byterun(bs); if (PL_in_eval) { OP *o; diff --git a/ext/ByteLoader/Makefile.PL b/ext/ByteLoader/Makefile.PL index 4aabe79..1facb5a 100644 --- a/ext/ByteLoader/Makefile.PL +++ b/ext/ByteLoader/Makefile.PL @@ -1,10 +1,8 @@ use ExtUtils::MakeMaker; -# See lib/ExtUtils/MakeMaker.pm for details of how to influence -# the contents of the Makefile that is written. + WriteMakefile( - 'NAME' => 'ByteLoader', - 'VERSION_FROM' => 'ByteLoader.pm', # finds $VERSION - 'LIBS' => [''], # e.g., '-lm' - 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING' - 'INC' => '-I$(PERL_SRC)', # e.g., '-I/usr/include/other' + NAME => 'ByteLoader', + VERSION_FROM => 'ByteLoader.pm', + XSPROTOARG => '-noprototypes', + OBJECT => 'byterun$(OBJ_EXT) ByteLoader$(OBJ_EXT)', ); diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h new file mode 100644 index 0000000..442ea5b --- /dev/null +++ b/ext/ByteLoader/bytecode.h @@ -0,0 +1,429 @@ +typedef char *pvcontents; +typedef char *strconst; +typedef U32 PV; +typedef char *op_tr_array; +typedef int comment_t; +typedef SV *svindex; +typedef OP *opindex; +typedef IV IV64; + +#define BGET_FREAD(argp, len, nelem) \ + bs.fread((char*)(argp),(len),(nelem),bs.data) +#define BGET_FGETC() bs.fgetc(bs.data) + +#define BGET_U32(arg) \ + BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg) +#define BGET_I32(arg) \ + BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg) +#define BGET_U16(arg) \ + BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg) +#define BGET_U8(arg) arg = BGET_FGETC() + +#define BGET_PV(arg) STMT_START { \ + BGET_U32(arg); \ + if (arg) \ + bs.freadpv(arg, bs.data, &bytecode_pv); \ + else { \ + bytecode_pv.xpv_pv = 0; \ + bytecode_pv.xpv_len = 0; \ + bytecode_pv.xpv_cur = 0; \ + } \ + } STMT_END + +#define BGET_comment_t(arg) \ + do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF) + +/* + * In the following, sizeof(IV)*4 is just a way of encoding 32 on 64-bit-IV + * machines such that 32-bit machine compilers don't whine about the shift + * count being too high even though the code is never reached there. + */ +#define BGET_IV64(arg) STMT_START { \ + U32 hi, lo; \ + BGET_U32(hi); \ + BGET_U32(lo); \ + if (sizeof(IV) == 8) \ + arg = (IV) (hi << (sizeof(IV)*4) | lo); \ + else if (((I32)hi == -1 && (I32)lo < 0) \ + || ((I32)hi == 0 && (I32)lo >= 0)) { \ + arg = (I32)lo; \ + } \ + else { \ + bytecode_iv_overflows++; \ + arg = 0; \ + } \ + } STMT_END + +#define BGET_op_tr_array(arg) do { \ + unsigned short *ary; \ + int i; \ + New(666, ary, 256, unsigned short); \ + BGET_FREAD(ary, 256, 2); \ + for (i = 0; i < 256; i++) \ + ary[i] = PerlSock_ntohs(ary[i]); \ + arg = (char *) ary; \ + } while (0) + +#define BGET_pvcontents(arg) arg = bytecode_pv.xpv_pv +#define BGET_strconst(arg) STMT_START { \ + for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \ + arg = PL_tokenbuf; \ + } STMT_END + +#define BGET_double(arg) STMT_START { \ + char *str; \ + BGET_strconst(str); \ + arg = atof(str); \ + } STMT_END + +#define BGET_objindex(arg, type) STMT_START { \ + U32 ix; \ + BGET_U32(ix); \ + arg = (type)bytecode_obj_list[ix]; \ + } STMT_END +#define BGET_svindex(arg) BGET_objindex(arg, svindex) +#define BGET_opindex(arg) BGET_objindex(arg, opindex) + +#define BSET_ldspecsv(sv, arg) sv = specialsv_list[arg] + +#define BSET_sv_refcnt_add(svrefcnt, arg) svrefcnt += arg +#define BSET_gp_refcnt_add(gprefcnt, arg) gprefcnt += arg +#define BSET_gp_share(sv, arg) STMT_START { \ + gp_free((GV*)sv); \ + GvGP(sv) = GvGP(arg); \ + } STMT_END + +#define BSET_gv_fetchpv(sv, arg) sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV) +#define BSET_gv_stashpv(sv, arg) sv = (SV*)gv_stashpv(arg, TRUE) +#define BSET_sv_magic(sv, arg) sv_magic(sv, Nullsv, arg, 0, 0) +#define BSET_mg_pv(mg, arg) mg->mg_ptr = arg; mg->mg_len = bytecode_pv.xpv_cur +#define BSET_sv_upgrade(sv, arg) (void)SvUPGRADE(sv, arg) +#define BSET_xpv(sv) do { \ + SvPV_set(sv, bytecode_pv.xpv_pv); \ + SvCUR_set(sv, bytecode_pv.xpv_cur); \ + SvLEN_set(sv, bytecode_pv.xpv_len); \ + } while (0) +#define BSET_av_extend(sv, arg) av_extend((AV*)sv, arg) + +#define BSET_av_push(sv, arg) av_push((AV*)sv, arg) +#define BSET_hv_store(sv, arg) \ + hv_store((HV*)sv, bytecode_pv.xpv_pv, bytecode_pv.xpv_cur, arg, 0) +#define BSET_pv_free(pv) Safefree(pv.xpv_pv) +#define BSET_pregcomp(o, arg) \ + ((PMOP*)o)->op_pmregexp = arg ? \ + CALLREGCOMP(arg, arg + bytecode_pv.xpv_cur, ((PMOP*)o)) : 0 +#define BSET_newsv(sv, arg) sv = NEWSV(666,0); SvUPGRADE(sv, arg) +#define BSET_newop(o, arg) o = (OP*)safemalloc(optype_size[arg]) +#define BSET_newopn(o, arg) STMT_START { \ + OP *oldop = o; \ + BSET_newop(o, arg); \ + oldop->op_next = o; \ + } STMT_END + +#define BSET_ret(foo) return + +/* + * Kludge special-case workaround for OP_MAPSTART + * which needs the ppaddr for OP_GREPSTART. Blech. + */ +#define BSET_op_type(o, arg) STMT_START { \ + o->op_type = arg; \ + if (arg == OP_MAPSTART) \ + arg = OP_GREPSTART; \ + o->op_ppaddr = PL_ppaddr[arg]; \ + } STMT_END +#define BSET_op_ppaddr(o, arg) croak("op_ppaddr not yet implemented") +#define BSET_curpad(pad, arg) STMT_START { \ + PL_comppad = (AV *)arg; \ + pad = AvARRAY(arg); \ + } STMT_END + +#define BSET_OBJ_STORE(obj, ix) \ + (I32)ix > bytecode_obj_list_fill ? \ + bset_obj_store(obj, (I32)ix) : (bytecode_obj_list[ix] = obj) +typedef char *pvcontents; +typedef char *strconst; +typedef U32 PV; +typedef char *op_tr_array; +typedef int comment_t; +typedef SV *svindex; +typedef OP *opindex; +typedef IV IV64; + +#define BGET_FREAD(argp, len, nelem) \ + bs.fread((char*)(argp),(len),(nelem),bs.data) +#define BGET_FGETC() bs.fgetc(bs.data) + +#define BGET_U32(arg) \ + BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg) +#define BGET_I32(arg) \ + BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg) +#define BGET_U16(arg) \ + BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg) +#define BGET_U8(arg) arg = BGET_FGETC() + +#define BGET_PV(arg) STMT_START { \ + BGET_U32(arg); \ + if (arg) \ + bs.freadpv(arg, bs.data, &bytecode_pv); \ + else { \ + bytecode_pv.xpv_pv = 0; \ + bytecode_pv.xpv_len = 0; \ + bytecode_pv.xpv_cur = 0; \ + } \ + } STMT_END + +#define BGET_comment_t(arg) \ + do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF) + +/* + * In the following, sizeof(IV)*4 is just a way of encoding 32 on 64-bit-IV + * machines such that 32-bit machine compilers don't whine about the shift + * count being too high even though the code is never reached there. + */ +#define BGET_IV64(arg) STMT_START { \ + U32 hi, lo; \ + BGET_U32(hi); \ + BGET_U32(lo); \ + if (sizeof(IV) == 8) \ + arg = (IV) (hi << (sizeof(IV)*4) | lo); \ + else if (((I32)hi == -1 && (I32)lo < 0) \ + || ((I32)hi == 0 && (I32)lo >= 0)) { \ + arg = (I32)lo; \ + } \ + else { \ + bytecode_iv_overflows++; \ + arg = 0; \ + } \ + } STMT_END + +#define BGET_op_tr_array(arg) do { \ + unsigned short *ary; \ + int i; \ + New(666, ary, 256, unsigned short); \ + BGET_FREAD(ary, 256, 2); \ + for (i = 0; i < 256; i++) \ + ary[i] = PerlSock_ntohs(ary[i]); \ + arg = (char *) ary; \ + } while (0) + +#define BGET_pvcontents(arg) arg = bytecode_pv.xpv_pv +#define BGET_strconst(arg) STMT_START { \ + for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \ + arg = PL_tokenbuf; \ + } STMT_END + +#define BGET_double(arg) STMT_START { \ + char *str; \ + BGET_strconst(str); \ + arg = atof(str); \ + } STMT_END + +#define BGET_objindex(arg, type) STMT_START { \ + U32 ix; \ + BGET_U32(ix); \ + arg = (type)bytecode_obj_list[ix]; \ + } STMT_END +#define BGET_svindex(arg) BGET_objindex(arg, svindex) +#define BGET_opindex(arg) BGET_objindex(arg, opindex) + +#define BSET_ldspecsv(sv, arg) sv = specialsv_list[arg] + +#define BSET_sv_refcnt_add(svrefcnt, arg) svrefcnt += arg +#define BSET_gp_refcnt_add(gprefcnt, arg) gprefcnt += arg +#define BSET_gp_share(sv, arg) STMT_START { \ + gp_free((GV*)sv); \ + GvGP(sv) = GvGP(arg); \ + } STMT_END + +#define BSET_gv_fetchpv(sv, arg) sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV) +#define BSET_gv_stashpv(sv, arg) sv = (SV*)gv_stashpv(arg, TRUE) +#define BSET_sv_magic(sv, arg) sv_magic(sv, Nullsv, arg, 0, 0) +#define BSET_mg_pv(mg, arg) mg->mg_ptr = arg; mg->mg_len = bytecode_pv.xpv_cur +#define BSET_sv_upgrade(sv, arg) (void)SvUPGRADE(sv, arg) +#define BSET_xpv(sv) do { \ + SvPV_set(sv, bytecode_pv.xpv_pv); \ + SvCUR_set(sv, bytecode_pv.xpv_cur); \ + SvLEN_set(sv, bytecode_pv.xpv_len); \ + } while (0) +#define BSET_av_extend(sv, arg) av_extend((AV*)sv, arg) + +#define BSET_av_push(sv, arg) av_push((AV*)sv, arg) +#define BSET_hv_store(sv, arg) \ + hv_store((HV*)sv, bytecode_pv.xpv_pv, bytecode_pv.xpv_cur, arg, 0) +#define BSET_pv_free(pv) Safefree(pv.xpv_pv) +#define BSET_pregcomp(o, arg) \ + ((PMOP*)o)->op_pmregexp = arg ? \ + CALLREGCOMP(arg, arg + bytecode_pv.xpv_cur, ((PMOP*)o)) : 0 +#define BSET_newsv(sv, arg) sv = NEWSV(666,0); SvUPGRADE(sv, arg) +#define BSET_newop(o, arg) o = (OP*)safemalloc(optype_size[arg]) +#define BSET_newopn(o, arg) STMT_START { \ + OP *oldop = o; \ + BSET_newop(o, arg); \ + oldop->op_next = o; \ + } STMT_END + +#define BSET_ret(foo) return + +/* + * Kludge special-case workaround for OP_MAPSTART + * which needs the ppaddr for OP_GREPSTART. Blech. + */ +#define BSET_op_type(o, arg) STMT_START { \ + o->op_type = arg; \ + if (arg == OP_MAPSTART) \ + arg = OP_GREPSTART; \ + o->op_ppaddr = PL_ppaddr[arg]; \ + } STMT_END +#define BSET_op_ppaddr(o, arg) croak("op_ppaddr not yet implemented") +#define BSET_curpad(pad, arg) STMT_START { \ + PL_comppad = (AV *)arg; \ + pad = AvARRAY(arg); \ + } STMT_END + +#define BSET_OBJ_STORE(obj, ix) \ + (I32)ix > bytecode_obj_list_fill ? \ + bset_obj_store(obj, (I32)ix) : (bytecode_obj_list[ix] = obj) +typedef char *pvcontents; +typedef char *strconst; +typedef U32 PV; +typedef char *op_tr_array; +typedef int comment_t; +typedef SV *svindex; +typedef OP *opindex; +typedef IV IV64; + +#define BGET_FREAD(argp, len, nelem) \ + bs.fread((char*)(argp),(len),(nelem),bs.data) +#define BGET_FGETC() bs.fgetc(bs.data) + +#define BGET_U32(arg) \ + BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg) +#define BGET_I32(arg) \ + BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg) +#define BGET_U16(arg) \ + BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg) +#define BGET_U8(arg) arg = BGET_FGETC() + +#define BGET_PV(arg) STMT_START { \ + BGET_U32(arg); \ + if (arg) \ + bs.freadpv(arg, bs.data, &bytecode_pv); \ + else { \ + bytecode_pv.xpv_pv = 0; \ + bytecode_pv.xpv_len = 0; \ + bytecode_pv.xpv_cur = 0; \ + } \ + } STMT_END + +#define BGET_comment_t(arg) \ + do { arg = BGET_FGETC(); } while (arg != '\n' && arg != EOF) + +/* + * In the following, sizeof(IV)*4 is just a way of encoding 32 on 64-bit-IV + * machines such that 32-bit machine compilers don't whine about the shift + * count being too high even though the code is never reached there. + */ +#define BGET_IV64(arg) STMT_START { \ + U32 hi, lo; \ + BGET_U32(hi); \ + BGET_U32(lo); \ + if (sizeof(IV) == 8) \ + arg = (IV) (hi << (sizeof(IV)*4) | lo); \ + else if (((I32)hi == -1 && (I32)lo < 0) \ + || ((I32)hi == 0 && (I32)lo >= 0)) { \ + arg = (I32)lo; \ + } \ + else { \ + bytecode_iv_overflows++; \ + arg = 0; \ + } \ + } STMT_END + +#define BGET_op_tr_array(arg) do { \ + unsigned short *ary; \ + int i; \ + New(666, ary, 256, unsigned short); \ + BGET_FREAD(ary, 256, 2); \ + for (i = 0; i < 256; i++) \ + ary[i] = PerlSock_ntohs(ary[i]); \ + arg = (char *) ary; \ + } while (0) + +#define BGET_pvcontents(arg) arg = bytecode_pv.xpv_pv +#define BGET_strconst(arg) STMT_START { \ + for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \ + arg = PL_tokenbuf; \ + } STMT_END + +#define BGET_double(arg) STMT_START { \ + char *str; \ + BGET_strconst(str); \ + arg = atof(str); \ + } STMT_END + +#define BGET_objindex(arg, type) STMT_START { \ + U32 ix; \ + BGET_U32(ix); \ + arg = (type)bytecode_obj_list[ix]; \ + } STMT_END +#define BGET_svindex(arg) BGET_objindex(arg, svindex) +#define BGET_opindex(arg) BGET_objindex(arg, opindex) + +#define BSET_ldspecsv(sv, arg) sv = specialsv_list[arg] + +#define BSET_sv_refcnt_add(svrefcnt, arg) svrefcnt += arg +#define BSET_gp_refcnt_add(gprefcnt, arg) gprefcnt += arg +#define BSET_gp_share(sv, arg) STMT_START { \ + gp_free((GV*)sv); \ + GvGP(sv) = GvGP(arg); \ + } STMT_END + +#define BSET_gv_fetchpv(sv, arg) sv = (SV*)gv_fetchpv(arg, TRUE, SVt_PV) +#define BSET_gv_stashpv(sv, arg) sv = (SV*)gv_stashpv(arg, TRUE) +#define BSET_sv_magic(sv, arg) sv_magic(sv, Nullsv, arg, 0, 0) +#define BSET_mg_pv(mg, arg) mg->mg_ptr = arg; mg->mg_len = bytecode_pv.xpv_cur +#define BSET_sv_upgrade(sv, arg) (void)SvUPGRADE(sv, arg) +#define BSET_xpv(sv) do { \ + SvPV_set(sv, bytecode_pv.xpv_pv); \ + SvCUR_set(sv, bytecode_pv.xpv_cur); \ + SvLEN_set(sv, bytecode_pv.xpv_len); \ + } while (0) +#define BSET_av_extend(sv, arg) av_extend((AV*)sv, arg) + +#define BSET_av_push(sv, arg) av_push((AV*)sv, arg) +#define BSET_hv_store(sv, arg) \ + hv_store((HV*)sv, bytecode_pv.xpv_pv, bytecode_pv.xpv_cur, arg, 0) +#define BSET_pv_free(pv) Safefree(pv.xpv_pv) +#define BSET_pregcomp(o, arg) \ + ((PMOP*)o)->op_pmregexp = arg ? \ + CALLREGCOMP(arg, arg + bytecode_pv.xpv_cur, ((PMOP*)o)) : 0 +#define BSET_newsv(sv, arg) sv = NEWSV(666,0); SvUPGRADE(sv, arg) +#define BSET_newop(o, arg) o = (OP*)safemalloc(optype_size[arg]) +#define BSET_newopn(o, arg) STMT_START { \ + OP *oldop = o; \ + BSET_newop(o, arg); \ + oldop->op_next = o; \ + } STMT_END + +#define BSET_ret(foo) return + +/* + * Kludge special-case workaround for OP_MAPSTART + * which needs the ppaddr for OP_GREPSTART. Blech. + */ +#define BSET_op_type(o, arg) STMT_START { \ + o->op_type = arg; \ + if (arg == OP_MAPSTART) \ + arg = OP_GREPSTART; \ + o->op_ppaddr = PL_ppaddr[arg]; \ + } STMT_END +#define BSET_op_ppaddr(o, arg) croak("op_ppaddr not yet implemented") +#define BSET_curpad(pad, arg) STMT_START { \ + PL_comppad = (AV *)arg; \ + pad = AvARRAY(arg); \ + } STMT_END + +#define BSET_OBJ_STORE(obj, ix) \ + (I32)ix > bytecode_obj_list_fill ? \ + bset_obj_store(obj, (I32)ix) : (bytecode_obj_list[ix] = obj) diff --git a/byterun.c b/ext/ByteLoader/byterun.c similarity index 78% rename from byterun.c rename to ext/ByteLoader/byterun.c index f8c07f9..ab5b5fc 100644 --- a/byterun.c +++ b/ext/ByteLoader/byterun.c @@ -11,29 +11,56 @@ #include "EXTERN.h" #include "perl.h" +#include "byterun.h" +#include "bytecode.h" + +static int optype_size[] = { + sizeof(OP), + sizeof(UNOP), + sizeof(BINOP), + sizeof(LOGOP), + sizeof(CONDOP), + sizeof(LISTOP), + sizeof(PMOP), + sizeof(SVOP), + sizeof(GVOP), + sizeof(PVOP), + sizeof(LOOP), + sizeof(COP) +}; + +static SV *specialsv_list[4]; + +static int bytecode_iv_overflows = 0; +static SV *bytecode_sv; +static XPV bytecode_pv; +static void **bytecode_obj_list; +static I32 bytecode_obj_list_fill = -1; void * bset_obj_store(void *obj, I32 ix) { - if (ix > PL_bytecode_obj_list_fill) { - if (PL_bytecode_obj_list_fill == -1) - New(666, PL_bytecode_obj_list, ix + 1, void*); + if (ix > bytecode_obj_list_fill) { + if (bytecode_obj_list_fill == -1) + New(666, bytecode_obj_list, ix + 1, void*); else - Renew(PL_bytecode_obj_list, ix + 1, void*); - PL_bytecode_obj_list_fill = ix; + Renew(bytecode_obj_list, ix + 1, void*); + bytecode_obj_list_fill = ix; } - PL_bytecode_obj_list[ix] = obj; + bytecode_obj_list[ix] = obj; return obj; } -#ifdef INDIRECT_BGET_MACROS void byterun(struct bytestream bs) -#else -void byterun(PerlIO *fp) -#endif /* INDIRECT_BGET_MACROS */ { dTHR; int insn; + + specialsv_list[0] = Nullsv; + specialsv_list[1] = &PL_sv_undef; + specialsv_list[2] = &PL_sv_yes; + specialsv_list[3] = &PL_sv_no; + while ((insn = BGET_FGETC()) != EOF) { switch (insn) { case INSN_COMMENT: /* 35 */ @@ -56,7 +83,7 @@ void byterun(PerlIO *fp) { svindex arg; BGET_svindex(arg); - PL_bytecode_sv = arg; + bytecode_sv = arg; break; } case INSN_LDOP: /* 2 */ @@ -70,7 +97,7 @@ void byterun(PerlIO *fp) { U32 arg; BGET_U32(arg); - BSET_OBJ_STORE(PL_bytecode_sv, arg); + BSET_OBJ_STORE(bytecode_sv, arg); break; } case INSN_STOP: /* 4 */ @@ -84,14 +111,14 @@ void byterun(PerlIO *fp) { U8 arg; BGET_U8(arg); - BSET_ldspecsv(PL_bytecode_sv, arg); + BSET_ldspecsv(bytecode_sv, arg); break; } case INSN_NEWSV: /* 6 */ { U8 arg; BGET_U8(arg); - BSET_newsv(PL_bytecode_sv, arg); + BSET_newsv(bytecode_sv, arg); break; } case INSN_NEWOP: /* 7 */ @@ -118,486 +145,486 @@ void byterun(PerlIO *fp) { STRLEN arg; BGET_U32(arg); - PL_bytecode_pv.xpv_cur = arg; + bytecode_pv.xpv_cur = arg; break; } case INSN_PV_FREE: /* 12 */ { - BSET_pv_free(PL_bytecode_pv); + BSET_pv_free(bytecode_pv); break; } case INSN_SV_UPGRADE: /* 13 */ { char arg; BGET_U8(arg); - BSET_sv_upgrade(PL_bytecode_sv, arg); + BSET_sv_upgrade(bytecode_sv, arg); break; } case INSN_SV_REFCNT: /* 14 */ { U32 arg; BGET_U32(arg); - SvREFCNT(PL_bytecode_sv) = arg; + SvREFCNT(bytecode_sv) = arg; break; } case INSN_SV_REFCNT_ADD: /* 15 */ { I32 arg; BGET_I32(arg); - BSET_sv_refcnt_add(SvREFCNT(PL_bytecode_sv), arg); + BSET_sv_refcnt_add(SvREFCNT(bytecode_sv), arg); break; } case INSN_SV_FLAGS: /* 16 */ { U32 arg; BGET_U32(arg); - SvFLAGS(PL_bytecode_sv) = arg; + SvFLAGS(bytecode_sv) = arg; break; } case INSN_XRV: /* 17 */ { svindex arg; BGET_svindex(arg); - SvRV(PL_bytecode_sv) = arg; + SvRV(bytecode_sv) = arg; break; } case INSN_XPV: /* 18 */ { - BSET_xpv(PL_bytecode_sv); + BSET_xpv(bytecode_sv); break; } case INSN_XIV32: /* 19 */ { I32 arg; BGET_I32(arg); - SvIVX(PL_bytecode_sv) = arg; + SvIVX(bytecode_sv) = arg; break; } case INSN_XIV64: /* 20 */ { IV64 arg; BGET_IV64(arg); - SvIVX(PL_bytecode_sv) = arg; + SvIVX(bytecode_sv) = arg; break; } case INSN_XNV: /* 21 */ { double arg; BGET_double(arg); - SvNVX(PL_bytecode_sv) = arg; + SvNVX(bytecode_sv) = arg; break; } case INSN_XLV_TARGOFF: /* 22 */ { STRLEN arg; BGET_U32(arg); - LvTARGOFF(PL_bytecode_sv) = arg; + LvTARGOFF(bytecode_sv) = arg; break; } case INSN_XLV_TARGLEN: /* 23 */ { STRLEN arg; BGET_U32(arg); - LvTARGLEN(PL_bytecode_sv) = arg; + LvTARGLEN(bytecode_sv) = arg; break; } case INSN_XLV_TARG: /* 24 */ { svindex arg; BGET_svindex(arg); - LvTARG(PL_bytecode_sv) = arg; + LvTARG(bytecode_sv) = arg; break; } case INSN_XLV_TYPE: /* 25 */ { char arg; BGET_U8(arg); - LvTYPE(PL_bytecode_sv) = arg; + LvTYPE(bytecode_sv) = arg; break; } case INSN_XBM_USEFUL: /* 26 */ { I32 arg; BGET_I32(arg); - BmUSEFUL(PL_bytecode_sv) = arg; + BmUSEFUL(bytecode_sv) = arg; break; } case INSN_XBM_PREVIOUS: /* 27 */ { U16 arg; BGET_U16(arg); - BmPREVIOUS(PL_bytecode_sv) = arg; + BmPREVIOUS(bytecode_sv) = arg; break; } case INSN_XBM_RARE: /* 28 */ { U8 arg; BGET_U8(arg); - BmRARE(PL_bytecode_sv) = arg; + BmRARE(bytecode_sv) = arg; break; } case INSN_XFM_LINES: /* 29 */ { I32 arg; BGET_I32(arg); - FmLINES(PL_bytecode_sv) = arg; + FmLINES(bytecode_sv) = arg; break; } case INSN_XIO_LINES: /* 30 */ { long arg; BGET_I32(arg); - IoLINES(PL_bytecode_sv) = arg; + IoLINES(bytecode_sv) = arg; break; } case INSN_XIO_PAGE: /* 31 */ { long arg; BGET_I32(arg); - IoPAGE(PL_bytecode_sv) = arg; + IoPAGE(bytecode_sv) = arg; break; } case INSN_XIO_PAGE_LEN: /* 32 */ { long arg; BGET_I32(arg); - IoPAGE_LEN(PL_bytecode_sv) = arg; + IoPAGE_LEN(bytecode_sv) = arg; break; } case INSN_XIO_LINES_LEFT: /* 33 */ { long arg; BGET_I32(arg); - IoLINES_LEFT(PL_bytecode_sv) = arg; + IoLINES_LEFT(bytecode_sv) = arg; break; } case INSN_XIO_TOP_NAME: /* 34 */ { pvcontents arg; BGET_pvcontents(arg); - IoTOP_NAME(PL_bytecode_sv) = arg; + IoTOP_NAME(bytecode_sv) = arg; break; } case INSN_XIO_TOP_GV: /* 36 */ { svindex arg; BGET_svindex(arg); - *(SV**)&IoTOP_GV(PL_bytecode_sv) = arg; + *(SV**)&IoTOP_GV(bytecode_sv) = arg; break; } case INSN_XIO_FMT_NAME: /* 37 */ { pvcontents arg; BGET_pvcontents(arg); - IoFMT_NAME(PL_bytecode_sv) = arg; + IoFMT_NAME(bytecode_sv) = arg; break; } case INSN_XIO_FMT_GV: /* 38 */ { svindex arg; BGET_svindex(arg); - *(SV**)&IoFMT_GV(PL_bytecode_sv) = arg; + *(SV**)&IoFMT_GV(bytecode_sv) = arg; break; } case INSN_XIO_BOTTOM_NAME: /* 39 */ { pvcontents arg; BGET_pvcontents(arg); - IoBOTTOM_NAME(PL_bytecode_sv) = arg; + IoBOTTOM_NAME(bytecode_sv) = arg; break; } case INSN_XIO_BOTTOM_GV: /* 40 */ { svindex arg; BGET_svindex(arg); - *(SV**)&IoBOTTOM_GV(PL_bytecode_sv) = arg; + *(SV**)&IoBOTTOM_GV(bytecode_sv) = arg; break; } case INSN_XIO_SUBPROCESS: /* 41 */ { short arg; BGET_U16(arg); - IoSUBPROCESS(PL_bytecode_sv) = arg; + IoSUBPROCESS(bytecode_sv) = arg; break; } case INSN_XIO_TYPE: /* 42 */ { char arg; BGET_U8(arg); - IoTYPE(PL_bytecode_sv) = arg; + IoTYPE(bytecode_sv) = arg; break; } case INSN_XIO_FLAGS: /* 43 */ { char arg; BGET_U8(arg); - IoFLAGS(PL_bytecode_sv) = arg; + IoFLAGS(bytecode_sv) = arg; break; } case INSN_XCV_STASH: /* 44 */ { svindex arg; BGET_svindex(arg); - *(SV**)&CvSTASH(PL_bytecode_sv) = arg; + *(SV**)&CvSTASH(bytecode_sv) = arg; break; } case INSN_XCV_START: /* 45 */ { opindex arg; BGET_opindex(arg); - CvSTART(PL_bytecode_sv) = arg; + CvSTART(bytecode_sv) = arg; break; } case INSN_XCV_ROOT: /* 46 */ { opindex arg; BGET_opindex(arg); - CvROOT(PL_bytecode_sv) = arg; + CvROOT(bytecode_sv) = arg; break; } case INSN_XCV_GV: /* 47 */ { svindex arg; BGET_svindex(arg); - *(SV**)&CvGV(PL_bytecode_sv) = arg; + *(SV**)&CvGV(bytecode_sv) = arg; break; } case INSN_XCV_FILEGV: /* 48 */ { svindex arg; BGET_svindex(arg); - *(SV**)&CvFILEGV(PL_bytecode_sv) = arg; + *(SV**)&CvFILEGV(bytecode_sv) = arg; break; } case INSN_XCV_DEPTH: /* 49 */ { long arg; BGET_I32(arg); - CvDEPTH(PL_bytecode_sv) = arg; + CvDEPTH(bytecode_sv) = arg; break; } case INSN_XCV_PADLIST: /* 50 */ { svindex arg; BGET_svindex(arg); - *(SV**)&CvPADLIST(PL_bytecode_sv) = arg; + *(SV**)&CvPADLIST(bytecode_sv) = arg; break; } case INSN_XCV_OUTSIDE: /* 51 */ { svindex arg; BGET_svindex(arg); - *(SV**)&CvOUTSIDE(PL_bytecode_sv) = arg; + *(SV**)&CvOUTSIDE(bytecode_sv) = arg; break; } case INSN_XCV_FLAGS: /* 52 */ { U8 arg; BGET_U8(arg); - CvFLAGS(PL_bytecode_sv) = arg; + CvFLAGS(bytecode_sv) = arg; break; } case INSN_AV_EXTEND: /* 53 */ { SSize_t arg; BGET_I32(arg); - BSET_av_extend(PL_bytecode_sv, arg); + BSET_av_extend(bytecode_sv, arg); break; } case INSN_AV_PUSH: /* 54 */ { svindex arg; BGET_svindex(arg); - BSET_av_push(PL_bytecode_sv, arg); + BSET_av_push(bytecode_sv, arg); break; } case INSN_XAV_FILL: /* 55 */ { SSize_t arg; BGET_I32(arg); - AvFILLp(PL_bytecode_sv) = arg; + AvFILLp(bytecode_sv) = arg; break; } case INSN_XAV_MAX: /* 56 */ { SSize_t arg; BGET_I32(arg); - AvMAX(PL_bytecode_sv) = arg; + AvMAX(bytecode_sv) = arg; break; } case INSN_XAV_FLAGS: /* 57 */ { U8 arg; BGET_U8(arg); - AvFLAGS(PL_bytecode_sv) = arg; + AvFLAGS(bytecode_sv) = arg; break; } case INSN_XHV_RITER: /* 58 */ { I32 arg; BGET_I32(arg); - HvRITER(PL_bytecode_sv) = arg; + HvRITER(bytecode_sv) = arg; break; } case INSN_XHV_NAME: /* 59 */ { pvcontents arg; BGET_pvcontents(arg); - HvNAME(PL_bytecode_sv) = arg; + HvNAME(bytecode_sv) = arg; break; } case INSN_HV_STORE: /* 60 */ { svindex arg; BGET_svindex(arg); - BSET_hv_store(PL_bytecode_sv, arg); + BSET_hv_store(bytecode_sv, arg); break; } case INSN_SV_MAGIC: /* 61 */ { char arg; BGET_U8(arg); - BSET_sv_magic(PL_bytecode_sv, arg); + BSET_sv_magic(bytecode_sv, arg); break; } case INSN_MG_OBJ: /* 62 */ { svindex arg; BGET_svindex(arg); - SvMAGIC(PL_bytecode_sv)->mg_obj = arg; + SvMAGIC(bytecode_sv)->mg_obj = arg; break; } case INSN_MG_PRIVATE: /* 63 */ { U16 arg; BGET_U16(arg); - SvMAGIC(PL_bytecode_sv)->mg_private = arg; + SvMAGIC(bytecode_sv)->mg_private = arg; break; } case INSN_MG_FLAGS: /* 64 */ { U8 arg; BGET_U8(arg); - SvMAGIC(PL_bytecode_sv)->mg_flags = arg; + SvMAGIC(bytecode_sv)->mg_flags = arg; break; } case INSN_MG_PV: /* 65 */ { pvcontents arg; BGET_pvcontents(arg); - BSET_mg_pv(SvMAGIC(PL_bytecode_sv), arg); + BSET_mg_pv(SvMAGIC(bytecode_sv), arg); break; } case INSN_XMG_STASH: /* 66 */ { svindex arg; BGET_svindex(arg); - *(SV**)&SvSTASH(PL_bytecode_sv) = arg; + *(SV**)&SvSTASH(bytecode_sv) = arg; break; } case INSN_GV_FETCHPV: /* 67 */ { strconst arg; BGET_strconst(arg); - BSET_gv_fetchpv(PL_bytecode_sv, arg); + BSET_gv_fetchpv(bytecode_sv, arg); break; } case INSN_GV_STASHPV: /* 68 */ { strconst arg; BGET_strconst(arg); - BSET_gv_stashpv(PL_bytecode_sv, arg); + BSET_gv_stashpv(bytecode_sv, arg); break; } case INSN_GP_SV: /* 69 */ { svindex arg; BGET_svindex(arg); - GvSV(PL_bytecode_sv) = arg; + GvSV(bytecode_sv) = arg; break; } case INSN_GP_REFCNT: /* 70 */ { U32 arg; BGET_U32(arg); - GvREFCNT(PL_bytecode_sv) = arg; + GvREFCNT(bytecode_sv) = arg; break; } case INSN_GP_REFCNT_ADD: /* 71 */ { I32 arg; BGET_I32(arg); - BSET_gp_refcnt_add(GvREFCNT(PL_bytecode_sv), arg); + BSET_gp_refcnt_add(GvREFCNT(bytecode_sv), arg); break; } case INSN_GP_AV: /* 72 */ { svindex arg; BGET_svindex(arg); - *(SV**)&GvAV(PL_bytecode_sv) = arg; + *(SV**)&GvAV(bytecode_sv) = arg; break; } case INSN_GP_HV: /* 73 */ { svindex arg; BGET_svindex(arg); - *(SV**)&GvHV(PL_bytecode_sv) = arg; + *(SV**)&GvHV(bytecode_sv) = arg; break; } case INSN_GP_CV: /* 74 */ { svindex arg; BGET_svindex(arg); - *(SV**)&GvCV(PL_bytecode_sv) = arg; + *(SV**)&GvCV(bytecode_sv) = arg; break; } case INSN_GP_FILEGV: /* 75 */ { svindex arg; BGET_svindex(arg); - *(SV**)&GvFILEGV(PL_bytecode_sv) = arg; + *(SV**)&GvFILEGV(bytecode_sv) = arg; break; } case INSN_GP_IO: /* 76 */ { svindex arg; BGET_svindex(arg); - *(SV**)&GvIOp(PL_bytecode_sv) = arg; + *(SV**)&GvIOp(bytecode_sv) = arg; break; } case INSN_GP_FORM: /* 77 */ { svindex arg; BGET_svindex(arg); - *(SV**)&GvFORM(PL_bytecode_sv) = arg; + *(SV**)&GvFORM(bytecode_sv) = arg; break; } case INSN_GP_CVGEN: /* 78 */ { U32 arg; BGET_U32(arg); - GvCVGEN(PL_bytecode_sv) = arg; + GvCVGEN(bytecode_sv) = arg; break; } case INSN_GP_LINE: /* 79 */ { line_t arg; BGET_U16(arg); - GvLINE(PL_bytecode_sv) = arg; + GvLINE(bytecode_sv) = arg; break; } case INSN_GP_SHARE: /* 80 */ { svindex arg; BGET_svindex(arg); - BSET_gp_share(PL_bytecode_sv, arg); + BSET_gp_share(bytecode_sv, arg); break; } case INSN_XGV_FLAGS: /* 81 */ { U8 arg; BGET_U8(arg); - GvFLAGS(PL_bytecode_sv) = arg; + GvFLAGS(bytecode_sv) = arg; break; } case INSN_OP_NEXT: /* 82 */ diff --git a/byterun.h b/ext/ByteLoader/byterun.h similarity index 97% rename from byterun.h rename to ext/ByteLoader/byterun.h index 160913f..c293160 100644 --- a/byterun.h +++ b/ext/ByteLoader/byterun.h @@ -8,14 +8,12 @@ /* * This file is autogenerated from bytecode.pl. Changes made here will be lost. */ -#ifdef INDIRECT_BGET_MACROS struct bytestream { void *data; int (*fgetc)(void *); - int (*fread)(char *, size_t, size_t, void*); - void (*freadpv)(U32, void*); + int (*fread)(char *, size_t, size_t, void *); + void (*freadpv)(U32, void *, XPV *); }; -#endif /* INDIRECT_BGET_MACROS */ enum { INSN_RET, /* 0 */ diff --git a/global.sym b/global.sym index 44417d9..44f4361 100644 --- a/global.sym +++ b/global.sym @@ -33,7 +33,6 @@ block_gimme block_start boot_core_UNIVERSAL bset_obj_store -byterun call_list cando cast_ulong @@ -154,7 +153,6 @@ get_op_descs get_op_names get_no_modify get_opargs -get_specialsv_list get_vtbl gp_free gp_ref diff --git a/intrpvar.h b/intrpvar.h index e4f112e..d28d198 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -200,12 +200,6 @@ PERLVARI(Ithreadnum, U32, 0) /* incremented each thread creation */ PERLVAR(Istrtab_mutex, perl_mutex) /* Mutex for string table access */ #endif /* USE_THREADS */ -PERLVARI(Ibytecode_iv_overflows,int, 0) /* from bytecode.h */ -PERLVAR(Ibytecode_sv, SV *) -PERLVAR(Ibytecode_pv, XPV) -PERLVAR(Ibytecode_obj_list, void **) -PERLVARI(Ibytecode_obj_list_fill, I32, -1) - #ifdef PERL_OBJECT PERLVARI(piMem, IPerlMem*, NULL) PERLVARI(piENV, IPerlEnv*, NULL) diff --git a/objXSUB.h b/objXSUB.h index e4f90ab..9b6700a 100644 --- a/objXSUB.h +++ b/objXSUB.h @@ -62,16 +62,6 @@ #define PL_bufend pPerl->PL_bufend #undef PL_bufptr #define PL_bufptr pPerl->PL_bufptr -#undef PL_bytecode_iv_overflows -#define PL_bytecode_iv_overflows pPerl->PL_bytecode_iv_overflows -#undef PL_bytecode_obj_list -#define PL_bytecode_obj_list pPerl->PL_bytecode_obj_list -#undef PL_bytecode_obj_list_fill -#define PL_bytecode_obj_list_fill pPerl->PL_bytecode_obj_list_fill -#undef PL_bytecode_pv -#define PL_bytecode_pv pPerl->PL_bytecode_pv -#undef PL_bytecode_sv -#define PL_bytecode_sv pPerl->PL_bytecode_sv #undef PL_cddir #define PL_cddir pPerl->PL_cddir #undef PL_chopset @@ -442,8 +432,6 @@ #define PL_op_seqmax pPerl->PL_op_seqmax #undef PL_opsave #define PL_opsave pPerl->PL_opsave -#undef PL_optype_size -#define PL_optype_size pPerl->PL_optype_size #undef PL_origalen #define PL_origalen pPerl->PL_origalen #undef PL_origargc @@ -650,8 +638,6 @@ #define PL_sortcxix pPerl->PL_sortcxix #undef PL_sortstash #define PL_sortstash pPerl->PL_sortstash -#undef PL_specialsv_list -#define PL_specialsv_list pPerl->PL_specialsv_list #undef PL_splitstr #define PL_splitstr pPerl->PL_splitstr #undef PL_srand_called @@ -885,8 +871,6 @@ #define boot_core_UNIVERSAL pPerl->Perl_boot_core_UNIVERSAL #undef bset_obj_store #define bset_obj_store pPerl->Perl_bset_obj_store -#undef byterun -#define byterun pPerl->Perl_byterun #undef cache_re #define cache_re pPerl->Perl_cache_re #undef call_list @@ -1237,8 +1221,6 @@ #define get_op_names pPerl->Perl_get_op_names #undef get_opargs #define get_opargs pPerl->Perl_get_opargs -#undef get_specialsv_list -#define get_specialsv_list pPerl->Perl_get_specialsv_list #undef get_vtbl #define get_vtbl pPerl->Perl_get_vtbl #undef gp_free diff --git a/perl.h b/perl.h index f075f3a..97e130d 100644 --- a/perl.h +++ b/perl.h @@ -1538,8 +1538,6 @@ union any { #include "mg.h" #include "scope.h" #include "warning.h" -#include "bytecode.h" -#include "byterun.h" #include "utf8.h" /* Current curly descriptor */ diff --git a/perlvars.h b/perlvars.h index 061f8f3..3e1a24b 100644 --- a/perlvars.h +++ b/perlvars.h @@ -186,8 +186,6 @@ PERLVARIC(GNo, char *, "") PERLVARIC(Ghexdigit, char *, "0123456789abcdef0123456789ABCDEF") PERLVARIC(Gpatleave, char *, "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}") -PERLVAR(Gspecialsv_list[4],SV *) /* from byterun.h */ - /* perly.c globals */ PERLVAR(Gyydebug, int) PERLVAR(Gyynerrs, int) @@ -204,6 +202,4 @@ PERLVAR(Guudmap[256], char) PERLVAR(Gbitcount, char *) PERLVAR(Gfilter_debug, int) -/* byterun globals */ -PERLVAR(Goptype_size[], int) diff --git a/proto.h b/proto.h index 6ec5b37..aacf85e 100644 --- a/proto.h +++ b/proto.h @@ -932,7 +932,6 @@ void restore_expect _((void *e)); void restore_lex_expect _((void *e)); void yydestruct _((void *ptr)); VIRTUAL int fprintf _((PerlIO *pf, const char *pat, ...)); -VIRTUAL SV** get_specialsv_list _((void)); #ifdef WIN32 VIRTUAL int& ErrorNo _((void)); @@ -941,12 +940,6 @@ VIRTUAL int& ErrorNo _((void)); END_EXTERN_C #endif /* PERL_OBJECT */ -#ifdef INDIRECT_BGET_MACROS -VIRTUAL void byterun _((struct bytestream bs)); -#else -VIRTUAL void byterun _((PerlIO *fp)); -#endif /* INDIRECT_BGET_MACROS */ - VIRTUAL void sv_catpvf_mg _((SV *sv, const char* pat, ...)); VIRTUAL void sv_catpv_mg _((SV *sv, const char *ptr)); VIRTUAL void sv_catpvn_mg _((SV *sv, const char *ptr, STRLEN len)); diff --git a/util.c b/util.c index 82f094c..25739e4 100644 --- a/util.c +++ b/util.c @@ -3205,12 +3205,6 @@ get_opargs(void) return PL_opargs; } -SV ** -get_specialsv_list(void) -{ - return PL_specialsv_list; -} - #ifndef HAS_GETENV_LEN char * getenv_len(char *env_elem, unsigned long *len) diff --git a/utils/Makefile b/utils/Makefile index b650bbd..5f424e3 100644 --- a/utils/Makefile +++ b/utils/Makefile @@ -5,9 +5,9 @@ REALPERL = ../perl # Files to be built with variable substitution after miniperl is # available. Dependencies handled manually below (for now). -pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL perlcc.PL perlbc.PL -plextract = c2ph h2ph h2xs perlbug perldoc pl2pm splain perlcc perlbc -plextractexe = c2ph.exe h2ph.exe h2xs.exe perlbug.exe perldoc.exe pl2pm.exe splain.exe perlcc.exe perlbc.exe +pl = c2ph.PL h2ph.PL h2xs.PL perlbug.PL perldoc.PL pl2pm.PL splain.PL perlcc.PL +plextract = c2ph h2ph h2xs perlbug perldoc pl2pm splain perlcc +plextractexe = c2ph.exe h2ph.exe h2xs.exe perlbug.exe perldoc.exe pl2pm.exe splain.exe perlcc.exe all: $(plextract) @@ -33,8 +33,6 @@ splain: splain.PL ../config.sh ../lib/diagnostics.pm perlcc: perlcc.PL ../config.sh -perlbc: perlbc.PL ../config.sh - clean: realclean: