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
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
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
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
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)
# 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,
+++ /dev/null
-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)
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
#
# 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
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") {
#
# 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
#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
#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
#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
#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
#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
#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)
#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
#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)
#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)
#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
#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
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
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<Bytecode> module in F<B::Backend> for how to generate bytecode.
-
=back
=head1 AUTHOR
static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */
+static SV *specialsv_list[4];
+
static opclass
cc_opclass(OP *o)
{
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;
}
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)
{
{
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"
}
=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<assemble> lives in the C<B> 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
VERSION => "a5",
MAN3PODS => {},
clean => {
- FILES => "perl$e byteperl$e *$o B.c defsubs.h *~"
+ FILES => "perl$e *$o B.c defsubs.h *~"
}
);
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
-#}
@ISA = qw(DynaLoader);
-$VERSION = 0.01;
+$VERSION = 0.03;
bootstrap ByteLoader $VERSION;
=head1 SYNOPSIS
- use ByteLoader 0.01;
+ use ByteLoader 0.03;
<byte code>
- use ByteLoader 0.01;
+ use ByteLoader 0.03;
<byte code>
=head1 DESCRIPTION
#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
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;
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)',
);
--- /dev/null
+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)
#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 */
{
svindex arg;
BGET_svindex(arg);
- PL_bytecode_sv = arg;
+ bytecode_sv = arg;
break;
}
case INSN_LDOP: /* 2 */
{
U32 arg;
BGET_U32(arg);
- BSET_OBJ_STORE(PL_bytecode_sv, arg);
+ BSET_OBJ_STORE(bytecode_sv, arg);
break;
}
case INSN_STOP: /* 4 */
{
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 */
{
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 */
/*
* 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 */
block_start
boot_core_UNIVERSAL
bset_obj_store
-byterun
call_list
cando
cast_ulong
get_op_names
get_no_modify
get_opargs
-get_specialsv_list
get_vtbl
gp_free
gp_ref
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)
#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
#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
#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
#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
#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
#include "mg.h"
#include "scope.h"
#include "warning.h"
-#include "bytecode.h"
-#include "byterun.h"
#include "utf8.h"
/* Current curly descriptor */
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)
PERLVAR(Gbitcount, char *)
PERLVAR(Gfilter_debug, int)
-/* byterun globals */
-PERLVAR(Goptype_size[], int)
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));
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));
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)
# 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)
perlcc: perlcc.PL ../config.sh
-perlbc: perlbc.PL ../config.sh
-
clean:
realclean:
projects / p5sagit/p5-mst-13.2.git / commitdiff