summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bytecode.pl227
-rw-r--r--embedvar.h4
-rw-r--r--ext/B/B.pm5
-rw-r--r--ext/B/B.xs21
-rw-r--r--ext/B/B/Asmdata.pm228
-rw-r--r--ext/B/B/Assembler.pm119
-rw-r--r--ext/B/B/Bytecode.pm410
-rw-r--r--ext/B/O.pm3
-rw-r--r--ext/B/defsubs_h.PL11
-rw-r--r--ext/ByteLoader/ByteLoader.pm6
-rw-r--r--ext/ByteLoader/ByteLoader.xs103
-rw-r--r--ext/ByteLoader/bytecode.h167
-rw-r--r--ext/ByteLoader/byterun.c453
-rw-r--r--ext/ByteLoader/byterun.h258
-rw-r--r--intrpvar.h1
-rw-r--r--perl.c9
-rw-r--r--perlapi.h2
-rw-r--r--pod/perldelta.pod6
18 files changed, 1200 insertions, 833 deletions
diff --git a/bytecode.pl b/bytecode.pl
index d1e1c708c0..93216048a3 100644
--- a/bytecode.pl
+++ b/bytecode.pl
@@ -13,7 +13,7 @@ my @optype= qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP);
# Nullsv *must* come first in the following so that the condition
# ($$sv == 0) can continue to be used to test (sv == Nullsv).
-my @specialsv = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no);
+my @specialsv = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no pWARN_ALL pWARN_NONE);
my (%alias_from, $from, $tos);
while (($from, $tos) = each %alias_to) {
@@ -82,7 +82,7 @@ print BYTERUN_C $c_header, <<'EOT';
#include "bytecode.h"
-static int optype_size[] = {
+static const int optype_size[] = {
EOT
my $i = 0;
for ($i = 0; $i < @optype - 1; $i++) {
@@ -92,33 +92,28 @@ 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(pTHXo_ void *obj, I32 ix)
+bset_obj_store(pTHXo_ struct byteloader_state *bstate, void *obj, I32 ix)
{
- if (ix > bytecode_obj_list_fill) {
- if (bytecode_obj_list_fill == -1)
- New(666, bytecode_obj_list, ix + 1, void*);
- else
- Renew(bytecode_obj_list, ix + 1, void*);
- bytecode_obj_list_fill = ix;
+ if (ix > bstate->bs_obj_list_fill) {
+ Renew(bstate->bs_obj_list, ix + 32, void*);
+ bstate->bs_obj_list_fill = ix + 31;
}
- bytecode_obj_list[ix] = obj;
+ bstate->bs_obj_list[ix] = obj;
return obj;
}
void
-byterun(pTHXo_ struct bytestream bs)
+byterun(pTHXo_ register struct byteloader_state *bstate)
{
dTHR;
- int insn;
+ register int insn;
+ U32 ix;
+ SV *specialsv_list[6];
+
+ BYTECODE_HEADER_CHECK; /* croak if incorrect platform */
+ New(666, bstate->bs_obj_list, 32, void*); /* set op objlist */
+ bstate->bs_obj_list_fill = 31;
EOT
@@ -198,13 +193,25 @@ EOT
#
open(BYTERUN_H, ">ext/ByteLoader/byterun.h") or die "ext/ByteLoader/byterun.h: $!";
print BYTERUN_H $c_header, <<'EOT';
-struct bytestream {
- void *data;
- int (*pfgetc)(void *);
- int (*pfread)(char *, size_t, size_t, void *);
- void (*pfreadpv)(U32, void *, XPV *);
+struct byteloader_fdata {
+ SV *datasv;
+ int next_out;
+ int idx;
};
+struct byteloader_state {
+ struct byteloader_fdata *bs_fdata;
+ SV *bs_sv;
+ void **bs_obj_list;
+ int bs_obj_list_fill;
+ XPV bs_pv;
+ int bs_iv_overflows;
+};
+
+int bl_getc(struct byteloader_fdata *);
+int bl_read(struct byteloader_fdata *, char *, size_t, size_t);
+extern void byterun(pTHXo_ struct byteloader_state *);
+
enum {
EOT
@@ -233,18 +240,6 @@ for ($i = 0; $i < @optype - 1; $i++) {
}
printf BYTERUN_H " OPt_%s\t\t/* %d */\n};\n\n", $optype[$i], $i;
-print BYTERUN_H <<'EOT';
-extern void byterun(pTHXo_ struct bytestream bs);
-
-#define INIT_SPECIALSV_LIST STMT_START { \
-EOT
-for ($i = 0; $i < @specialsv; $i++) {
- print BYTERUN_H "\tPL_specialsv_list[$i] = $specialsv[$i]; \\\n";
-}
-print BYTERUN_H <<'EOT';
- } STMT_END
-EOT
-
#
# Finish off insn_data and create array initialisers in Asmdata.pm
#
@@ -294,85 +289,86 @@ nop none none
#opcode lvalue argtype flags
#
ret none none x
-ldsv bytecode_sv svindex
+ldsv bstate->bs_sv svindex
ldop PL_op opindex
-stsv bytecode_sv U32 s
+stsv bstate->bs_sv U32 s
stop PL_op U32 s
-ldspecsv bytecode_sv U8 x
-newsv bytecode_sv U8 x
+stpv bstate->bs_pv.xpv_pv U32 x
+ldspecsv bstate->bs_sv U8 x
+newsv bstate->bs_sv U8 x
newop PL_op U8 x
newopn PL_op U8 x
newpv none PV
-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) NV
-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_file CvFILE(bytecode_sv) pvcontents
-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) U16
-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_file GvFILE(bytecode_sv) pvcontents
-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
+pv_cur bstate->bs_pv.xpv_cur STRLEN
+pv_free bstate->bs_pv none x
+sv_upgrade bstate->bs_sv char x
+sv_refcnt SvREFCNT(bstate->bs_sv) U32
+sv_refcnt_add SvREFCNT(bstate->bs_sv) I32 x
+sv_flags SvFLAGS(bstate->bs_sv) U32
+xrv SvRV(bstate->bs_sv) svindex
+xpv bstate->bs_sv none x
+xiv32 SvIVX(bstate->bs_sv) I32
+xiv64 SvIVX(bstate->bs_sv) IV64
+xnv SvNVX(bstate->bs_sv) NV
+xlv_targoff LvTARGOFF(bstate->bs_sv) STRLEN
+xlv_targlen LvTARGLEN(bstate->bs_sv) STRLEN
+xlv_targ LvTARG(bstate->bs_sv) svindex
+xlv_type LvTYPE(bstate->bs_sv) char
+xbm_useful BmUSEFUL(bstate->bs_sv) I32
+xbm_previous BmPREVIOUS(bstate->bs_sv) U16
+xbm_rare BmRARE(bstate->bs_sv) U8
+xfm_lines FmLINES(bstate->bs_sv) I32
+xio_lines IoLINES(bstate->bs_sv) long
+xio_page IoPAGE(bstate->bs_sv) long
+xio_page_len IoPAGE_LEN(bstate->bs_sv) long
+xio_lines_left IoLINES_LEFT(bstate->bs_sv) long
+xio_top_name IoTOP_NAME(bstate->bs_sv) pvcontents
+xio_top_gv *(SV**)&IoTOP_GV(bstate->bs_sv) svindex
+xio_fmt_name IoFMT_NAME(bstate->bs_sv) pvcontents
+xio_fmt_gv *(SV**)&IoFMT_GV(bstate->bs_sv) svindex
+xio_bottom_name IoBOTTOM_NAME(bstate->bs_sv) pvcontents
+xio_bottom_gv *(SV**)&IoBOTTOM_GV(bstate->bs_sv) svindex
+xio_subprocess IoSUBPROCESS(bstate->bs_sv) short
+xio_type IoTYPE(bstate->bs_sv) char
+xio_flags IoFLAGS(bstate->bs_sv) char
+xcv_stash *(SV**)&CvSTASH(bstate->bs_sv) svindex
+xcv_start CvSTART(bstate->bs_sv) opindex
+xcv_root CvROOT(bstate->bs_sv) opindex
+xcv_gv *(SV**)&CvGV(bstate->bs_sv) svindex
+xcv_file CvFILE(bstate->bs_sv) pvindex
+xcv_depth CvDEPTH(bstate->bs_sv) long
+xcv_padlist *(SV**)&CvPADLIST(bstate->bs_sv) svindex
+xcv_outside *(SV**)&CvOUTSIDE(bstate->bs_sv) svindex
+xcv_flags CvFLAGS(bstate->bs_sv) U16
+av_extend bstate->bs_sv SSize_t x
+av_push bstate->bs_sv svindex x
+xav_fill AvFILLp(bstate->bs_sv) SSize_t
+xav_max AvMAX(bstate->bs_sv) SSize_t
+xav_flags AvFLAGS(bstate->bs_sv) U8
+xhv_riter HvRITER(bstate->bs_sv) I32
+xhv_name HvNAME(bstate->bs_sv) pvcontents
+hv_store bstate->bs_sv svindex x
+sv_magic bstate->bs_sv char x
+mg_obj SvMAGIC(bstate->bs_sv)->mg_obj svindex
+mg_private SvMAGIC(bstate->bs_sv)->mg_private U16
+mg_flags SvMAGIC(bstate->bs_sv)->mg_flags U8
+mg_pv SvMAGIC(bstate->bs_sv) pvcontents x
+xmg_stash *(SV**)&SvSTASH(bstate->bs_sv) svindex
+gv_fetchpv bstate->bs_sv strconst x
+gv_stashpv bstate->bs_sv strconst x
+gp_sv GvSV(bstate->bs_sv) svindex
+gp_refcnt GvREFCNT(bstate->bs_sv) U32
+gp_refcnt_add GvREFCNT(bstate->bs_sv) I32 x
+gp_av *(SV**)&GvAV(bstate->bs_sv) svindex
+gp_hv *(SV**)&GvHV(bstate->bs_sv) svindex
+gp_cv *(SV**)&GvCV(bstate->bs_sv) svindex
+gp_file GvFILE(bstate->bs_sv) pvindex
+gp_io *(SV**)&GvIOp(bstate->bs_sv) svindex
+gp_form *(SV**)&GvFORM(bstate->bs_sv) svindex
+gp_cvgen GvCVGEN(bstate->bs_sv) U32
+gp_line GvLINE(bstate->bs_sv) line_t
+gp_share bstate->bs_sv svindex x
+xgv_flags GvFLAGS(bstate->bs_sv) U8
op_next PL_op->op_next opindex
op_sibling PL_op->op_sibling opindex
op_ppaddr PL_op->op_ppaddr strconst x
@@ -399,9 +395,9 @@ op_pv_tr cPVOP->op_pv op_tr_array
op_redoop cLOOP->op_redoop opindex
op_nextop cLOOP->op_nextop opindex
op_lastop cLOOP->op_lastop opindex
-cop_label cCOP->cop_label pvcontents
-cop_stashpv cCOP pvcontents x
-cop_file cCOP pvcontents x
+cop_label cCOP->cop_label pvindex
+cop_stashpv cCOP pvindex x
+cop_file cCOP pvindex x
cop_seq cCOP->cop_seq U32
cop_arybase cCOP->cop_arybase I32
cop_line cCOP line_t x
@@ -409,3 +405,6 @@ cop_warnings cCOP->cop_warnings svindex
main_start PL_main_start opindex
main_root PL_main_root opindex
curpad PL_curpad svindex x
+push_begin PL_beginav svindex x
+push_init PL_initav svindex x
+push_end PL_endav svindex x
diff --git a/embedvar.h b/embedvar.h
index 10339b27e1..f6488c6977 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -196,6 +196,7 @@
#define PL_argvoutgv (PERL_GET_INTERP->Iargvoutgv)
#define PL_basetime (PERL_GET_INTERP->Ibasetime)
#define PL_beginav (PERL_GET_INTERP->Ibeginav)
+#define PL_beginav_save (PERL_GET_INTERP->Ibeginav_save)
#define PL_bitcount (PERL_GET_INTERP->Ibitcount)
#define PL_bufend (PERL_GET_INTERP->Ibufend)
#define PL_bufptr (PERL_GET_INTERP->Ibufptr)
@@ -475,6 +476,7 @@
#define PL_argvoutgv (vTHX->Iargvoutgv)
#define PL_basetime (vTHX->Ibasetime)
#define PL_beginav (vTHX->Ibeginav)
+#define PL_beginav_save (vTHX->Ibeginav_save)
#define PL_bitcount (vTHX->Ibitcount)
#define PL_bufend (vTHX->Ibufend)
#define PL_bufptr (vTHX->Ibufptr)
@@ -891,6 +893,7 @@
#define PL_argvoutgv (aTHXo->interp.Iargvoutgv)
#define PL_basetime (aTHXo->interp.Ibasetime)
#define PL_beginav (aTHXo->interp.Ibeginav)
+#define PL_beginav_save (aTHXo->interp.Ibeginav_save)
#define PL_bitcount (aTHXo->interp.Ibitcount)
#define PL_bufend (aTHXo->interp.Ibufend)
#define PL_bufptr (aTHXo->interp.Ibufptr)
@@ -1171,6 +1174,7 @@
#define PL_Iargvoutgv PL_argvoutgv
#define PL_Ibasetime PL_basetime
#define PL_Ibeginav PL_beginav
+#define PL_Ibeginav_save PL_beginav_save
#define PL_Ibitcount PL_bitcount
#define PL_Ibufend PL_bufend
#define PL_Ibufptr PL_bufptr
diff --git a/ext/B/B.pm b/ext/B/B.pm
index 4512d916e6..50364fa1d2 100644
--- a/ext/B/B.pm
+++ b/ext/B/B.pm
@@ -9,11 +9,12 @@ package B;
use XSLoader ();
require Exporter;
@ISA = qw(Exporter);
-@EXPORT_OK = qw(minus_c ppname
+@EXPORT_OK = qw(minus_c ppname save_BEGINs
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
- parents comppadlist sv_undef compile_stats timing_info init_av);
+ parents comppadlist sv_undef compile_stats timing_info
+ begin_av init_av end_av);
sub OPf_KIDS ();
use strict;
@B::SV::ISA = 'B::OBJECT';
diff --git a/ext/B/B.xs b/ext/B/B.xs
index 7704ccdd2f..9fbe4a390e 100644
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -81,7 +81,7 @@ static char *opclassnames[] = {
static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */
-static SV *specialsv_list[4];
+static SV *specialsv_list[6];
static opclass
cc_opclass(pTHX_ OP *o)
@@ -386,11 +386,15 @@ BOOT:
specialsv_list[1] = &PL_sv_undef;
specialsv_list[2] = &PL_sv_yes;
specialsv_list[3] = &PL_sv_no;
+ specialsv_list[4] = pWARN_ALL;
+ specialsv_list[5] = pWARN_NONE;
#include "defsubs.h"
}
#define B_main_cv() PL_main_cv
#define B_init_av() PL_initav
+#define B_begin_av() PL_beginav_save
+#define B_end_av() PL_endav
#define B_main_root() PL_main_root
#define B_main_start() PL_main_start
#define B_amagic_generation() PL_amagic_generation
@@ -402,6 +406,12 @@ BOOT:
B::AV
B_init_av()
+B::AV
+B_begin_av()
+
+B::AV
+B_end_av()
+
B::CV
B_main_cv()
@@ -515,6 +525,11 @@ minus_c()
CODE:
PL_minus_c = TRUE;
+void
+save_BEGINs()
+ CODE:
+ PL_minus_c |= 0x10;
+
SV *
cstring(sv)
SV * sv
@@ -693,8 +708,8 @@ PMOP_precomp(o)
if (rx)
sv_setpvn(ST(0), rx->precomp, rx->prelen);
-#define SVOP_sv(o) cSVOPo->op_sv
-#define SVOP_gv(o) ((GV*)cSVOPo->op_sv)
+#define SVOP_sv(o) cSVOPo_sv
+#define SVOP_gv(o) cGVOPo_gv
MODULE = B PACKAGE = B::SVOP PREFIX = SVOP_
diff --git a/ext/B/B/Asmdata.pm b/ext/B/B/Asmdata.pm
index bc0eda935b..b412927ab4 100644
--- a/ext/B/B/Asmdata.pm
+++ b/ext/B/B/Asmdata.pm
@@ -15,7 +15,7 @@ use Exporter;
our(%insn_data, @insn_name, @optype, @specialsv_name);
@optype = qw(OP UNOP BINOP LOGOP LISTOP PMOP SVOP PADOP PVOP LOOP COP);
-@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no);
+@specialsv_name = qw(Nullsv &PL_sv_undef &PL_sv_yes &PL_sv_no pWARN_ALL pWARN_NONE);
# XXX insn_data is initialised this way because with a large
# %insn_data = (foo => [...], bar => [...], ...) initialiser
@@ -27,117 +27,121 @@ $insn_data{ldsv} = [1, \&PUT_svindex, "GET_svindex"];
$insn_data{ldop} = [2, \&PUT_opindex, "GET_opindex"];
$insn_data{stsv} = [3, \&PUT_U32, "GET_U32"];
$insn_data{stop} = [4, \&PUT_U32, "GET_U32"];
-$insn_data{ldspecsv} = [5, \&PUT_U8, "GET_U8"];
-$insn_data{newsv} = [6, \&PUT_U8, "GET_U8"];
-$insn_data{newop} = [7, \&PUT_U8, "GET_U8"];
-$insn_data{newopn} = [8, \&PUT_U8, "GET_U8"];
-$insn_data{newpv} = [9, \&PUT_PV, "GET_PV"];
-$insn_data{pv_cur} = [11, \&PUT_U32, "GET_U32"];
-$insn_data{pv_free} = [12, \&PUT_none, "GET_none"];
-$insn_data{sv_upgrade} = [13, \&PUT_U8, "GET_U8"];
-$insn_data{sv_refcnt} = [14, \&PUT_U32, "GET_U32"];
-$insn_data{sv_refcnt_add} = [15, \&PUT_I32, "GET_I32"];
-$insn_data{sv_flags} = [16, \&PUT_U32, "GET_U32"];
-$insn_data{xrv} = [17, \&PUT_svindex, "GET_svindex"];
-$insn_data{xpv} = [18, \&PUT_none, "GET_none"];
-$insn_data{xiv32} = [19, \&PUT_I32, "GET_I32"];
-$insn_data{xiv64} = [20, \&PUT_IV64, "GET_IV64"];
-$insn_data{xnv} = [21, \&PUT_NV, "GET_NV"];
-$insn_data{xlv_targoff} = [22, \&PUT_U32, "GET_U32"];
-$insn_data{xlv_targlen} = [23, \&PUT_U32, "GET_U32"];
-$insn_data{xlv_targ} = [24, \&PUT_svindex, "GET_svindex"];
-$insn_data{xlv_type} = [25, \&PUT_U8, "GET_U8"];
-$insn_data{xbm_useful} = [26, \&PUT_I32, "GET_I32"];
-$insn_data{xbm_previous} = [27, \&PUT_U16, "GET_U16"];
-$insn_data{xbm_rare} = [28, \&PUT_U8, "GET_U8"];
-$insn_data{xfm_lines} = [29, \&PUT_I32, "GET_I32"];
-$insn_data{xio_lines} = [30, \&PUT_I32, "GET_I32"];
-$insn_data{xio_page} = [31, \&PUT_I32, "GET_I32"];
-$insn_data{xio_page_len} = [32, \&PUT_I32, "GET_I32"];
-$insn_data{xio_lines_left} = [33, \&PUT_I32, "GET_I32"];
-$insn_data{xio_top_name} = [34, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{xio_top_gv} = [36, \&PUT_svindex, "GET_svindex"];
-$insn_data{xio_fmt_name} = [37, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{xio_fmt_gv} = [38, \&PUT_svindex, "GET_svindex"];
-$insn_data{xio_bottom_name} = [39, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{xio_bottom_gv} = [40, \&PUT_svindex, "GET_svindex"];
-$insn_data{xio_subprocess} = [41, \&PUT_U16, "GET_U16"];
-$insn_data{xio_type} = [42, \&PUT_U8, "GET_U8"];
-$insn_data{xio_flags} = [43, \&PUT_U8, "GET_U8"];
-$insn_data{xcv_stash} = [44, \&PUT_svindex, "GET_svindex"];
-$insn_data{xcv_start} = [45, \&PUT_opindex, "GET_opindex"];
-$insn_data{xcv_root} = [46, \&PUT_opindex, "GET_opindex"];
-$insn_data{xcv_gv} = [47, \&PUT_svindex, "GET_svindex"];
-$insn_data{xcv_file} = [48, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{xcv_depth} = [49, \&PUT_I32, "GET_I32"];
-$insn_data{xcv_padlist} = [50, \&PUT_svindex, "GET_svindex"];
-$insn_data{xcv_outside} = [51, \&PUT_svindex, "GET_svindex"];
-$insn_data{xcv_flags} = [52, \&PUT_U16, "GET_U16"];
-$insn_data{av_extend} = [53, \&PUT_I32, "GET_I32"];
-$insn_data{av_push} = [54, \&PUT_svindex, "GET_svindex"];
-$insn_data{xav_fill} = [55, \&PUT_I32, "GET_I32"];
-$insn_data{xav_max} = [56, \&PUT_I32, "GET_I32"];
-$insn_data{xav_flags} = [57, \&PUT_U8, "GET_U8"];
-$insn_data{xhv_riter} = [58, \&PUT_I32, "GET_I32"];
-$insn_data{xhv_name} = [59, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{hv_store} = [60, \&PUT_svindex, "GET_svindex"];
-$insn_data{sv_magic} = [61, \&PUT_U8, "GET_U8"];
-$insn_data{mg_obj} = [62, \&PUT_svindex, "GET_svindex"];
-$insn_data{mg_private} = [63, \&PUT_U16, "GET_U16"];
-$insn_data{mg_flags} = [64, \&PUT_U8, "GET_U8"];
-$insn_data{mg_pv} = [65, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{xmg_stash} = [66, \&PUT_svindex, "GET_svindex"];
-$insn_data{gv_fetchpv} = [67, \&PUT_strconst, "GET_strconst"];
-$insn_data{gv_stashpv} = [68, \&PUT_strconst, "GET_strconst"];
-$insn_data{gp_sv} = [69, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_refcnt} = [70, \&PUT_U32, "GET_U32"];
-$insn_data{gp_refcnt_add} = [71, \&PUT_I32, "GET_I32"];
-$insn_data{gp_av} = [72, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_hv} = [73, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_cv} = [74, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_file} = [75, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{gp_io} = [76, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_form} = [77, \&PUT_svindex, "GET_svindex"];
-$insn_data{gp_cvgen} = [78, \&PUT_U32, "GET_U32"];
-$insn_data{gp_line} = [79, \&PUT_U16, "GET_U16"];
-$insn_data{gp_share} = [80, \&PUT_svindex, "GET_svindex"];
-$insn_data{xgv_flags} = [81, \&PUT_U8, "GET_U8"];
-$insn_data{op_next} = [82, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_sibling} = [83, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_ppaddr} = [84, \&PUT_strconst, "GET_strconst"];
-$insn_data{op_targ} = [85, \&PUT_U32, "GET_U32"];
-$insn_data{op_type} = [86, \&PUT_U16, "GET_U16"];
-$insn_data{op_seq} = [87, \&PUT_U16, "GET_U16"];
-$insn_data{op_flags} = [88, \&PUT_U8, "GET_U8"];
-$insn_data{op_private} = [89, \&PUT_U8, "GET_U8"];
-$insn_data{op_first} = [90, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_last} = [91, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_other} = [92, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_children} = [93, \&PUT_U32, "GET_U32"];
-$insn_data{op_pmreplroot} = [94, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_pmreplrootgv} = [95, \&PUT_svindex, "GET_svindex"];
-$insn_data{op_pmreplstart} = [96, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_pmnext} = [97, \&PUT_opindex, "GET_opindex"];
-$insn_data{pregcomp} = [98, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{op_pmflags} = [99, \&PUT_U16, "GET_U16"];
-$insn_data{op_pmpermflags} = [100, \&PUT_U16, "GET_U16"];
-$insn_data{op_sv} = [101, \&PUT_svindex, "GET_svindex"];
-$insn_data{op_padix} = [102, \&PUT_U32, "GET_U32"];
-$insn_data{op_pv} = [103, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{op_pv_tr} = [104, \&PUT_op_tr_array, "GET_op_tr_array"];
-$insn_data{op_redoop} = [105, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_nextop} = [106, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_lastop} = [107, \&PUT_opindex, "GET_opindex"];
-$insn_data{cop_label} = [108, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{cop_stashpv} = [109, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{cop_file} = [110, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{cop_seq} = [111, \&PUT_U32, "GET_U32"];
-$insn_data{cop_arybase} = [112, \&PUT_I32, "GET_I32"];
-$insn_data{cop_line} = [113, \&PUT_U16, "GET_U16"];
-$insn_data{cop_warnings} = [114, \&PUT_svindex, "GET_svindex"];
-$insn_data{main_start} = [115, \&PUT_opindex, "GET_opindex"];
-$insn_data{main_root} = [116, \&PUT_opindex, "GET_opindex"];
-$insn_data{curpad} = [117, \&PUT_svindex, "GET_svindex"];
+$insn_data{stpv} = [5, \&PUT_U32, "GET_U32"];
+$insn_data{ldspecsv} = [6, \&PUT_U8, "GET_U8"];
+$insn_data{newsv} = [7, \&PUT_U8, "GET_U8"];
+$insn_data{newop} = [8, \&PUT_U8, "GET_U8"];
+$insn_data{newopn} = [9, \&PUT_U8, "GET_U8"];
+$insn_data{newpv} = [11, \&PUT_PV, "GET_PV"];
+$insn_data{pv_cur} = [12, \&PUT_U32, "GET_U32"];
+$insn_data{pv_free} = [13, \&PUT_none, "GET_none"];
+$insn_data{sv_upgrade} = [14, \&PUT_U8, "GET_U8"];
+$insn_data{sv_refcnt} = [15, \&PUT_U32, "GET_U32"];
+$insn_data{sv_refcnt_add} = [16, \&PUT_I32, "GET_I32"];
+$insn_data{sv_flags} = [17, \&PUT_U32, "GET_U32"];
+$insn_data{xrv} = [18, \&PUT_svindex, "GET_svindex"];
+$insn_data{xpv} = [19, \&PUT_none, "GET_none"];
+$insn_data{xiv32} = [20, \&PUT_I32, "GET_I32"];
+$insn_data{xiv64} = [21, \&PUT_IV64, "GET_IV64"];
+$insn_data{xnv} = [22, \&PUT_NV, "GET_NV"];
+$insn_data{xlv_targoff} = [23, \&PUT_U32, "GET_U32"];
+$insn_data{xlv_targlen} = [24, \&PUT_U32, "GET_U32"];
+$insn_data{xlv_targ} = [25, \&PUT_svindex, "GET_svindex"];
+$insn_data{xlv_type} = [26, \&PUT_U8, "GET_U8"];
+$insn_data{xbm_useful} = [27, \&PUT_I32, "GET_I32"];
+$insn_data{xbm_previous} = [28, \&PUT_U16, "GET_U16"];
+$insn_data{xbm_rare} = [29, \&PUT_U8, "GET_U8"];
+$insn_data{xfm_lines} = [30, \&PUT_I32, "GET_I32"];
+$insn_data{xio_lines} = [31, \&PUT_I32, "GET_I32"];
+$insn_data{xio_page} = [32, \&PUT_I32, "GET_I32"];
+$insn_data{xio_page_len} = [33, \&PUT_I32, "GET_I32"];
+$insn_data{xio_lines_left} = [34, \&PUT_I32, "GET_I32"];
+$insn_data{xio_top_name} = [36, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_top_gv} = [37, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_fmt_name} = [38, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_fmt_gv} = [39, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_bottom_name} = [40, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xio_bottom_gv} = [41, \&PUT_svindex, "GET_svindex"];
+$insn_data{xio_subprocess} = [42, \&PUT_U16, "GET_U16"];
+$insn_data{xio_type} = [43, \&PUT_U8, "GET_U8"];
+$insn_data{xio_flags} = [44, \&PUT_U8, "GET_U8"];
+$insn_data{xcv_stash} = [45, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_start} = [46, \&PUT_opindex, "GET_opindex"];
+$insn_data{xcv_root} = [47, \&PUT_opindex, "GET_opindex"];
+$insn_data{xcv_gv} = [48, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_file} = [49, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{xcv_depth} = [50, \&PUT_I32, "GET_I32"];
+$insn_data{xcv_padlist} = [51, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_outside} = [52, \&PUT_svindex, "GET_svindex"];
+$insn_data{xcv_flags} = [53, \&PUT_U16, "GET_U16"];
+$insn_data{av_extend} = [54, \&PUT_I32, "GET_I32"];
+$insn_data{av_push} = [55, \&PUT_svindex, "GET_svindex"];
+$insn_data{xav_fill} = [56, \&PUT_I32, "GET_I32"];
+$insn_data{xav_max} = [57, \&PUT_I32, "GET_I32"];
+$insn_data{xav_flags} = [58, \&PUT_U8, "GET_U8"];
+$insn_data{xhv_riter} = [59, \&PUT_I32, "GET_I32"];
+$insn_data{xhv_name} = [60, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{hv_store} = [61, \&PUT_svindex, "GET_svindex"];
+$insn_data{sv_magic} = [62, \&PUT_U8, "GET_U8"];
+$insn_data{mg_obj} = [63, \&PUT_svindex, "GET_svindex"];
+$insn_data{mg_private} = [64, \&PUT_U16, "GET_U16"];
+$insn_data{mg_flags} = [65, \&PUT_U8, "GET_U8"];
+$insn_data{mg_pv} = [66, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{xmg_stash} = [67, \&PUT_svindex, "GET_svindex"];
+$insn_data{gv_fetchpv} = [68, \&PUT_strconst, "GET_strconst"];
+$insn_data{gv_stashpv} = [69, \&PUT_strconst, "GET_strconst"];
+$insn_data{gp_sv} = [70, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_refcnt} = [71, \&PUT_U32, "GET_U32"];
+$insn_data{gp_refcnt_add} = [72, \&PUT_I32, "GET_I32"];
+$insn_data{gp_av} = [73, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_hv} = [74, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_cv} = [75, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_file} = [76, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{gp_io} = [77, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_form} = [78, \&PUT_svindex, "GET_svindex"];
+$insn_data{gp_cvgen} = [79, \&PUT_U32, "GET_U32"];
+$insn_data{gp_line} = [80, \&PUT_U16, "GET_U16"];
+$insn_data{gp_share} = [81, \&PUT_svindex, "GET_svindex"];
+$insn_data{xgv_flags} = [82, \&PUT_U8, "GET_U8"];
+$insn_data{op_next} = [83, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_sibling} = [84, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_ppaddr} = [85, \&PUT_strconst, "GET_strconst"];
+$insn_data{op_targ} = [86, \&PUT_U32, "GET_U32"];
+$insn_data{op_type} = [87, \&PUT_U16, "GET_U16"];
+$insn_data{op_seq} = [88, \&PUT_U16, "GET_U16"];
+$insn_data{op_flags} = [89, \&PUT_U8, "GET_U8"];
+$insn_data{op_private} = [90, \&PUT_U8, "GET_U8"];
+$insn_data{op_first} = [91, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_last} = [92, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_other} = [93, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_children} = [94, \&PUT_U32, "GET_U32"];
+$insn_data{op_pmreplroot} = [95, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmreplrootgv} = [96, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_pmreplstart} = [97, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmnext} = [98, \&PUT_opindex, "GET_opindex"];
+$insn_data{pregcomp} = [99, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pmflags} = [100, \&PUT_U16, "GET_U16"];
+$insn_data{op_pmpermflags} = [101, \&PUT_U16, "GET_U16"];
+$insn_data{op_sv} = [102, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_padix} = [103, \&PUT_U32, "GET_U32"];
+$insn_data{op_pv} = [104, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pv_tr} = [105, \&PUT_op_tr_array, "GET_op_tr_array"];
+$insn_data{op_redoop} = [106, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_nextop} = [107, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_lastop} = [108, \&PUT_opindex, "GET_opindex"];
+$insn_data{cop_label} = [109, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_stashpv} = [110, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_file} = [111, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_seq} = [112, \&PUT_U32, "GET_U32"];
+$insn_data{cop_arybase} = [113, \&PUT_I32, "GET_I32"];
+$insn_data{cop_line} = [114, \&PUT_U16, "GET_U16"];
+$insn_data{cop_warnings} = [115, \&PUT_svindex, "GET_svindex"];
+$insn_data{main_start} = [116, \&PUT_opindex, "GET_opindex"];
+$insn_data{main_root} = [117, \&PUT_opindex, "GET_opindex"];
+$insn_data{curpad} = [118, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_begin} = [119, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_init} = [120, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_end} = [121, \&PUT_svindex, "GET_svindex"];
my ($insn_name, $insn_data);
while (($insn_name, $insn_data) = each %insn_data) {
diff --git a/ext/B/B/Assembler.pm b/ext/B/B/Assembler.pm
index 6c51a9ad3e..5e798ce485 100644
--- a/ext/B/B/Assembler.pm
+++ b/ext/B/B/Assembler.pm
@@ -4,14 +4,17 @@
#
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the README file.
+
package B::Assembler;
use Exporter;
use B qw(ppname);
use B::Asmdata qw(%insn_data @insn_name);
+use Config qw(%Config);
+require ByteLoader; # we just need its $VERSIOM
@ISA = qw(Exporter);
-@EXPORT_OK = qw(assemble_fh assemble_insn strip_comments
- parse_statement uncstring);
+@EXPORT_OK = qw(assemble_fh newasm endasm assemble);
+$VERSION = 0.02;
use strict;
my %opnumber;
@@ -20,7 +23,7 @@ for ($i = 0; defined($opname = ppname($i)); $i++) {
$opnumber{$opname} = $i;
}
-my ($linenum, $errors);
+my($linenum, $errors, $out); # global state, set up by newasm
sub error {
my $str = shift;
@@ -49,13 +52,15 @@ sub B::Asmdata::PUT_U8 {
return $c;
}
-sub B::Asmdata::PUT_U16 { pack("n", $_[0]) }
-sub B::Asmdata::PUT_U32 { pack("N", $_[0]) }
-sub B::Asmdata::PUT_I32 { pack("N", $_[0]) }
-sub B::Asmdata::PUT_NV { sprintf("%lf\0", $_[0]) }
-sub B::Asmdata::PUT_objindex { pack("N", $_[0]) } # could allow names here
+sub B::Asmdata::PUT_U16 { pack("S", $_[0]) }
+sub B::Asmdata::PUT_U32 { pack("L", $_[0]) }
+sub B::Asmdata::PUT_I32 { pack("L", $_[0]) }
+sub B::Asmdata::PUT_NV { sprintf("%s\0", $_[0]) } # "%lf" looses precision and pack('d',...)
+ # may not even be portable between compilers
+sub B::Asmdata::PUT_objindex { pack("L", $_[0]) } # could allow names here
sub B::Asmdata::PUT_svindex { &B::Asmdata::PUT_objindex }
sub B::Asmdata::PUT_opindex { &B::Asmdata::PUT_objindex }
+sub B::Asmdata::PUT_pvindex { &B::Asmdata::PUT_objindex }
sub B::Asmdata::PUT_strconst {
my $arg = shift;
@@ -79,7 +84,7 @@ sub B::Asmdata::PUT_PV {
my $arg = shift;
$arg = uncstring($arg);
error "bad string argument: $arg" unless defined($arg);
- return pack("N", length($arg)) . $arg;
+ return pack("L", length($arg)) . $arg;
}
sub B::Asmdata::PUT_comment_t {
my $arg = shift;
@@ -90,7 +95,7 @@ sub B::Asmdata::PUT_comment_t {
}
return $arg . "\n";
}
-sub B::Asmdata::PUT_double { sprintf("%s\0", $_[0]) }
+sub B::Asmdata::PUT_double { sprintf("%s\0", $_[0]) } # see PUT_NV above
sub B::Asmdata::PUT_none {
my $arg = shift;
error "extraneous argument: $arg" if defined $arg;
@@ -103,12 +108,12 @@ sub B::Asmdata::PUT_op_tr_array {
error "wrong number of arguments to op_tr_array";
@ary = (0) x 256;
}
- return pack("n256", @ary);
+ return pack("S256", @ary);
}
# XXX Check this works
sub B::Asmdata::PUT_IV64 {
my $arg = shift;
- return pack("NN", $arg >> 32, $arg & 0xffffffff);
+ return pack("LL", $arg >> 32, $arg & 0xffffffff);
}
my %unesc = (n => "\n", r => "\r", t => "\t", a => "\a",
@@ -138,6 +143,24 @@ sub strip_comments {
return $stmt;
}
+# create the ByteCode header: magic, archname, ByteLoader $VERSION, ivsize,
+# ptrsize, byteorder
+# nvtype is irrelevant (floats are stored as strings)
+# byteorder is strconst not U32 because of varying size issues
+
+sub gen_header {
+ my $header = "";
+
+ $header .= B::Asmdata::PUT_U32(0x43424c50); # 'PLBC'
+ $header .= B::Asmdata::PUT_strconst('"' . $Config{archname}. '"');
+ $header .= B::Asmdata::PUT_strconst(qq["$ByteLoader::VERSION"]);
+ $header .= B::Asmdata::PUT_U32($Config{ivsize});
+ $header .= B::Asmdata::PUT_U32($Config{ptrsize});
+ $header .= B::Asmdata::PUT_strconst(sprintf(qq["0x%s"], $Config{byteorder}));
+
+ $header;
+}
+
sub parse_statement {
my $stmt = shift;
my ($insn, $arg) = $stmt =~ m{
@@ -183,27 +206,52 @@ sub assemble_insn {
sub assemble_fh {
my ($fh, $out) = @_;
- my ($line, $insn, $arg);
- $linenum = 0;
- $errors = 0;
+ my $line;
+ my $asm = newasm($out);
while ($line = <$fh>) {
- $linenum++;
- chomp $line;
- if ($debug) {
- my $quotedline = $line;
- $quotedline =~ s/\\/\\\\/g;
- $quotedline =~ s/"/\\"/g;
- &$out(assemble_insn("comment", qq("$quotedline")));
- }
- $line = strip_comments($line) or next;
- ($insn, $arg) = parse_statement($line);
- &$out(assemble_insn($insn, $arg));
- if ($debug) {
- &$out(assemble_insn("nop", undef));
- }
+ assemble($line);
}
+ endasm();
+}
+
+sub newasm {
+ my($outsub) = @_;
+
+ die "Invalid printing routine for B::Assembler\n" unless ref $outsub eq 'CODE';
+ die <<EOD if ref $out;
+Can't have multiple byteassembly sessions at once!
+ (perhaps you forgot an endasm()?)
+EOD
+
+ $linenum = $errors = 0;
+ $out = $outsub;
+
+ $out->(gen_header());
+}
+
+sub endasm {
if ($errors) {
- die "Assembly failed with $errors error(s)\n";
+ die "There were $errors assembly errors\n";
+ }
+ $linenum = $errors = $out = 0;
+}
+
+sub assemble {
+ my($line) = @_;
+ my ($insn, $arg);
+ $linenum++;
+ chomp $line;
+ if ($debug) {
+ my $quotedline = $line;
+ $quotedline =~ s/\\/\\\\/g;
+ $quotedline =~ s/"/\\"/g;
+ $out->(assemble_insn("comment", qq("$quotedline")));
+ }
+ $line = strip_comments($line) or next;
+ ($insn, $arg) = parse_statement($line);
+ $out->(assemble_insn($insn, $arg));
+ if ($debug) {
+ $out->(assemble_insn("nop", undef));
}
}
@@ -217,14 +265,21 @@ B::Assembler - Assemble Perl bytecode
=head1 SYNOPSIS
- use Assembler;
+ use B::Assembler qw(newasm endasm assemble);
+ newasm(\&printsub); # sets up for assembly
+ assemble($buf); # assembles one line
+ endasm(); # closes down
+
+ use B::Assembler qw(assemble_fh);
+ assemble_fh($fh, \&printsub); # assemble everything in $fh
=head1 DESCRIPTION
See F<ext/B/B/Assembler.pm>.
-=head1 AUTHOR
+=head1 AUTHORS
Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+Per-statement interface by Benjamin Stuhl, C<sho_pi@hotmail.com>
=cut
diff --git a/ext/B/B/Bytecode.pm b/ext/B/B/Bytecode.pm
index 941a818f6b..ef59c4af42 100644
--- a/ext/B/B/Bytecode.pm
+++ b/ext/B/B/Bytecode.pm
@@ -6,16 +6,18 @@
# License or the Artistic License, as specified in the README file.
#
package B::Bytecode;
+
use strict;
use Carp;
-use IO::File;
-
-use B qw(minus_c main_cv main_root main_start comppadlist
+use B qw(main_cv main_root main_start comppadlist
class peekop walkoptree svref_2object cstring walksymtable
- SVf_POK SVp_POK SVf_IOK SVp_IOK
+ init_av begin_av end_av
+ SVf_POK SVp_POK SVf_IOK SVp_IOK SVf_NOK SVp_NOK
+ SVf_READONLY GVf_IMPORTED_AV GVf_IMPORTED_CV GVf_IMPORTED_HV
+ GVf_IMPORTED_SV SVTYPEMASK
);
use B::Asmdata qw(@optype @specialsv_name);
-use B::Assembler qw(assemble_fh);
+use B::Assembler qw(newasm endasm assemble);
my %optype_enum;
my $i;
@@ -31,41 +33,76 @@ sub POK () { SVf_POK|SVp_POK }
# XXX Shouldn't be hardwired
sub IOK () { SVf_IOK|SVp_IOK }
-my ($verbose, $module_only, $no_assemble, $debug_bc, $debug_cv);
-my $assembler_pid;
+# Following is SVf_NOK|SVp_NOK
+# XXX Shouldn't be hardwired
+sub NOK () { SVf_NOK|SVp_NOK }
+
+# nonexistant flags (see B::GV::bytecode for usage)
+sub GVf_IMPORTED_IO () { 0; }
+sub GVf_IMPORTED_FORM () { 0; }
+
+my ($verbose, $no_assemble, $debug_bc, $debug_cv);
+my @packages; # list of packages to compile
+
+sub asm (@) { # print replacement that knows about assembling
+ if ($no_assemble) {
+ print @_;
+ } else {
+ my $buf = join '', @_;
+ assemble($_) for (split /\n/, $buf);
+ }
+}
+
+sub asmf (@) { # printf replacement that knows about assembling
+ if ($no_assemble) {
+ printf shift(), @_;
+ } else {
+ my $format = shift;
+ my $buf = sprintf $format, @_;
+ assemble($_) for (split /\n/, $buf);
+ }
+}
# Optimisation options. On the command line, use hyphens instead of
# underscores for compatibility with gcc-style options. We use
# underscores here because they are OK in (strict) barewords.
-my ($strip_syntree, $compress_nullops, $omit_seq, $bypass_nullops);
-my %optimise = (strip_syntax_tree => \$strip_syntree,
- compress_nullops => \$compress_nullops,
+my ($compress_nullops, $omit_seq, $bypass_nullops);
+my %optimise = (compress_nullops => \$compress_nullops,
omit_sequence_numbers => \$omit_seq,
bypass_nullops => \$bypass_nullops);
+my $strip_syntree; # this is left here in case stripping the
+ # syntree ever becomes safe again
+ # -- BKS, June 2000
+
my $nextix = 0;
my %symtable; # maps object addresses to object indices.
# Filled in at allocation (newsv/newop) time.
+
my %saved; # maps object addresses (for SVish classes) to "saved yet?"
# flag. Set at FOO::bytecode time usually by SV::bytecode.
# Manipulated via saved(), mark_saved(), unmark_saved().
+my %strtable; # maps shared strings to object indices
+ # Filled in at allocation (pvix) time
+
my $svix = -1; # we keep track of when the sv register contains an element
# of the object table to avoid unnecessary repeated
# consecutive ldsv instructions.
+
my $opix = -1; # Ditto for the op register.
sub ldsv {
my $ix = shift;
if ($ix != $svix) {
- print "ldsv $ix\n";
+ asm "ldsv $ix\n";
$svix = $ix;
}
}
sub stsv {
my $ix = shift;
- print "stsv $ix\n";
+ asm "stsv $ix\n";
$svix = $ix;
}
@@ -76,14 +113,14 @@ sub set_svix {
sub ldop {
my $ix = shift;
if ($ix != $opix) {
- print "ldop $ix\n";
+ asm "ldop $ix\n";
$opix = $ix;
}
}
sub stop {
my $ix = shift;
- print "stop $ix\n";
+ asm "stop $ix\n";
$opix = $ix;
}
@@ -100,12 +137,29 @@ sub pvstring {
}
}
+sub nv {
+ # print full precision
+ my $str = sprintf "%.40f", $_[0];
+ $str =~ s/0+$//; # remove trailing zeros
+ $str =~ s/\.$/.0/;
+ return $str;
+}
+
sub saved { $saved{${$_[0]}} }
sub mark_saved { $saved{${$_[0]}} = 1 }
sub unmark_saved { $saved{${$_[0]}} = 0 }
sub debug { $debug_bc = shift }
+sub pvix { # save a shared PV (mainly for COPs)
+ return $strtable{$_[0]} if defined($strtable{$_[0]});
+ asmf "newpv %s\n", pvstring($_[0]);
+ my $ix = $nextix++;
+ $strtable{$_[0]} = $ix;
+ asmf "stpv %d\n", $ix;
+ return $ix;
+}
+
sub B::OBJECT::nyi {
my $obj = shift;
warn sprintf("bytecode save method for %s (0x%x) not yet implemented\n",
@@ -129,7 +183,7 @@ sub B::OBJECT::objix {
sub B::SV::newix {
my ($sv, $ix) = @_;
- printf "newsv %d\t# %s\n", $sv->FLAGS & 0xf, class($sv);
+ asmf "newsv %d\t# %s\n", $sv->FLAGS & SVTYPEMASK, class($sv);
stsv($ix);
}
@@ -137,7 +191,7 @@ sub B::GV::newix {
my ($gv, $ix) = @_;
my $gvname = $gv->NAME;
my $name = cstring($gv->STASH->NAME . "::" . $gvname);
- print "gv_fetchpv $name\n";
+ asm "gv_fetchpv $name\n";
stsv($ix);
}
@@ -146,7 +200,7 @@ sub B::HV::newix {
my $name = $hv->NAME;
if ($name) {
# It's a stash
- printf "gv_stashpv %s\n", cstring($name);
+ asmf "gv_stashpv %s\n", cstring($name);
stsv($ix);
} else {
# It's an ordinary HV. Fall back to ordinary newix method
@@ -158,7 +212,7 @@ sub B::SPECIAL::newix {
my ($sv, $ix) = @_;
# Special case. $$sv is not the address of the SV but an
# index into svspecialsv_list.
- printf "ldspecsv $$sv\t# %s\n", $specialsv_name[$$sv];
+ asmf "ldspecsv $$sv\t# %s\n", $specialsv_name[$$sv];
stsv($ix);
}
@@ -166,8 +220,8 @@ sub B::OP::newix {
my ($op, $ix) = @_;
my $class = class($op);
my $typenum = $optype_enum{$class};
- croak "OP::newix: can't understand class $class" unless defined($typenum);
- print "newop $typenum\t# $class\n";
+ croak("OP::newix: can't understand class $class") unless defined($typenum);
+ asm "newop $typenum\t# $class\n";
stop($ix);
}
@@ -180,7 +234,7 @@ sub B::OP::bytecode {
my $op = shift;
my $next = $op->next;
my $nextix;
- my $sibix = $op->sibling->objix;
+ my $sibix = $op->sibling->objix unless $strip_syntree;
my $ix = $op->objix;
my $type = $op->type;
@@ -189,24 +243,24 @@ sub B::OP::bytecode {
}
$nextix = $next->objix;
- printf "# %s\n", peekop($op) if $debug_bc;
+ asmf "# %s\n", peekop($op) if $debug_bc;
ldop($ix);
- print "op_next $nextix\n";
- print "op_sibling $sibix\n" unless $strip_syntree;
- printf "op_type %s\t# %d\n", "pp_" . $op->name, $type;
- printf("op_seq %d\n", $op->seq) unless $omit_seq;
+ asm "op_next $nextix\n";
+ asm "op_sibling $sibix\n" unless $strip_syntree;
+ asmf "op_type %s\t# %d\n", "pp_" . $op->name, $type;
+ asmf("op_seq %d\n", $op->seq) unless $omit_seq;
if ($type || !$compress_nullops) {
- printf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n",
+ asmf "op_targ %d\nop_flags 0x%x\nop_private 0x%x\n",
$op->targ, $op->flags, $op->private;
}
}
sub B::UNOP::bytecode {
my $op = shift;
- my $firstix = $op->first->objix;
+ my $firstix = $op->first->objix unless $strip_syntree;
$op->B::OP::bytecode;
if (($op->type || !$compress_nullops) && !$strip_syntree) {
- print "op_first $firstix\n";
+ asm "op_first $firstix\n";
}
}
@@ -214,7 +268,7 @@ sub B::LOGOP::bytecode {
my $op = shift;
my $otherix = $op->other->objix;
$op->B::UNOP::bytecode;
- print "op_other $otherix\n";
+ asm "op_other $otherix\n";
}
sub B::SVOP::bytecode {
@@ -222,7 +276,7 @@ sub B::SVOP::bytecode {
my $sv = $op->sv;
my $svix = $sv->objix;
$op->B::OP::bytecode;
- print "op_sv $svix\n";
+ asm "op_sv $svix\n";
$sv->bytecode;
}
@@ -230,7 +284,7 @@ sub B::PADOP::bytecode {
my $op = shift;
my $padix = $op->padix;
$op->B::OP::bytecode;
- print "op_padix $padix\n";
+ asm "op_padix $padix\n";
}
sub B::PVOP::bytecode {
@@ -243,27 +297,27 @@ sub B::PVOP::bytecode {
#
if ($op->name eq "trans") {
my @shorts = unpack("s256", $pv); # assembler handles endianness
- print "op_pv_tr ", join(",", @shorts), "\n";
+ asm "op_pv_tr ", join(",", @shorts), "\n";
} else {
- printf "newpv %s\nop_pv\n", pvstring($pv);
+ asmf "newpv %s\nop_pv\n", pvstring($pv);
}
}
sub B::BINOP::bytecode {
my $op = shift;
- my $lastix = $op->last->objix;
+ my $lastix = $op->last->objix unless $strip_syntree;
$op->B::UNOP::bytecode;
if (($op->type || !$compress_nullops) && !$strip_syntree) {
- print "op_last $lastix\n";
+ asm "op_last $lastix\n";
}
}
sub B::LISTOP::bytecode {
my $op = shift;
- my $children = $op->children;
+ my $children = $op->children unless $strip_syntree;
$op->B::BINOP::bytecode;
if (($op->type || !$compress_nullops) && !$strip_syntree) {
- print "op_children $children\n";
+ asm "op_children $children\n";
}
}
@@ -273,28 +327,29 @@ sub B::LOOP::bytecode {
my $nextopix = $op->nextop->objix;
my $lastopix = $op->lastop->objix;
$op->B::LISTOP::bytecode;
- print "op_redoop $redoopix\nop_nextop $nextopix\nop_lastop $lastopix\n";
+ asm "op_redoop $redoopix\nop_nextop $nextopix\nop_lastop $lastopix\n";
}
sub B::COP::bytecode {
my $op = shift;
- my $stashpv = $op->stashpv;
my $file = $op->file;
my $line = $op->line;
+ if ($debug_bc) { # do this early to aid debugging
+ asmf "# line %s:%d\n", $file, $line;
+ }
+ my $stashpv = $op->stashpv;
my $warnings = $op->warnings;
my $warningsix = $warnings->objix;
- if ($debug_bc) {
- printf "# line %s:%d\n", $file, $line;
- }
+ my $labelix = pvix($op->label);
+ my $stashix = pvix($stashpv);
+ my $fileix = pvix($file);
+ $warnings->bytecode;
$op->B::OP::bytecode;
- printf <<"EOT", pvstring($op->label), pvstring($stashpv), $op->cop_seq, pvstring($file), $op->arybase;
-newpv %s
-cop_label
-newpv %s
-cop_stashpv
+ asmf <<"EOT", $labelix, $stashix, $op->cop_seq, $fileix, $op->arybase;
+cop_label %d
+cop_stashpv %d
cop_seq %d
-newpv %s
-cop_file
+cop_file %d
cop_arybase %d
cop_line $line
cop_warnings $warningsix
@@ -322,13 +377,13 @@ sub B::PMOP::bytecode {
}
$op->B::LISTOP::bytecode;
if ($opname eq "pushre") {
- printf "op_pmreplrootgv $replrootix\n";
+ asmf "op_pmreplrootgv $replrootix\n";
} else {
- print "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n";
+ asm "op_pmreplroot $replrootix\nop_pmreplstart $replstartix\n";
}
my $re = pvstring($op->precomp);
# op_pmnext omitted since a perl bug means it's sometime corrupt
- printf <<"EOT", $op->pmflags, $op->pmpermflags;
+ asmf <<"EOT", $op->pmflags, $op->pmpermflags;
op_pmflags 0x%x
op_pmpermflags 0x%x
newpv $re
@@ -343,7 +398,7 @@ sub B::SV::bytecode {
my $refcnt = $sv->REFCNT;
my $flags = sprintf("0x%x", $sv->FLAGS);
ldsv($ix);
- print "sv_refcnt $refcnt\nsv_flags $flags\n";
+ asm "sv_refcnt $refcnt\nsv_flags $flags\n";
mark_saved($sv);
}
@@ -351,7 +406,7 @@ sub B::PV::bytecode {
my $sv = shift;
return if saved($sv);
$sv->B::SV::bytecode;
- printf("newpv %s\nxpv\n", pvstring($sv->PV)) if $sv->FLAGS & POK;
+ asmf("newpv %s\nxpv\n", pvstring($sv->PV)) if $sv->FLAGS & POK;
}
sub B::IV::bytecode {
@@ -359,14 +414,14 @@ sub B::IV::bytecode {
return if saved($sv);
my $iv = $sv->IVX;
$sv->B::SV::bytecode;
- printf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32";
+ asmf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32" if $sv->FLAGS & IOK; # could be PVNV
}
sub B::NV::bytecode {
my $sv = shift;
return if saved($sv);
$sv->B::SV::bytecode;
- printf "xnv %s\n", $sv->NVX;
+ asmf "xnv %s\n", nv($sv->NVX);
}
sub B::RV::bytecode {
@@ -376,7 +431,7 @@ sub B::RV::bytecode {
my $rvix = $rv->objix;
$rv->bytecode;
$sv->B::SV::bytecode;
- print "xrv $rvix\n";
+ asm "xrv $rvix\n";
}
sub B::PVIV::bytecode {
@@ -384,7 +439,7 @@ sub B::PVIV::bytecode {
return if saved($sv);
my $iv = $sv->IVX;
$sv->B::PV::bytecode;
- printf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32";
+ asmf "%s $iv\n", $sv->needs64bits ? "xiv64" : "xiv32";
}
sub B::PVNV::bytecode {
@@ -404,12 +459,12 @@ sub B::PVNV::bytecode {
} else {
my $pv = $sv->PV;
$sv->B::IV::bytecode;
- printf "xnv %s\n", $sv->NVX;
+ asmf "xnv %s\n", nv($sv->NVX);
if ($flag == 1) {
$pv .= "\0" . $sv->TABLE;
- printf "newpv %s\npv_cur %d\nxpv\n", pvstring($pv),length($pv)-257;
+ asmf "newpv %s\npv_cur %d\nxpv\n", pvstring($pv),length($pv)-257;
} else {
- printf("newpv %s\nxpv\n", pvstring($pv)) if $sv->FLAGS & POK;
+ asmf("newpv %s\nxpv\n", pvstring($pv)) if $sv->FLAGS & POK;
}
}
}
@@ -431,9 +486,9 @@ sub B::PVMG::bytecode {
#
@mgobjix = map($_->OBJ->objix, @mgchain);
$sv->B::PVNV::bytecode($flag);
- print "xmg_stash $stashix\n";
+ asm "xmg_stash $stashix\n";
foreach $mg (@mgchain) {
- printf "sv_magic %s\nmg_obj %d\nnewpv %s\nmg_pv\n",
+ asmf "sv_magic %s\nmg_obj %d\nnewpv %s\nmg_pv\n",
cstring($mg->TYPE), shift(@mgobjix), pvstring($mg->PTR);
}
}
@@ -442,7 +497,7 @@ sub B::PVLV::bytecode {
my $sv = shift;
return if saved($sv);
$sv->B::PVMG::bytecode;
- printf <<'EOT', $sv->TARGOFF, $sv->TARGLEN, cstring($sv->TYPE);
+ asmf <<'EOT', $sv->TARGOFF, $sv->TARGLEN, cstring($sv->TYPE);
xlv_targoff %d
xlv_targlen %d
xlv_type %s
@@ -454,46 +509,63 @@ sub B::BM::bytecode {
return if saved($sv);
# See PVNV::bytecode for an explanation of what the argument does
$sv->B::PVMG::bytecode(1);
- printf "xbm_useful %d\nxbm_previous %d\nxbm_rare %d\n",
+ asmf "xbm_useful %d\nxbm_previous %d\nxbm_rare %d\n",
$sv->USEFUL, $sv->PREVIOUS, $sv->RARE;
}
+sub empty_gv { # is a GV empty except for imported stuff?
+ my $gv = shift;
+
+ return 0 if ($gv->SV->FLAGS & SVTYPEMASK); # sv not SVt_NULL
+ my @subfield_names = qw(AV HV CV FORM IO);
+ @subfield_names = grep {;
+ no strict 'refs';
+ !($gv->GvFLAGS & ${\"GVf_IMPORTED_$_"}->()) && ${$gv->$_()};
+ } @subfield_names;
+ return scalar @subfield_names;
+}
+
sub B::GV::bytecode {
my $gv = shift;
return if saved($gv);
+ return unless grep { $_ eq $gv->STASH->NAME; } @packages;
+ return if $gv->NAME =~ m/^\(/; # ignore overloads - they'll be rebuilt
my $ix = $gv->objix;
mark_saved($gv);
ldsv($ix);
- printf <<"EOT", $gv->FLAGS, $gv->GvFLAGS;
+ asmf <<"EOT", $gv->FLAGS, $gv->GvFLAGS;
sv_flags 0x%x
xgv_flags 0x%x
EOT
my $refcnt = $gv->REFCNT;
- printf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
+ asmf("sv_refcnt_add %d\n", $refcnt - 1) if $refcnt > 1;
return if $gv->is_empty;
- printf <<"EOT", $gv->LINE, pvstring($gv->FILE);
+ asmf <<"EOT", $gv->LINE, pvix($gv->FILE);
gp_line %d
-newpv %s
-gp_file
+gp_file %d
EOT
my $gvname = $gv->NAME;
my $name = cstring($gv->STASH->NAME . "::" . $gvname);
my $egv = $gv->EGV;
my $egvix = $egv->objix;
my $gvrefcnt = $gv->GvREFCNT;
- printf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1;
+ asmf("gp_refcnt_add %d\n", $gvrefcnt - 1) if $gvrefcnt > 1;
if ($gvrefcnt > 1 && $ix != $egvix) {
- print "gp_share $egvix\n";
+ asm "gp_share $egvix\n";
} else {
if ($gvname !~ /^([^A-Za-z]|STDIN|STDOUT|STDERR|ARGV|SIG|ENV)$/) {
my $i;
my @subfield_names = qw(SV AV HV CV FORM IO);
+ @subfield_names = grep {;
+ no strict 'refs';
+ !($gv->GvFLAGS & ${\"GVf_IMPORTED_$_"}->());
+ } @subfield_names;
my @subfields = map($gv->$_(), @subfield_names);
my @ixes = map($_->objix, @subfields);
# Reset sv register for $gv
ldsv($ix);
for ($i = 0; $i < @ixes; $i++) {
- printf "gp_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
+ asmf "gp_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
}
# Now save all the subfields
my $sv;
@@ -523,10 +595,10 @@ sub B::HV::bytecode {
}
ldsv($ix);
for ($i = 0; $i < @contents; $i += 2) {
- printf("newpv %s\nhv_store %d\n",
+ asmf("newpv %s\nhv_store %d\n",
pvstring($contents[$i]), $ixes[$i / 2]);
}
- printf "sv_refcnt %d\nsv_flags 0x%x\n", $hv->REFCNT, $hv->FLAGS;
+ asmf "sv_refcnt %d\nsv_flags 0x%x\n", $hv->REFCNT, $hv->FLAGS;
}
}
@@ -551,22 +623,26 @@ sub B::AV::bytecode {
# create an AV with NEWSV and SvUPGRADE rather than doing newAV
# which is what sets AvMAX and AvFILL.
ldsv($ix);
- printf "xav_flags 0x%x\nxav_max -1\nxav_fill -1\n", $av->AvFLAGS;
+ asmf "sv_flags 0x%x\n", $av->FLAGS & ~SVf_READONLY; # SvREADONLY_off($av) in case PADCONST
+ asmf "xav_flags 0x%x\nxav_max -1\nxav_fill -1\n", $av->AvFLAGS;
if ($fill > -1) {
my $elix;
foreach $elix (@ixes) {
- print "av_push $elix\n";
+ asm "av_push $elix\n";
}
} else {
if ($max > -1) {
- print "av_extend $max\n";
+ asm "av_extend $max\n";
}
}
+ asmf "sv_flags 0x%x\n", $av->FLAGS; # restore flags from above
}
sub B::CV::bytecode {
my $cv = shift;
return if saved($cv);
+ return if ${$cv->GV} && ($cv->GV->GvFLAGS & GVf_IMPORTED_CV);
+ my $fileix = pvix($cv->FILE);
my $ix = $cv->objix;
$cv->B::PVMG::bytecode;
my $i;
@@ -581,10 +657,10 @@ sub B::CV::bytecode {
# Reset sv register for $cv (since above ->objix calls stomped on it)
ldsv($ix);
for ($i = 0; $i < @ixes; $i++) {
- printf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
+ asmf "xcv_%s %d\n", lc($subfield_names[$i]), $ixes[$i];
}
- printf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->CvFLAGS;
- printf "newpv %s\nxcv_file\n", pvstring($cv->FILE);
+ asmf "xcv_depth %d\nxcv_flags 0x%x\n", $cv->DEPTH, $cv->CvFLAGS;
+ asmf "xcv_file %d\n", $fileix;
# Now save all the subfields (except for CvROOT which was handled
# above) and CvSTART (now the initial element of @subfields).
shift @subfields; # bye-bye CvSTART
@@ -607,17 +683,17 @@ sub B::IO::bytecode {
$io->B::PVMG::bytecode;
ldsv($ix);
- print "xio_top_gv $top_gvix\n";
- print "xio_fmt_gv $fmt_gvix\n";
- print "xio_bottom_gv $bottom_gvix\n";
+ asm "xio_top_gv $top_gvix\n";
+ asm "xio_fmt_gv $fmt_gvix\n";
+ asm "xio_bottom_gv $bottom_gvix\n";
my $field;
foreach $field (qw(TOP_NAME FMT_NAME BOTTOM_NAME)) {
- printf "newpv %s\nxio_%s\n", pvstring($io->$field()), lc($field);
+ asmf "newpv %s\nxio_%s\n", pvstring($io->$field()), lc($field);
}
foreach $field (qw(LINES PAGE PAGE_LEN LINES_LEFT SUBPROCESS)) {
- printf "xio_%s %d\n", lc($field), $io->$field();
+ asmf "xio_%s %d\n", lc($field), $io->$field();
}
- printf "xio_type %s\nxio_flags 0x%x\n", cstring($io->IoTYPE), $io->IoFLAGS;
+ asmf "xio_type %s\nxio_flags 0x%x\n", cstring($io->IoTYPE), $io->IoFLAGS;
$top_gv->bytecode;
$fmt_gv->bytecode;
$bottom_gv->bytecode;
@@ -628,8 +704,7 @@ sub B::SPECIAL::bytecode {
}
sub bytecompile_object {
- my $sv;
- foreach $sv (@_) {
+ for my $sv (@_) {
svref_2object($sv)->bytecode;
}
}
@@ -637,7 +712,7 @@ sub bytecompile_object {
sub B::GV::bytecodecv {
my $gv = shift;
my $cv = $gv->CV;
- if ($$cv && !saved($cv)) {
+ if ($$cv && !saved($cv) && !($gv->FLAGS & GVf_IMPORTED_CV)) {
if ($debug_cv) {
warn sprintf("saving extra CV &%s::%s (0x%x) from GV 0x%x\n",
$gv->STASH->NAME, $gv->NAME, $$cv, $$gv);
@@ -646,43 +721,66 @@ sub B::GV::bytecodecv {
}
}
-sub bytecompile_main {
- my $curpad = (comppadlist->ARRAY)[1];
- my $curpadix = $curpad->objix;
- $curpad->bytecode;
- walkoptree(main_root, "bytecode");
- warn "done main program, now walking symbol table\n" if $debug_bc;
- my ($pack, %exclude);
- foreach $pack (qw(B O AutoLoader DynaLoader XSLoader Config DB VMS strict vars
- FileHandle Exporter Carp UNIVERSAL IO Fcntl Symbol warnings
- attributes File::Spec SelectSaver blib Cwd))
- {
- $exclude{$pack."::"} = 1;
+sub save_call_queues {
+ if (begin_av()->isa("B::AV")) { # this is just to save 'use Foo;' calls
+ for my $cv (begin_av()->ARRAY) {
+ next unless grep { $_ eq $cv->STASH->NAME; } @packages;
+ my $op = $cv->START;
+OPLOOP:
+ while ($$op) {
+ if ($op->name eq 'require') { # save any BEGIN that does a require
+ $cv->bytecode;
+ asmf "push_begin %d\n", $cv->objix;
+ last OPLOOP;
+ }
+ $op = $op->next;
+ }
+ }
}
- no strict qw(vars refs);
- walksymtable(\%{"main::"}, "bytecodecv", sub {
- warn "considering $_[0]\n" if $debug_bc;
- return !defined($exclude{$_[0]});
- });
- if (!$module_only) {
- printf "main_root %d\n", main_root->objix;
- printf "main_start %d\n", main_start->objix;
- printf "curpad $curpadix\n";
- # XXX Do min_intro_pending and max_intro_pending matter?
+ if (init_av()->isa("B::AV")) {
+ for my $cv (init_av()->ARRAY) {
+ next unless grep { $_ eq $cv->STASH->NAME; } @packages;
+ $cv->bytecode;
+ asmf "push_init %d\n", $cv->objix;
+ }
+ }
+ if (end_av()->isa("B::AV")) {
+ for my $cv (end_av()->ARRAY) {
+ next unless grep { $_ eq $cv->STASH->NAME; } @packages;
+ $cv->bytecode;
+ asmf "push_end %d\n", $cv->objix;
+ }
}
}
-sub prepare_assemble {
- my $newfh = IO::File->new_tmpfile;
- select($newfh);
- binmode $newfh;
- return $newfh;
+sub symwalk {
+ no strict 'refs';
+ my $ok = 1 if grep { (my $name = $_[0]) =~ s/::$//; $_ eq $name;} @packages;
+ if (grep { /^$_[0]/; } @packages) {
+ walksymtable(\%{"$_[0]"}, "bytecodecv", \&symwalk, $_[0]);
+ }
+ warn "considering $_[0] ... " . ($ok ? "accepted\n" : "rejected\n")
+ if $debug_bc;
+ $ok;
}
-sub do_assemble {
- my $fh = shift;
- seek($fh, 0, 0); # rewind the temporary file
- assemble_fh($fh, sub { print OUT @_ });
+sub bytecompile_main {
+ my $curpad = (comppadlist->ARRAY)[1];
+ my $curpadix = $curpad->objix;
+ $curpad->bytecode;
+ save_call_queues();
+ walkoptree(main_root, "bytecode") unless ref(main_root) eq "B::NULL";
+ warn "done main program, now walking symbol table\n" if $debug_bc;
+ if (@packages) {
+ no strict qw(refs);
+ walksymtable(\%{"main::"}, "bytecodecv", \&symwalk);
+ } else {
+ die "No packages requested for compilation!\n";
+ }
+ asmf "main_root %d\n", main_root->objix;
+ asmf "main_start %d\n", main_start->objix;
+ asmf "curpad $curpadix\n";
+ # XXX Do min_intro_pending and max_intro_pending matter?
}
sub compile {
@@ -690,7 +788,7 @@ sub compile {
my ($option, $opt, $arg);
open(OUT, ">&STDOUT");
binmode OUT;
- select(OUT);
+ select OUT;
OPTION:
while ($option = shift @options) {
if ($option =~ /^-(.)(.*)/) {
@@ -727,8 +825,6 @@ sub compile {
}
} elsif ($opt eq "v") {
$verbose = 1;
- } elsif ($opt eq "m") {
- $module_only = 1;
} elsif ($opt eq "S") {
$no_assemble = 1;
} elsif ($opt eq "f") {
@@ -747,9 +843,6 @@ sub compile {
foreach $ref (values %optimise) {
$$ref = 0;
}
- if ($arg >= 6) {
- $strip_syntree = 1;
- }
if ($arg >= 2) {
$bypass_nullops = 1;
}
@@ -757,28 +850,30 @@ sub compile {
$compress_nullops = 1;
$omit_seq = 1;
}
+ } elsif ($opt eq "P") {
+ $arg ||= shift @options;
+ push @packages, $arg;
+ } else {
+ warn qq(ignoring unknown option "$opt$arg"\n);
}
}
+ if (! @packages) {
+ warn "No package specified for compilation, assuming main::\n";
+ @packages = qw(main);
+ }
if (@options) {
- return sub {
- my $objname;
- my $newfh;
- $newfh = prepare_assemble() unless $no_assemble;
- foreach $objname (@options) {
- eval "bytecompile_object(\\$objname)";
- }
- do_assemble($newfh) unless $no_assemble;
- }
+ die "Extraneous options left on B::Bytecode commandline: @options\n";
} else {
- return sub {
- my $newfh;
- $newfh = prepare_assemble() unless $no_assemble;
+ return sub {
+ newasm(\&apr) unless $no_assemble;
bytecompile_main();
- do_assemble($newfh) unless $no_assemble;
- }
+ endasm() unless $no_assemble;
+ };
}
}
+sub apr { print @_; }
+
1;
__END__
@@ -848,18 +943,11 @@ which is only used by perl's internal compiler.
If op->op_next ever points to a NULLOP, replaces the op_next field
with the first non-NULLOP in the path of execution.
-=item B<-fstrip-syntax-tree>
-
-Leaves out code to fill in the pointers which link the internal syntax
-tree together. They're not needed at run-time but leaving them out
-will make it impossible to recompile or disassemble the resulting
-program. It will also stop C<goto label> statements from working.
-
=item B<-On>
Optimisation level (n = 0, 1, 2, ...). B<-O> means B<-O1>.
B<-O1> sets B<-fcompress-nullops> B<-fomit-sequence numbers>.
-B<-O6> adds B<-fstrip-syntax-tree>.
+B<-O2> adds B<-fbypass-nullops>.
=item B<-D>
@@ -887,33 +975,33 @@ Prints each CV taken from the final symbol tree walk.
Output (bytecode) assembler source rather than piping it
through the assembler and outputting bytecode.
-=item B<-m>
-
-Compile as a module rather than a standalone program. Currently this
-just means that the bytecodes for initialising C<main_start>,
-C<main_root> and C<curpad> are omitted.
-
+=item B<-Ppackage>
+
+Stores package in the output.
+
=back
=head1 EXAMPLES
- perl -MO=Bytecode,-O6,-o,foo.plc foo.pl
+ perl -MO=Bytecode,-O6,-ofoo.plc,-Pmain foo.pl
- perl -MO=Bytecode,-S foo.pl > foo.S
+ perl -MO=Bytecode,-S,-Pmain foo.pl > foo.S
assemble foo.S > foo.plc
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
+ perl -MO=Bytecode,-PFoo,-oFoo.pmc Foo.pm
=head1 BUGS
-Plenty. Current status: experimental.
+Output is still huge and there are still occasional crashes during
+either compilation or ByteLoading. Current status: experimental.
-=head1 AUTHOR
+=head1 AUTHORS
Malcolm Beattie, C<mbeattie@sable.ox.ac.uk>
+Benjamin Stuhl, C<sho_pi@hotmail.com>
=cut
diff --git a/ext/B/O.pm b/ext/B/O.pm
index 352f8d4206..2ef91edbd9 100644
--- a/ext/B/O.pm
+++ b/ext/B/O.pm
@@ -1,5 +1,5 @@
package O;
-use B qw(minus_c);
+use B qw(minus_c save_BEGINs);
use Carp;
sub import {
@@ -11,6 +11,7 @@ sub import {
my $compilesub = &{"B::${backend}::compile"}(@options);
if (ref($compilesub) eq "CODE") {
minus_c;
+ save_BEGINs;
eval 'CHECK { &$compilesub() }';
} else {
die $compilesub;
diff --git a/ext/B/defsubs_h.PL b/ext/B/defsubs_h.PL
index 759013bbcc..800bb2ca7d 100644
--- a/ext/B/defsubs_h.PL
+++ b/ext/B/defsubs_h.PL
@@ -6,11 +6,16 @@ my ($out) = __FILE__ =~ /(^.*)\.PL/i;
$out =~ s/_h$/.h/;
open(OUT,">$out") || die "Cannot open $file:$!";
print "Extracting $out...\n";
-foreach my $const (qw(AVf_REAL
+foreach my $const (qw(
+ AVf_REAL
HEf_SVKEY
- CVf_METHOD CVf_LOCKED CVf_LVALUE
+ SVf_READONLY SVTYPEMASK
+ GVf_IMPORTED_AV GVf_IMPORTED_HV
+ GVf_IMPORTED_SV GVf_IMPORTED_CV
+ CVf_METHOD CVf_LOCKED CVf_LVALUE
SVf_IOK SVf_IVisUV SVf_NOK SVf_POK
- SVf_ROK SVp_IOK SVp_POK ))
+ SVf_ROK SVp_IOK SVp_POK SVp_NOK
+ ))
{
doconst($const);
}
diff --git a/ext/ByteLoader/ByteLoader.pm b/ext/ByteLoader/ByteLoader.pm
index 286d74697e..9c8c84d677 100644
--- a/ext/ByteLoader/ByteLoader.pm
+++ b/ext/ByteLoader/ByteLoader.pm
@@ -2,7 +2,7 @@ package ByteLoader;
use XSLoader ();
-$VERSION = 0.03;
+$VERSION = 0.04;
XSLoader::load 'ByteLoader', $VERSION;
@@ -17,10 +17,10 @@ ByteLoader - load byte compiled perl code
=head1 SYNOPSIS
- use ByteLoader 0.03;
+ use ByteLoader 0.04;
<byte code>
- use ByteLoader 0.03;
+ use ByteLoader 0.04;
<byte code>
=head1 DESCRIPTION
diff --git a/ext/ByteLoader/ByteLoader.xs b/ext/ByteLoader/ByteLoader.xs
index 7c3746bba7..d3b435199e 100644
--- a/ext/ByteLoader/ByteLoader.xs
+++ b/ext/ByteLoader/ByteLoader.xs
@@ -4,31 +4,74 @@
#include "XSUB.h"
#include "byterun.h"
-static int
-xgetc(PerlIO *io)
-{
- dTHX;
- return PerlIO_getc(io);
-}
+/* Something arbitary for a buffer size */
+#define BYTELOADER_BUFFER 8096
-static int
-xfread(char *buf, size_t size, size_t n, PerlIO *io)
+int
+bl_getc(struct byteloader_fdata *data)
{
dTHX;
- int i = PerlIO_read(io, buf, n * size);
- if (i > 0)
- i /= size;
- return i;
+ if (SvCUR(data->datasv) <= data->next_out) {
+ int result;
+ /* Run out of buffered data, so attempt to read some more */
+ *(SvPV_nolen (data->datasv)) = '\0';
+ SvCUR_set (data->datasv, 0);
+ data->next_out = 0;
+ result = FILTER_READ (data->idx + 1, data->datasv, BYTELOADER_BUFFER);
+
+ /* Filter returned error, or we got EOF and no data, then return EOF.
+ Not sure if filter is allowed to return EOF and add data simultaneously
+ Think not, but will bullet proof against it. */
+ if (result < 0 || SvCUR(data->datasv) == 0)
+ return EOF;
+ /* Else there must be at least one byte present, which is good enough */
+ }
+
+ return *((char *) SvPV_nolen (data->datasv) + data->next_out++);
}
-static void
-freadpv(U32 len, void *data, XPV *pv)
+int
+bl_read(struct byteloader_fdata *data, char *buf, size_t size, size_t n)
{
dTHX;
- New(666, pv->xpv_pv, len, char);
- PerlIO_read((PerlIO*)data, (void*)pv->xpv_pv, len);
- pv->xpv_len = len;
- pv->xpv_cur = len - 1;
+ char *start;
+ STRLEN len;
+ size_t wanted = size * n;
+
+ start = SvPV (data->datasv, len);
+ if (len < (data->next_out + wanted)) {
+ int result;
+
+ /* Shuffle data to start of buffer */
+ len -= data->next_out;
+ if (len) {
+ memmove (start, start + data->next_out, len + 1);
+ SvCUR_set (data->datasv, len);
+ } else {
+ *start = '\0'; /* Avoid call to memmove. */
+ SvCUR_set (data->datasv, 0);
+ }
+ data->next_out = 0;
+
+ /* Attempt to read more data. */
+ do {
+ result = FILTER_READ (data->idx + 1, data->datasv, BYTELOADER_BUFFER);
+
+ start = SvPV (data->datasv, len);
+ } while (result > 0 && len < wanted);
+ /* Loop while not (EOF || error) and short reads */
+
+ /* If not enough data read, truncate copy */
+ if (wanted > len)
+ wanted = len;
+ }
+
+ if (wanted > 0) {
+ memcpy (buf, start + data->next_out, wanted);
+ data->next_out += wanted;
+ wanted /= size;
+ }
+ return (int) wanted;
}
static I32
@@ -37,14 +80,20 @@ byteloader_filter(pTHXo_ int idx, SV *buf_sv, int maxlen)
dTHR;
OP *saveroot = PL_main_root;
OP *savestart = PL_main_start;
- struct bytestream bs;
+ struct byteloader_state bstate;
+ struct byteloader_fdata data;
+
+ data.next_out = 0;
+ data.datasv = FILTER_DATA(idx);
+ data.idx = idx;
- bs.data = PL_rsfp;
- bs.pfgetc = (int(*) (void*))xgetc;
- bs.pfread = (int(*) (char*,size_t,size_t,void*))xfread;
- bs.pfreadpv = freadpv;
+ bstate.bs_fdata = &data;
+ bstate.bs_obj_list = Null(void**);
+ bstate.bs_obj_list_fill = -1;
+ bstate.bs_sv = Nullsv;
+ bstate.bs_iv_overflows = 0;
- byterun(aTHXo_ bs);
+ byterun(aTHXo_ &bstate);
if (PL_in_eval) {
OP *o;
@@ -70,8 +119,12 @@ PROTOTYPES: ENABLE
void
import(...)
+ PREINIT:
+ SV *sv = newSVpvn ("", 0);
PPCODE:
- filter_add(byteloader_filter, NULL);
+ if (!sv)
+ croak ("Could not allocate ByteLoader buffers");
+ filter_add(byteloader_filter, sv);
void
unimport(...)
diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
index 1621fed4eb..296c2afd65 100644
--- a/ext/ByteLoader/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -5,29 +5,33 @@ typedef char *op_tr_array;
typedef int comment_t;
typedef SV *svindex;
typedef OP *opindex;
+typedef char *pvindex;
typedef IV IV64;
#define BGET_FREAD(argp, len, nelem) \
- bs.pfread((char*)(argp),(len),(nelem),bs.data)
-#define BGET_FGETC() bs.pfgetc(bs.data)
+ bl_read(bstate->bs_fdata,(char*)(argp),(len),(nelem))
+#define BGET_FGETC() bl_getc(bstate->bs_fdata)
#define BGET_U32(arg) \
- BGET_FREAD(&arg, sizeof(U32), 1); arg = PerlSock_ntohl((U32)arg)
+ BGET_FREAD(&arg, sizeof(U32), 1)
#define BGET_I32(arg) \
- BGET_FREAD(&arg, sizeof(I32), 1); arg = (I32)PerlSock_ntohl((U32)arg)
+ BGET_FREAD(&arg, sizeof(I32), 1)
#define BGET_U16(arg) \
- BGET_FREAD(&arg, sizeof(U16), 1); arg = PerlSock_ntohs((U16)arg)
+ BGET_FREAD(&arg, sizeof(U16), 1)
#define BGET_U8(arg) arg = BGET_FGETC()
-#define BGET_PV(arg) STMT_START { \
- BGET_U32(arg); \
- if (arg) \
- bs.pfreadpv(arg, bs.data, &bytecode_pv); \
- else { \
- bytecode_pv.xpv_pv = 0; \
- bytecode_pv.xpv_len = 0; \
- bytecode_pv.xpv_cur = 0; \
- } \
+#define BGET_PV(arg) STMT_START { \
+ BGET_U32(arg); \
+ if (arg) { \
+ New(666, bstate->bs_pv.xpv_pv, arg, char); \
+ bl_read(bstate->bs_fdata, (void*)bstate->bs_pv.xpv_pv, arg, 1); \
+ bstate->bs_pv.xpv_len = arg; \
+ bstate->bs_pv.xpv_cur = arg - 1; \
+ } else { \
+ bstate->bs_pv.xpv_pv = 0; \
+ bstate->bs_pv.xpv_len = 0; \
+ bstate->bs_pv.xpv_cur = 0; \
+ } \
} STMT_END
#ifdef BYTELOADER_LOG_COMMENTS
@@ -63,22 +67,20 @@ typedef IV IV64;
arg = (I32)lo; \
} \
else { \
- bytecode_iv_overflows++; \
+ bstate->bs_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; \
+#define BGET_op_tr_array(arg) do { \
+ unsigned short *ary; \
+ int i; \
+ New(666, ary, 256, unsigned short); \
+ BGET_FREAD(ary, sizeof(unsigned short), 256); \
+ arg = (char *) ary; \
} while (0)
-#define BGET_pvcontents(arg) arg = bytecode_pv.xpv_pv
+#define BGET_pvcontents(arg) arg = bstate->bs_pv.xpv_pv
#define BGET_strconst(arg) STMT_START { \
for (arg = PL_tokenbuf; (*arg = BGET_FGETC()); arg++) /* nothing */; \
arg = PL_tokenbuf; \
@@ -91,14 +93,21 @@ typedef IV IV64;
} STMT_END
#define BGET_objindex(arg, type) STMT_START { \
- U32 ix; \
BGET_U32(ix); \
- arg = (type)bytecode_obj_list[ix]; \
+ arg = (type)bstate->bs_obj_list[ix]; \
} STMT_END
#define BGET_svindex(arg) BGET_objindex(arg, svindex)
#define BGET_opindex(arg) BGET_objindex(arg, opindex)
+#define BGET_pvindex(arg) STMT_START { \
+ BGET_objindex(arg, pvindex); \
+ arg = arg ? savepv(arg) : arg; \
+ } STMT_END
#define BSET_ldspecsv(sv, arg) sv = specialsv_list[arg]
+#define BSET_stpv(pv, arg) STMT_START { \
+ BSET_OBJ_STORE(pv, arg); \
+ SAVEFREEPV(pv); \
+ } STMT_END
#define BSET_sv_refcnt_add(svrefcnt, arg) svrefcnt += arg
#define BSET_gp_refcnt_add(gprefcnt, arg) gprefcnt += arg
@@ -110,23 +119,29 @@ typedef IV IV64;
#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_mg_pv(mg, arg) mg->mg_ptr = arg; mg->mg_len = bstate->bs_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); \
+ SvPV_set(sv, bstate->bs_pv.xpv_pv); \
+ SvCUR_set(sv, bstate->bs_pv.xpv_cur); \
+ SvLEN_set(sv, bstate->bs_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)
+ hv_store((HV*)sv, bstate->bs_pv.xpv_pv, bstate->bs_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(aTHX_ arg, arg + bytecode_pv.xpv_cur, ((PMOP*)o)) : 0
-#define BSET_newsv(sv, arg) sv = NEWSV(666,0); SvUPGRADE(sv, arg)
+ CALLREGCOMP(aTHX_ arg, arg + bstate->bs_pv.xpv_cur, ((PMOP*)o)) : 0
+#define BSET_newsv(sv, arg) \
+ STMT_START { \
+ sv = (arg == SVt_PVAV ? (SV*)newAV() : \
+ arg == SVt_PVHV ? (SV*)newHV() : \
+ NEWSV(666,0)); \
+ SvUPGRADE(sv, arg); \
+ } STMT_END
#define BSET_newop(o, arg) ((o = (OP*)safemalloc(optype_size[arg])), \
memzero((char*)o,optype_size[arg]))
#define BSET_newopn(o, arg) STMT_START { \
@@ -135,7 +150,10 @@ typedef IV IV64;
oldop->op_next = o; \
} STMT_END
-#define BSET_ret(foo) return
+#define BSET_ret(foo) STMT_START { \
+ Safefree(bstate->bs_obj_list); \
+ return; \
+ } STMT_END
/*
* Kludge special-case workaround for OP_MAPSTART
@@ -152,10 +170,85 @@ typedef IV IV64;
PL_comppad = (AV *)arg; \
pad = AvARRAY(arg); \
} STMT_END
+/* this works now that Sarathy's changed the CopFILE_set macro to do the SvREFCNT_inc()
+ -- BKS 6-2-2000 */
#define BSET_cop_file(cop, arg) CopFILE_set(cop,arg)
#define BSET_cop_line(cop, arg) CopLINE_set(cop,arg)
#define BSET_cop_stashpv(cop, arg) CopSTASHPV_set(cop,arg)
-#define BSET_OBJ_STORE(obj, ix) \
- (I32)ix > bytecode_obj_list_fill ? \
- bset_obj_store(aTHXo_ obj, (I32)ix) : (bytecode_obj_list[ix] = obj)
+/* this is simply stolen from the code in newATTRSUB() */
+#define BSET_push_begin(ary,cv) \
+ STMT_START { \
+ I32 oldscope = PL_scopestack_ix; \
+ ENTER; \
+ SAVECOPFILE(&PL_compiling); \
+ SAVECOPLINE(&PL_compiling); \
+ save_svref(&PL_rs); \
+ sv_setsv(PL_rs, PL_nrs); \
+ if (!PL_beginav) \
+ PL_beginav = newAV(); \
+ av_push(PL_beginav, cv); \
+ call_list(oldscope, PL_beginav); \
+ PL_curcop = &PL_compiling; \
+ PL_compiling.op_private = PL_hints; \
+ LEAVE; \
+ } STMT_END
+#define BSET_push_init(ary,cv) \
+ STMT_START { \
+ av_unshift((PL_initav ? PL_initav : (PL_initav = newAV(), PL_initav)), 1); \
+ av_store(PL_initav, 0, cv); \
+ } STMT_END
+#define BSET_push_end(ary,cv) \
+ STMT_START { \
+ av_unshift((PL_endav ? PL_endav : (PL_endav = newAV(), PL_endav)), 1); \
+ av_store(PL_endav, 0, cv); \
+ } STMT_END
+#define BSET_OBJ_STORE(obj, ix) \
+ (I32)ix > bstate->bs_obj_list_fill ? \
+ bset_obj_store(aTHXo_ bstate, obj, (I32)ix) : (bstate->bs_obj_list[ix] = obj)
+
+/* NOTE: the bytecode header only sanity-checks the bytecode. If a script cares about
+ * what version of Perl it's being called under, it should do a 'require 5.6.0' or
+ * equivalent. However, since the header includes checks requiring an exact match in
+ * ByteLoader versions (we can't guarantee forward compatibility), you don't
+ * need to specify one:
+ * use ByteLoader;
+ * is all you need.
+ * -- BKS, June 2000
+*/
+
+#define HEADER_FAIL(f, arg1, arg2) \
+ Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f, arg1, arg2)
+
+#define BYTECODE_HEADER_CHECK \
+ STMT_START { \
+ U32 sz = 0; \
+ strconst str; \
+ \
+ BGET_U32(sz); /* Magic: 'PLBC' */ \
+ if (sz != 0x43424c50) { \
+ HEADER_FAIL("bad magic (want 0x43424c50, got %#x)", sz, 0); \
+ } \
+ BGET_strconst(str); /* archname */ \
+ if (strNE(str, ARCHNAME)) { \
+ HEADER_FAIL("wrong architecture (want %s, you have %s)",str,ARCHNAME); \
+ } \
+ BGET_strconst(str); /* ByteLoader version */ \
+ if (strNE(str, VERSION)) { \
+ HEADER_FAIL("mismatched ByteLoader versions (want %s, you have %s)", \
+ str, VERSION); \
+ } \
+ BGET_U32(sz); /* ivsize */ \
+ if (sz != IVSIZE) { \
+ HEADER_FAIL("different IVSIZE", 0, 0); \
+ } \
+ BGET_U32(sz); /* ptrsize */ \
+ if (sz != PTRSIZE) { \
+ HEADER_FAIL("different PTRSIZE", 0, 0); \
+ } \
+ BGET_strconst(str); /* byteorder */ \
+ if (strNE(str, STRINGIFY(BYTEORDER))) { \
+ HEADER_FAIL("different byteorder", 0, 0); \
+ } \
+ Safefree(str); \
+ } STMT_END
diff --git a/ext/ByteLoader/byterun.c b/ext/ByteLoader/byterun.c
index a1044ab2c0..19f1f6b44c 100644
--- a/ext/ByteLoader/byterun.c
+++ b/ext/ByteLoader/byterun.c
@@ -26,7 +26,7 @@
#include "bytecode.h"
-static int optype_size[] = {
+static const int optype_size[] = {
sizeof(OP),
sizeof(UNOP),
sizeof(BINOP),
@@ -40,38 +40,35 @@ static int optype_size[] = {
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(pTHXo_ void *obj, I32 ix)
+bset_obj_store(pTHXo_ struct byteloader_state *bstate, void *obj, I32 ix)
{
- if (ix > bytecode_obj_list_fill) {
- if (bytecode_obj_list_fill == -1)
- New(666, bytecode_obj_list, ix + 1, void*);
- else
- Renew(bytecode_obj_list, ix + 1, void*);
- bytecode_obj_list_fill = ix;
+ if (ix > bstate->bs_obj_list_fill) {
+ Renew(bstate->bs_obj_list, ix + 32, void*);
+ bstate->bs_obj_list_fill = ix + 31;
}
- bytecode_obj_list[ix] = obj;
+ bstate->bs_obj_list[ix] = obj;
return obj;
}
void
-byterun(pTHXo_ struct bytestream bs)
+byterun(pTHXo_ register struct byteloader_state *bstate)
{
dTHR;
- int insn;
+ register int insn;
+ U32 ix;
+ SV *specialsv_list[6];
+
+ BYTECODE_HEADER_CHECK; /* croak if incorrect platform */
+ New(666, bstate->bs_obj_list, 32, void*); /* set op objlist */
+ bstate->bs_obj_list_fill = 31;
specialsv_list[0] = Nullsv;
specialsv_list[1] = &PL_sv_undef;
specialsv_list[2] = &PL_sv_yes;
specialsv_list[3] = &PL_sv_no;
+ specialsv_list[4] = pWARN_ALL;
+ specialsv_list[5] = pWARN_NONE;
while ((insn = BGET_FGETC()) != EOF) {
switch (insn) {
@@ -95,7 +92,7 @@ byterun(pTHXo_ struct bytestream bs)
{
svindex arg;
BGET_svindex(arg);
- bytecode_sv = arg;
+ bstate->bs_sv = arg;
break;
}
case INSN_LDOP: /* 2 */
@@ -109,7 +106,7 @@ byterun(pTHXo_ struct bytestream bs)
{
U32 arg;
BGET_U32(arg);
- BSET_OBJ_STORE(bytecode_sv, arg);
+ BSET_OBJ_STORE(bstate->bs_sv, arg);
break;
}
case INSN_STOP: /* 4 */
@@ -119,778 +116,806 @@ byterun(pTHXo_ struct bytestream bs)
BSET_OBJ_STORE(PL_op, arg);
break;
}
- case INSN_LDSPECSV: /* 5 */
+ case INSN_STPV: /* 5 */
+ {
+ U32 arg;
+ BGET_U32(arg);
+ BSET_stpv(bstate->bs_pv.xpv_pv, arg);
+ break;
+ }
+ case INSN_LDSPECSV: /* 6 */
{
U8 arg;
BGET_U8(arg);
- BSET_ldspecsv(bytecode_sv, arg);
+ BSET_ldspecsv(bstate->bs_sv, arg);
break;
}
- case INSN_NEWSV: /* 6 */
+ case INSN_NEWSV: /* 7 */
{
U8 arg;
BGET_U8(arg);
- BSET_newsv(bytecode_sv, arg);
+ BSET_newsv(bstate->bs_sv, arg);
break;
}
- case INSN_NEWOP: /* 7 */
+ case INSN_NEWOP: /* 8 */
{
U8 arg;
BGET_U8(arg);
BSET_newop(PL_op, arg);
break;
}
- case INSN_NEWOPN: /* 8 */
+ case INSN_NEWOPN: /* 9 */
{
U8 arg;
BGET_U8(arg);
BSET_newopn(PL_op, arg);
break;
}
- case INSN_NEWPV: /* 9 */
+ case INSN_NEWPV: /* 11 */
{
PV arg;
BGET_PV(arg);
break;
}
- case INSN_PV_CUR: /* 11 */
+ case INSN_PV_CUR: /* 12 */
{
STRLEN arg;
BGET_U32(arg);
- bytecode_pv.xpv_cur = arg;
+ bstate->bs_pv.xpv_cur = arg;
break;
}
- case INSN_PV_FREE: /* 12 */
+ case INSN_PV_FREE: /* 13 */
{
- BSET_pv_free(bytecode_pv);
+ BSET_pv_free(bstate->bs_pv);
break;
}
- case INSN_SV_UPGRADE: /* 13 */
+ case INSN_SV_UPGRADE: /* 14 */
{
char arg;
BGET_U8(arg);
- BSET_sv_upgrade(bytecode_sv, arg);
+ BSET_sv_upgrade(bstate->bs_sv, arg);
break;
}
- case INSN_SV_REFCNT: /* 14 */
+ case INSN_SV_REFCNT: /* 15 */
{
U32 arg;
BGET_U32(arg);
- SvREFCNT(bytecode_sv) = arg;
+ SvREFCNT(bstate->bs_sv) = arg;
break;
}
- case INSN_SV_REFCNT_ADD: /* 15 */
+ case INSN_SV_REFCNT_ADD: /* 16 */
{
I32 arg;
BGET_I32(arg);
- BSET_sv_refcnt_add(SvREFCNT(bytecode_sv), arg);
+ BSET_sv_refcnt_add(SvREFCNT(bstate->bs_sv), arg);
break;
}
- case INSN_SV_FLAGS: /* 16 */
+ case INSN_SV_FLAGS: /* 17 */
{
U32 arg;
BGET_U32(arg);
- SvFLAGS(bytecode_sv) = arg;
+ SvFLAGS(bstate->bs_sv) = arg;
break;
}
- case INSN_XRV: /* 17 */
+ case INSN_XRV: /* 18 */
{
svindex arg;
BGET_svindex(arg);
- SvRV(bytecode_sv) = arg;
+ SvRV(bstate->bs_sv) = arg;
break;
}
- case INSN_XPV: /* 18 */
+ case INSN_XPV: /* 19 */
{
- BSET_xpv(bytecode_sv);
+ BSET_xpv(bstate->bs_sv);
break;
}
- case INSN_XIV32: /* 19 */
+ case INSN_XIV32: /* 20 */
{
I32 arg;
BGET_I32(arg);
- SvIVX(bytecode_sv) = arg;
+ SvIVX(bstate->bs_sv) = arg;
break;
}
- case INSN_XIV64: /* 20 */
+ case INSN_XIV64: /* 21 */
{
IV64 arg;
BGET_IV64(arg);
- SvIVX(bytecode_sv) = arg;
+ SvIVX(bstate->bs_sv) = arg;
break;
}
- case INSN_XNV: /* 21 */
+ case INSN_XNV: /* 22 */
{
NV arg;
BGET_NV(arg);
- SvNVX(bytecode_sv) = arg;
+ SvNVX(bstate->bs_sv) = arg;
break;
}
- case INSN_XLV_TARGOFF: /* 22 */
+ case INSN_XLV_TARGOFF: /* 23 */
{
STRLEN arg;
BGET_U32(arg);
- LvTARGOFF(bytecode_sv) = arg;
+ LvTARGOFF(bstate->bs_sv) = arg;
break;
}
- case INSN_XLV_TARGLEN: /* 23 */
+ case INSN_XLV_TARGLEN: /* 24 */
{
STRLEN arg;
BGET_U32(arg);
- LvTARGLEN(bytecode_sv) = arg;
+ LvTARGLEN(bstate->bs_sv) = arg;
break;
}
- case INSN_XLV_TARG: /* 24 */
+ case INSN_XLV_TARG: /* 25 */
{
svindex arg;
BGET_svindex(arg);
- LvTARG(bytecode_sv) = arg;
+ LvTARG(bstate->bs_sv) = arg;
break;
}
- case INSN_XLV_TYPE: /* 25 */
+ case INSN_XLV_TYPE: /* 26 */
{
char arg;
BGET_U8(arg);
- LvTYPE(bytecode_sv) = arg;
+ LvTYPE(bstate->bs_sv) = arg;
break;
}
- case INSN_XBM_USEFUL: /* 26 */
+ case INSN_XBM_USEFUL: /* 27 */
{
I32 arg;
BGET_I32(arg);
- BmUSEFUL(bytecode_sv) = arg;
+ BmUSEFUL(bstate->bs_sv) = arg;
break;
}
- case INSN_XBM_PREVIOUS: /* 27 */
+ case INSN_XBM_PREVIOUS: /* 28 */
{
U16 arg;
BGET_U16(arg);
- BmPREVIOUS(bytecode_sv) = arg;
+ BmPREVIOUS(bstate->bs_sv) = arg;
break;
}
- case INSN_XBM_RARE: /* 28 */
+ case INSN_XBM_RARE: /* 29 */
{
U8 arg;
BGET_U8(arg);
- BmRARE(bytecode_sv) = arg;
+ BmRARE(bstate->bs_sv) = arg;
break;
}
- case INSN_XFM_LINES: /* 29 */
+ case INSN_XFM_LINES: /* 30 */
{
I32 arg;
BGET_I32(arg);
- FmLINES(bytecode_sv) = arg;
+ FmLINES(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_LINES: /* 30 */
+ case INSN_XIO_LINES: /* 31 */
{
long arg;
BGET_I32(arg);
- IoLINES(bytecode_sv) = arg;
+ IoLINES(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_PAGE: /* 31 */
+ case INSN_XIO_PAGE: /* 32 */
{
long arg;
BGET_I32(arg);
- IoPAGE(bytecode_sv) = arg;
+ IoPAGE(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_PAGE_LEN: /* 32 */
+ case INSN_XIO_PAGE_LEN: /* 33 */
{
long arg;
BGET_I32(arg);
- IoPAGE_LEN(bytecode_sv) = arg;
+ IoPAGE_LEN(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_LINES_LEFT: /* 33 */
+ case INSN_XIO_LINES_LEFT: /* 34 */
{
long arg;
BGET_I32(arg);
- IoLINES_LEFT(bytecode_sv) = arg;
+ IoLINES_LEFT(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_TOP_NAME: /* 34 */
+ case INSN_XIO_TOP_NAME: /* 36 */
{
pvcontents arg;
BGET_pvcontents(arg);
- IoTOP_NAME(bytecode_sv) = arg;
+ IoTOP_NAME(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_TOP_GV: /* 36 */
+ case INSN_XIO_TOP_GV: /* 37 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&IoTOP_GV(bytecode_sv) = arg;
+ *(SV**)&IoTOP_GV(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_FMT_NAME: /* 37 */
+ case INSN_XIO_FMT_NAME: /* 38 */
{
pvcontents arg;
BGET_pvcontents(arg);
- IoFMT_NAME(bytecode_sv) = arg;
+ IoFMT_NAME(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_FMT_GV: /* 38 */
+ case INSN_XIO_FMT_GV: /* 39 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&IoFMT_GV(bytecode_sv) = arg;
+ *(SV**)&IoFMT_GV(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_BOTTOM_NAME: /* 39 */
+ case INSN_XIO_BOTTOM_NAME: /* 40 */
{
pvcontents arg;
BGET_pvcontents(arg);
- IoBOTTOM_NAME(bytecode_sv) = arg;
+ IoBOTTOM_NAME(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_BOTTOM_GV: /* 40 */
+ case INSN_XIO_BOTTOM_GV: /* 41 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&IoBOTTOM_GV(bytecode_sv) = arg;
+ *(SV**)&IoBOTTOM_GV(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_SUBPROCESS: /* 41 */
+ case INSN_XIO_SUBPROCESS: /* 42 */
{
short arg;
BGET_U16(arg);
- IoSUBPROCESS(bytecode_sv) = arg;
+ IoSUBPROCESS(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_TYPE: /* 42 */
+ case INSN_XIO_TYPE: /* 43 */
{
char arg;
BGET_U8(arg);
- IoTYPE(bytecode_sv) = arg;
+ IoTYPE(bstate->bs_sv) = arg;
break;
}
- case INSN_XIO_FLAGS: /* 43 */
+ case INSN_XIO_FLAGS: /* 44 */
{
char arg;
BGET_U8(arg);
- IoFLAGS(bytecode_sv) = arg;
+ IoFLAGS(bstate->bs_sv) = arg;
break;
}
- case INSN_XCV_STASH: /* 44 */
+ case INSN_XCV_STASH: /* 45 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&CvSTASH(bytecode_sv) = arg;
+ *(SV**)&CvSTASH(bstate->bs_sv) = arg;
break;
}
- case INSN_XCV_START: /* 45 */
+ case INSN_XCV_START: /* 46 */
{
opindex arg;
BGET_opindex(arg);
- CvSTART(bytecode_sv) = arg;
+ CvSTART(bstate->bs_sv) = arg;
break;
}
- case INSN_XCV_ROOT: /* 46 */
+ case INSN_XCV_ROOT: /* 47 */
{
opindex arg;
BGET_opindex(arg);
- CvROOT(bytecode_sv) = arg;
+ CvROOT(bstate->bs_sv) = arg;
break;
}
- case INSN_XCV_GV: /* 47 */
+ case INSN_XCV_GV: /* 48 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&CvGV(bytecode_sv) = arg;
+ *(SV**)&CvGV(bstate->bs_sv) = arg;
break;
}
- case INSN_XCV_FILE: /* 48 */
+ case INSN_XCV_FILE: /* 49 */
{
- pvcontents arg;
- BGET_pvcontents(arg);
- CvFILE(bytecode_sv) = arg;
+ pvindex arg;
+ BGET_pvindex(arg);
+ CvFILE(bstate->bs_sv) = arg;
break;
}
- case INSN_XCV_DEPTH: /* 49 */
+ case INSN_XCV_DEPTH: /* 50 */
{
long arg;
BGET_I32(arg);
- CvDEPTH(bytecode_sv) = arg;
+ CvDEPTH(bstate->bs_sv) = arg;
break;
}
- case INSN_XCV_PADLIST: /* 50 */
+ case INSN_XCV_PADLIST: /* 51 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&CvPADLIST(bytecode_sv) = arg;
+ *(SV**)&CvPADLIST(bstate->bs_sv) = arg;
break;
}
- case INSN_XCV_OUTSIDE: /* 51 */
+ case INSN_XCV_OUTSIDE: /* 52 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&CvOUTSIDE(bytecode_sv) = arg;
+ *(SV**)&CvOUTSIDE(bstate->bs_sv) = arg;
break;
}
- case INSN_XCV_FLAGS: /* 52 */
+ case INSN_XCV_FLAGS: /* 53 */
{
U16 arg;
BGET_U16(arg);
- CvFLAGS(bytecode_sv) = arg;
+ CvFLAGS(bstate->bs_sv) = arg;
break;
}
- case INSN_AV_EXTEND: /* 53 */
+ case INSN_AV_EXTEND: /* 54 */
{
SSize_t arg;
BGET_I32(arg);
- BSET_av_extend(bytecode_sv, arg);
+ BSET_av_extend(bstate->bs_sv, arg);
break;
}
- case INSN_AV_PUSH: /* 54 */
+ case INSN_AV_PUSH: /* 55 */
{
svindex arg;
BGET_svindex(arg);
- BSET_av_push(bytecode_sv, arg);
+ BSET_av_push(bstate->bs_sv, arg);
break;
}
- case INSN_XAV_FILL: /* 55 */
+ case INSN_XAV_FILL: /* 56 */
{
SSize_t arg;
BGET_I32(arg);
- AvFILLp(bytecode_sv) = arg;
+ AvFILLp(bstate->bs_sv) = arg;
break;
}
- case INSN_XAV_MAX: /* 56 */
+ case INSN_XAV_MAX: /* 57 */
{
SSize_t arg;
BGET_I32(arg);
- AvMAX(bytecode_sv) = arg;
+ AvMAX(bstate->bs_sv) = arg;
break;
}
- case INSN_XAV_FLAGS: /* 57 */
+ case INSN_XAV_FLAGS: /* 58 */
{
U8 arg;
BGET_U8(arg);
- AvFLAGS(bytecode_sv) = arg;
+ AvFLAGS(bstate->bs_sv) = arg;
break;
}
- case INSN_XHV_RITER: /* 58 */
+ case INSN_XHV_RITER: /* 59 */
{
I32 arg;
BGET_I32(arg);
- HvRITER(bytecode_sv) = arg;
+ HvRITER(bstate->bs_sv) = arg;
break;
}
- case INSN_XHV_NAME: /* 59 */
+ case INSN_XHV_NAME: /* 60 */
{
pvcontents arg;
BGET_pvcontents(arg);
- HvNAME(bytecode_sv) = arg;
+ HvNAME(bstate->bs_sv) = arg;
break;
}
- case INSN_HV_STORE: /* 60 */
+ case INSN_HV_STORE: /* 61 */
{
svindex arg;
BGET_svindex(arg);
- BSET_hv_store(bytecode_sv, arg);
+ BSET_hv_store(bstate->bs_sv, arg);
break;
}
- case INSN_SV_MAGIC: /* 61 */
+ case INSN_SV_MAGIC: /* 62 */
{
char arg;
BGET_U8(arg);
- BSET_sv_magic(bytecode_sv, arg);
+ BSET_sv_magic(bstate->bs_sv, arg);
break;
}
- case INSN_MG_OBJ: /* 62 */
+ case INSN_MG_OBJ: /* 63 */
{
svindex arg;
BGET_svindex(arg);
- SvMAGIC(bytecode_sv)->mg_obj = arg;
+ SvMAGIC(bstate->bs_sv)->mg_obj = arg;
break;
}
- case INSN_MG_PRIVATE: /* 63 */
+ case INSN_MG_PRIVATE: /* 64 */
{
U16 arg;
BGET_U16(arg);
- SvMAGIC(bytecode_sv)->mg_private = arg;
+ SvMAGIC(bstate->bs_sv)->mg_private = arg;
break;
}
- case INSN_MG_FLAGS: /* 64 */
+ case INSN_MG_FLAGS: /* 65 */
{
U8 arg;
BGET_U8(arg);
- SvMAGIC(bytecode_sv)->mg_flags = arg;
+ SvMAGIC(bstate->bs_sv)->mg_flags = arg;
break;
}
- case INSN_MG_PV: /* 65 */
+ case INSN_MG_PV: /* 66 */
{
pvcontents arg;
BGET_pvcontents(arg);
- BSET_mg_pv(SvMAGIC(bytecode_sv), arg);
+ BSET_mg_pv(SvMAGIC(bstate->bs_sv), arg);
break;
}
- case INSN_XMG_STASH: /* 66 */
+ case INSN_XMG_STASH: /* 67 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&SvSTASH(bytecode_sv) = arg;
+ *(SV**)&SvSTASH(bstate->bs_sv) = arg;
break;
}
- case INSN_GV_FETCHPV: /* 67 */
+ case INSN_GV_FETCHPV: /* 68 */
{
strconst arg;
BGET_strconst(arg);
- BSET_gv_fetchpv(bytecode_sv, arg);
+ BSET_gv_fetchpv(bstate->bs_sv, arg);
break;
}
- case INSN_GV_STASHPV: /* 68 */
+ case INSN_GV_STASHPV: /* 69 */
{
strconst arg;
BGET_strconst(arg);
- BSET_gv_stashpv(bytecode_sv, arg);
+ BSET_gv_stashpv(bstate->bs_sv, arg);
break;
}
- case INSN_GP_SV: /* 69 */
+ case INSN_GP_SV: /* 70 */
{
svindex arg;
BGET_svindex(arg);
- GvSV(bytecode_sv) = arg;
+ GvSV(bstate->bs_sv) = arg;
break;
}
- case INSN_GP_REFCNT: /* 70 */
+ case INSN_GP_REFCNT: /* 71 */
{
U32 arg;
BGET_U32(arg);
- GvREFCNT(bytecode_sv) = arg;
+ GvREFCNT(bstate->bs_sv) = arg;
break;
}
- case INSN_GP_REFCNT_ADD: /* 71 */
+ case INSN_GP_REFCNT_ADD: /* 72 */
{
I32 arg;
BGET_I32(arg);
- BSET_gp_refcnt_add(GvREFCNT(bytecode_sv), arg);
+ BSET_gp_refcnt_add(GvREFCNT(bstate->bs_sv), arg);
break;
}
- case INSN_GP_AV: /* 72 */
+ case INSN_GP_AV: /* 73 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&GvAV(bytecode_sv) = arg;
+ *(SV**)&GvAV(bstate->bs_sv) = arg;
break;
}
- case INSN_GP_HV: /* 73 */
+ case INSN_GP_HV: /* 74 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&GvHV(bytecode_sv) = arg;
+ *(SV**)&GvHV(bstate->bs_sv) = arg;
break;
}
- case INSN_GP_CV: /* 74 */
+ case INSN_GP_CV: /* 75 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&GvCV(bytecode_sv) = arg;
+ *(SV**)&GvCV(bstate->bs_sv) = arg;
break;
}
- case INSN_GP_FILE: /* 75 */
+ case INSN_GP_FILE: /* 76 */
{
- pvcontents arg;
- BGET_pvcontents(arg);
- GvFILE(bytecode_sv) = arg;
+ pvindex arg;
+ BGET_pvindex(arg);
+ GvFILE(bstate->bs_sv) = arg;
break;
}
- case INSN_GP_IO: /* 76 */
+ case INSN_GP_IO: /* 77 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&GvIOp(bytecode_sv) = arg;
+ *(SV**)&GvIOp(bstate->bs_sv) = arg;
break;
}
- case INSN_GP_FORM: /* 77 */
+ case INSN_GP_FORM: /* 78 */
{
svindex arg;
BGET_svindex(arg);
- *(SV**)&GvFORM(bytecode_sv) = arg;
+ *(SV**)&GvFORM(bstate->bs_sv) = arg;
break;
}
- case INSN_GP_CVGEN: /* 78 */
+ case INSN_GP_CVGEN: /* 79 */
{
U32 arg;
BGET_U32(arg);
- GvCVGEN(bytecode_sv) = arg;
+ GvCVGEN(bstate->bs_sv) = arg;
break;
}
- case INSN_GP_LINE: /* 79 */
+ case INSN_GP_LINE: /* 80 */
{
line_t arg;
BGET_U16(arg);
- GvLINE(bytecode_sv) = arg;
+ GvLINE(bstate->bs_sv) = arg;
break;
}
- case INSN_GP_SHARE: /* 80 */
+ case INSN_GP_SHARE: /* 81 */
{
svindex arg;
BGET_svindex(arg);
- BSET_gp_share(bytecode_sv, arg);
+ BSET_gp_share(bstate->bs_sv, arg);
break;
}
- case INSN_XGV_FLAGS: /* 81 */
+ case INSN_XGV_FLAGS: /* 82 */
{
U8 arg;
BGET_U8(arg);
- GvFLAGS(bytecode_sv) = arg;
+ GvFLAGS(bstate->bs_sv) = arg;
break;
}
- case INSN_OP_NEXT: /* 82 */
+ case INSN_OP_NEXT: /* 83 */
{
opindex arg;
BGET_opindex(arg);
PL_op->op_next = arg;
break;
}
- case INSN_OP_SIBLING: /* 83 */
+ case INSN_OP_SIBLING: /* 84 */
{
opindex arg;
BGET_opindex(arg);
PL_op->op_sibling = arg;
break;
}
- case INSN_OP_PPADDR: /* 84 */
+ case INSN_OP_PPADDR: /* 85 */
{
strconst arg;
BGET_strconst(arg);
BSET_op_ppaddr(PL_op->op_ppaddr, arg);
break;
}
- case INSN_OP_TARG: /* 85 */
+ case INSN_OP_TARG: /* 86 */
{
PADOFFSET arg;
BGET_U32(arg);
PL_op->op_targ = arg;
break;
}
- case INSN_OP_TYPE: /* 86 */
+ case INSN_OP_TYPE: /* 87 */
{
OPCODE arg;
BGET_U16(arg);
BSET_op_type(PL_op, arg);
break;
}
- case INSN_OP_SEQ: /* 87 */
+ case INSN_OP_SEQ: /* 88 */
{
U16 arg;
BGET_U16(arg);
PL_op->op_seq = arg;
break;
}
- case INSN_OP_FLAGS: /* 88 */
+ case INSN_OP_FLAGS: /* 89 */
{
U8 arg;
BGET_U8(arg);
PL_op->op_flags = arg;
break;
}
- case INSN_OP_PRIVATE: /* 89 */
+ case INSN_OP_PRIVATE: /* 90 */
{
U8 arg;
BGET_U8(arg);
PL_op->op_private = arg;
break;
}
- case INSN_OP_FIRST: /* 90 */
+ case INSN_OP_FIRST: /* 91 */
{
opindex arg;
BGET_opindex(arg);
cUNOP->op_first = arg;
break;
}
- case INSN_OP_LAST: /* 91 */
+ case INSN_OP_LAST: /* 92 */
{
opindex arg;
BGET_opindex(arg);
cBINOP->op_last = arg;
break;
}
- case INSN_OP_OTHER: /* 92 */
+ case INSN_OP_OTHER: /* 93 */
{
opindex arg;
BGET_opindex(arg);
cLOGOP->op_other = arg;
break;
}
- case INSN_OP_CHILDREN: /* 93 */
+ case INSN_OP_CHILDREN: /* 94 */
{
U32 arg;
BGET_U32(arg);
cLISTOP->op_children = arg;
break;
}
- case INSN_OP_PMREPLROOT: /* 94 */
+ case INSN_OP_PMREPLROOT: /* 95 */
{
opindex arg;
BGET_opindex(arg);
cPMOP->op_pmreplroot = arg;
break;
}
- case INSN_OP_PMREPLROOTGV: /* 95 */
+ case INSN_OP_PMREPLROOTGV: /* 96 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&cPMOP->op_pmreplroot = arg;
break;
}
- case INSN_OP_PMREPLSTART: /* 96 */
+ case INSN_OP_PMREPLSTART: /* 97 */
{
opindex arg;
BGET_opindex(arg);
cPMOP->op_pmreplstart = arg;
break;
}
- case INSN_OP_PMNEXT: /* 97 */
+ case INSN_OP_PMNEXT: /* 98 */
{
opindex arg;
BGET_opindex(arg);
*(OP**)&cPMOP->op_pmnext = arg;
break;
}
- case INSN_PREGCOMP: /* 98 */
+ case INSN_PREGCOMP: /* 99 */
{
pvcontents arg;
BGET_pvcontents(arg);
BSET_pregcomp(PL_op, arg);
break;
}
- case INSN_OP_PMFLAGS: /* 99 */
+ case INSN_OP_PMFLAGS: /* 100 */
{
U16 arg;
BGET_U16(arg);
cPMOP->op_pmflags = arg;
break;
}
- case INSN_OP_PMPERMFLAGS: /* 100 */
+ case INSN_OP_PMPERMFLAGS: /* 101 */
{
U16 arg;
BGET_U16(arg);
cPMOP->op_pmpermflags = arg;
break;
}
- case INSN_OP_SV: /* 101 */
+ case INSN_OP_SV: /* 102 */
{
svindex arg;
BGET_svindex(arg);
cSVOP->op_sv = arg;
break;
}
- case INSN_OP_PADIX: /* 102 */
+ case INSN_OP_PADIX: /* 103 */
{
PADOFFSET arg;
BGET_U32(arg);
cPADOP->op_padix = arg;
break;
}
- case INSN_OP_PV: /* 103 */
+ case INSN_OP_PV: /* 104 */
{
pvcontents arg;
BGET_pvcontents(arg);
cPVOP->op_pv = arg;
break;
}
- case INSN_OP_PV_TR: /* 104 */
+ case INSN_OP_PV_TR: /* 105 */
{
op_tr_array arg;
BGET_op_tr_array(arg);
cPVOP->op_pv = arg;
break;
}
- case INSN_OP_REDOOP: /* 105 */
+ case INSN_OP_REDOOP: /* 106 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_redoop = arg;
break;
}
- case INSN_OP_NEXTOP: /* 106 */
+ case INSN_OP_NEXTOP: /* 107 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_nextop = arg;
break;
}
- case INSN_OP_LASTOP: /* 107 */
+ case INSN_OP_LASTOP: /* 108 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_lastop = arg;
break;
}
- case INSN_COP_LABEL: /* 108 */
+ case INSN_COP_LABEL: /* 109 */
{
- pvcontents arg;
- BGET_pvcontents(arg);
+ pvindex arg;
+ BGET_pvindex(arg);
cCOP->cop_label = arg;
break;
}
- case INSN_COP_STASHPV: /* 109 */
+ case INSN_COP_STASHPV: /* 110 */
{
- pvcontents arg;
- BGET_pvcontents(arg);
+ pvindex arg;
+ BGET_pvindex(arg);
BSET_cop_stashpv(cCOP, arg);
break;
}
- case INSN_COP_FILE: /* 110 */
+ case INSN_COP_FILE: /* 111 */
{
- pvcontents arg;
- BGET_pvcontents(arg);
+ pvindex arg;
+ BGET_pvindex(arg);
BSET_cop_file(cCOP, arg);
break;
}
- case INSN_COP_SEQ: /* 111 */
+ case INSN_COP_SEQ: /* 112 */
{
U32 arg;
BGET_U32(arg);
cCOP->cop_seq = arg;
break;
}
- case INSN_COP_ARYBASE: /* 112 */
+ case INSN_COP_ARYBASE: /* 113 */
{
I32 arg;
BGET_I32(arg);
cCOP->cop_arybase = arg;
break;
}
- case INSN_COP_LINE: /* 113 */
+ case INSN_COP_LINE: /* 114 */
{
line_t arg;
BGET_U16(arg);
BSET_cop_line(cCOP, arg);
break;
}
- case INSN_COP_WARNINGS: /* 114 */
+ case INSN_COP_WARNINGS: /* 115 */
{
svindex arg;
BGET_svindex(arg);
cCOP->cop_warnings = arg;
break;
}
- case INSN_MAIN_START: /* 115 */
+ case INSN_MAIN_START: /* 116 */
{
opindex arg;
BGET_opindex(arg);
PL_main_start = arg;
break;
}
- case INSN_MAIN_ROOT: /* 116 */
+ case INSN_MAIN_ROOT: /* 117 */
{
opindex arg;
BGET_opindex(arg);
PL_main_root = arg;
break;
}
- case INSN_CURPAD: /* 117 */
+ case INSN_CURPAD: /* 118 */
{
svindex arg;
BGET_svindex(arg);
BSET_curpad(PL_curpad, arg);
break;
}
+ case INSN_PUSH_BEGIN: /* 119 */
+ {
+ svindex arg;
+ BGET_svindex(arg);
+ BSET_push_begin(PL_beginav, arg);
+ break;
+ }
+ case INSN_PUSH_INIT: /* 120 */
+ {
+ svindex arg;
+ BGET_svindex(arg);
+ BSET_push_init(PL_initav, arg);
+ break;
+ }
+ case INSN_PUSH_END: /* 121 */
+ {
+ svindex arg;
+ BGET_svindex(arg);
+ BSET_push_end(PL_endav, arg);
+ break;
+ }
default:
Perl_croak(aTHX_ "Illegal bytecode instruction %d\n", insn);
/* NOTREACHED */
diff --git a/ext/ByteLoader/byterun.h b/ext/ByteLoader/byterun.h
index f0de6b4820..1e67b8967e 100644
--- a/ext/ByteLoader/byterun.h
+++ b/ext/ByteLoader/byterun.h
@@ -8,133 +8,149 @@
/*
* This file is autogenerated from bytecode.pl. Changes made here will be lost.
*/
-struct bytestream {
- void *data;
- int (*pfgetc)(void *);
- int (*pfread)(char *, size_t, size_t, void *);
- void (*pfreadpv)(U32, void *, XPV *);
+struct byteloader_fdata {
+ SV *datasv;
+ int next_out;
+ int idx;
};
+struct byteloader_state {
+ struct byteloader_fdata *bs_fdata;
+ SV *bs_sv;
+ void **bs_obj_list;
+ int bs_obj_list_fill;
+ XPV bs_pv;
+ int bs_iv_overflows;
+};
+
+int bl_getc(struct byteloader_fdata *);
+int bl_read(struct byteloader_fdata *, char *, size_t, size_t);
+extern void byterun(pTHXo_ struct byteloader_state *);
+
enum {
INSN_RET, /* 0 */
INSN_LDSV, /* 1 */
INSN_LDOP, /* 2 */
INSN_STSV, /* 3 */
INSN_STOP, /* 4 */
- INSN_LDSPECSV, /* 5 */
- INSN_NEWSV, /* 6 */
- INSN_NEWOP, /* 7 */
- INSN_NEWOPN, /* 8 */
- INSN_NEWPV, /* 9 */
+ INSN_STPV, /* 5 */
+ INSN_LDSPECSV, /* 6 */
+ INSN_NEWSV, /* 7 */
+ INSN_NEWOP, /* 8 */
+ INSN_NEWOPN, /* 9 */
INSN_NOP, /* 10 */
- INSN_PV_CUR, /* 11 */
- INSN_PV_FREE, /* 12 */
- INSN_SV_UPGRADE, /* 13 */
- INSN_SV_REFCNT, /* 14 */
- INSN_SV_REFCNT_ADD, /* 15 */
- INSN_SV_FLAGS, /* 16 */
- INSN_XRV, /* 17 */
- INSN_XPV, /* 18 */
- INSN_XIV32, /* 19 */
- INSN_XIV64, /* 20 */
- INSN_XNV, /* 21 */
- INSN_XLV_TARGOFF, /* 22 */
- INSN_XLV_TARGLEN, /* 23 */
- INSN_XLV_TARG, /* 24 */
- INSN_XLV_TYPE, /* 25 */
- INSN_XBM_USEFUL, /* 26 */
- INSN_XBM_PREVIOUS, /* 27 */
- INSN_XBM_RARE, /* 28 */
- INSN_XFM_LINES, /* 29 */
- INSN_XIO_LINES, /* 30 */
- INSN_XIO_PAGE, /* 31 */
- INSN_XIO_PAGE_LEN, /* 32 */
- INSN_XIO_LINES_LEFT, /* 33 */
- INSN_XIO_TOP_NAME, /* 34 */
+ INSN_NEWPV, /* 11 */
+ INSN_PV_CUR, /* 12 */
+ INSN_PV_FREE, /* 13 */
+ INSN_SV_UPGRADE, /* 14 */
+ INSN_SV_REFCNT, /* 15 */
+ INSN_SV_REFCNT_ADD, /* 16 */
+ INSN_SV_FLAGS, /* 17 */
+ INSN_XRV, /* 18 */
+ INSN_XPV, /* 19 */
+ INSN_XIV32, /* 20 */
+ INSN_XIV64, /* 21 */
+ INSN_XNV, /* 22 */
+ INSN_XLV_TARGOFF, /* 23 */
+ INSN_XLV_TARGLEN, /* 24 */
+ INSN_XLV_TARG, /* 25 */
+ INSN_XLV_TYPE, /* 26 */
+ INSN_XBM_USEFUL, /* 27 */
+ INSN_XBM_PREVIOUS, /* 28 */
+ INSN_XBM_RARE, /* 29 */
+ INSN_XFM_LINES, /* 30 */
+ INSN_XIO_LINES, /* 31 */
+ INSN_XIO_PAGE, /* 32 */
+ INSN_XIO_PAGE_LEN, /* 33 */
+ INSN_XIO_LINES_LEFT, /* 34 */
INSN_COMMENT, /* 35 */
- INSN_XIO_TOP_GV, /* 36 */
- INSN_XIO_FMT_NAME, /* 37 */
- INSN_XIO_FMT_GV, /* 38 */
- INSN_XIO_BOTTOM_NAME, /* 39 */
- INSN_XIO_BOTTOM_GV, /* 40 */
- INSN_XIO_SUBPROCESS, /* 41 */
- INSN_XIO_TYPE, /* 42 */
- INSN_XIO_FLAGS, /* 43 */
- INSN_XCV_STASH, /* 44 */
- INSN_XCV_START, /* 45 */
- INSN_XCV_ROOT, /* 46 */
- INSN_XCV_GV, /* 47 */
- INSN_XCV_FILE, /* 48 */
- INSN_XCV_DEPTH, /* 49 */
- INSN_XCV_PADLIST, /* 50 */
- INSN_XCV_OUTSIDE, /* 51 */
- INSN_XCV_FLAGS, /* 52 */
- INSN_AV_EXTEND, /* 53 */
- INSN_AV_PUSH, /* 54 */
- INSN_XAV_FILL, /* 55 */
- INSN_XAV_MAX, /* 56 */
- INSN_XAV_FLAGS, /* 57 */
- INSN_XHV_RITER, /* 58 */
- INSN_XHV_NAME, /* 59 */
- INSN_HV_STORE, /* 60 */
- INSN_SV_MAGIC, /* 61 */
- INSN_MG_OBJ, /* 62 */
- INSN_MG_PRIVATE, /* 63 */
- INSN_MG_FLAGS, /* 64 */
- INSN_MG_PV, /* 65 */
- INSN_XMG_STASH, /* 66 */
- INSN_GV_FETCHPV, /* 67 */
- INSN_GV_STASHPV, /* 68 */
- INSN_GP_SV, /* 69 */
- INSN_GP_REFCNT, /* 70 */
- INSN_GP_REFCNT_ADD, /* 71 */
- INSN_GP_AV, /* 72 */
- INSN_GP_HV, /* 73 */
- INSN_GP_CV, /* 74 */
- INSN_GP_FILE, /* 75 */
- INSN_GP_IO, /* 76 */
- INSN_GP_FORM, /* 77 */
- INSN_GP_CVGEN, /* 78 */
- INSN_GP_LINE, /* 79 */
- INSN_GP_SHARE, /* 80 */
- INSN_XGV_FLAGS, /* 81 */
- INSN_OP_NEXT, /* 82 */
- INSN_OP_SIBLING, /* 83 */
- INSN_OP_PPADDR, /* 84 */
- INSN_OP_TARG, /* 85 */
- INSN_OP_TYPE, /* 86 */
- INSN_OP_SEQ, /* 87 */
- INSN_OP_FLAGS, /* 88 */
- INSN_OP_PRIVATE, /* 89 */
- INSN_OP_FIRST, /* 90 */
- INSN_OP_LAST, /* 91 */
- INSN_OP_OTHER, /* 92 */
- INSN_OP_CHILDREN, /* 93 */
- INSN_OP_PMREPLROOT, /* 94 */
- INSN_OP_PMREPLROOTGV, /* 95 */
- INSN_OP_PMREPLSTART, /* 96 */
- INSN_OP_PMNEXT, /* 97 */
- INSN_PREGCOMP, /* 98 */
- INSN_OP_PMFLAGS, /* 99 */
- INSN_OP_PMPERMFLAGS, /* 100 */
- INSN_OP_SV, /* 101 */
- INSN_OP_PADIX, /* 102 */
- INSN_OP_PV, /* 103 */
- INSN_OP_PV_TR, /* 104 */
- INSN_OP_REDOOP, /* 105 */
- INSN_OP_NEXTOP, /* 106 */
- INSN_OP_LASTOP, /* 107 */
- INSN_COP_LABEL, /* 108 */
- INSN_COP_STASHPV, /* 109 */
- INSN_COP_FILE, /* 110 */
- INSN_COP_SEQ, /* 111 */
- INSN_COP_ARYBASE, /* 112 */
- INSN_COP_LINE, /* 113 */
- INSN_COP_WARNINGS, /* 114 */
- INSN_MAIN_START, /* 115 */
- INSN_MAIN_ROOT, /* 116 */
- INSN_CURPAD, /* 117 */
- MAX_INSN = 117
+ INSN_XIO_TOP_NAME, /* 36 */
+ INSN_XIO_TOP_GV, /* 37 */
+ INSN_XIO_FMT_NAME, /* 38 */
+ INSN_XIO_FMT_GV, /* 39 */
+ INSN_XIO_BOTTOM_NAME, /* 40 */
+ INSN_XIO_BOTTOM_GV, /* 41 */
+ INSN_XIO_SUBPROCESS, /* 42 */
+ INSN_XIO_TYPE, /* 43 */
+ INSN_XIO_FLAGS, /* 44 */
+ INSN_XCV_STASH, /* 45 */
+ INSN_XCV_START, /* 46 */
+ INSN_XCV_ROOT, /* 47 */
+ INSN_XCV_GV, /* 48 */
+ INSN_XCV_FILE, /* 49 */
+ INSN_XCV_DEPTH, /* 50 */
+ INSN_XCV_PADLIST, /* 51 */
+ INSN_XCV_OUTSIDE, /* 52 */
+ INSN_XCV_FLAGS, /* 53 */
+ INSN_AV_EXTEND, /* 54 */
+ INSN_AV_PUSH, /* 55 */
+ INSN_XAV_FILL, /* 56 */
+ INSN_XAV_MAX, /* 57 */
+ INSN_XAV_FLAGS, /* 58 */
+ INSN_XHV_RITER, /* 59 */
+ INSN_XHV_NAME, /* 60 */
+ INSN_HV_STORE, /* 61 */
+ INSN_SV_MAGIC, /* 62 */
+ INSN_MG_OBJ, /* 63 */
+ INSN_MG_PRIVATE, /* 64 */
+ INSN_MG_FLAGS, /* 65 */
+ INSN_MG_PV, /* 66 */
+ INSN_XMG_STASH, /* 67 */
+ INSN_GV_FETCHPV, /* 68 */
+ INSN_GV_STASHPV, /* 69 */
+ INSN_GP_SV, /* 70 */
+ INSN_GP_REFCNT, /* 71 */
+ INSN_GP_REFCNT_ADD, /* 72 */
+ INSN_GP_AV, /* 73 */
+ INSN_GP_HV, /* 74 */
+ INSN_GP_CV, /* 75 */
+ INSN_GP_FILE, /* 76 */
+ INSN_GP_IO, /* 77 */
+ INSN_GP_FORM, /* 78 */
+ INSN_GP_CVGEN, /* 79 */
+ INSN_GP_LINE, /* 80 */
+ INSN_GP_SHARE, /* 81 */
+ INSN_XGV_FLAGS, /* 82 */
+ INSN_OP_NEXT, /* 83 */
+ INSN_OP_SIBLING, /* 84 */
+ INSN_OP_PPADDR, /* 85 */
+ INSN_OP_TARG, /* 86 */
+ INSN_OP_TYPE, /* 87 */
+ INSN_OP_SEQ, /* 88 */
+ INSN_OP_FLAGS, /* 89 */
+ INSN_OP_PRIVATE, /* 90 */
+ INSN_OP_FIRST, /* 91 */
+ INSN_OP_LAST, /* 92 */
+ INSN_OP_OTHER, /* 93 */
+ INSN_OP_CHILDREN, /* 94 */
+ INSN_OP_PMREPLROOT, /* 95 */
+ INSN_OP_PMREPLROOTGV, /* 96 */
+ INSN_OP_PMREPLSTART, /* 97 */
+ INSN_OP_PMNEXT, /* 98 */
+ INSN_PREGCOMP, /* 99 */
+ INSN_OP_PMFLAGS, /* 100 */
+ INSN_OP_PMPERMFLAGS, /* 101 */
+ INSN_OP_SV, /* 102 */
+ INSN_OP_PADIX, /* 103 */
+ INSN_OP_PV, /* 104 */
+ INSN_OP_PV_TR, /* 105 */
+ INSN_OP_REDOOP, /* 106 */
+ INSN_OP_NEXTOP, /* 107 */
+ INSN_OP_LASTOP, /* 108 */
+ INSN_COP_LABEL, /* 109 */
+ INSN_COP_STASHPV, /* 110 */
+ INSN_COP_FILE, /* 111 */
+ INSN_COP_SEQ, /* 112 */
+ INSN_COP_ARYBASE, /* 113 */
+ INSN_COP_LINE, /* 114 */
+ INSN_COP_WARNINGS, /* 115 */
+ INSN_MAIN_START, /* 116 */
+ INSN_MAIN_ROOT, /* 117 */
+ INSN_CURPAD, /* 118 */
+ INSN_PUSH_BEGIN, /* 119 */
+ INSN_PUSH_INIT, /* 120 */
+ INSN_PUSH_END, /* 121 */
+ MAX_INSN = 121
};
enum {
@@ -151,11 +167,3 @@ enum {
OPt_COP /* 10 */
};
-extern void byterun(pTHXo_ struct bytestream bs);
-
-#define INIT_SPECIALSV_LIST STMT_START { \
- PL_specialsv_list[0] = Nullsv; \
- PL_specialsv_list[1] = &PL_sv_undef; \
- PL_specialsv_list[2] = &PL_sv_yes; \
- PL_specialsv_list[3] = &PL_sv_no; \
- } STMT_END
diff --git a/intrpvar.h b/intrpvar.h
index f84de796c7..07ec33ede6 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -443,6 +443,7 @@ PERLVAR(IProc, struct IPerlProc*)
#if defined(USE_ITHREADS)
PERLVAR(Iptr_table, PTR_TBL_t*)
#endif
+PERLVARI(Ibeginav_save, AV*, Nullav) /* save BEGIN{}s when compiling */
#ifdef USE_THREADS
PERLVAR(Ifdpid_mutex, perl_mutex) /* mutex for fdpid array */
diff --git a/perl.c b/perl.c
index 197e737274..89e6429f17 100644
--- a/perl.c
+++ b/perl.c
@@ -3685,7 +3685,14 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
while (AvFILL(paramList) >= 0) {
cv = (CV*)av_shift(paramList);
- SAVEFREESV(cv);
+ if ((PL_minus_c & 0x10) && (paramList == PL_beginav)) {
+ /* save PL_beginav for compiler */
+ if (! PL_beginav_save)
+ PL_beginav_save = newAV();
+ av_push(PL_beginav_save, (SV*)cv);
+ } else {
+ SAVEFREESV(cv);
+ }
#ifdef PERL_FLEXIBLE_EXCEPTIONS
CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_list_body), cv);
#else
diff --git a/perlapi.h b/perlapi.h
index c57d5754b2..4a95fbb0cc 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -130,6 +130,8 @@ START_EXTERN_C
#define PL_basetime (*Perl_Ibasetime_ptr(aTHXo))
#undef PL_beginav
#define PL_beginav (*Perl_Ibeginav_ptr(aTHXo))
+#undef PL_beginav_save
+#define PL_beginav_save (*Perl_Ibeginav_save_ptr(aTHXo))
#undef PL_bitcount
#define PL_bitcount (*Perl_Ibitcount_ptr(aTHXo))
#undef PL_bufend
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index b6935b2699..455e0c8f1a 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -311,6 +311,12 @@ UNIVERSAL::isa no longer caches methods incorrectly.
The Emacs perl mode (emacs/cperl-mode.el) has been updated to version 4.31.
+=head2 perlbc "activated"
+
+The long-dormant perl bytecompiler has been added to the list of
+installed utilities since the bytecompiler backend has been improved.
+The bytecompiler is still very much experimental, though.
+
=head2 perlbug
Perlbug is now much more robust. It also sends the bug report to perl.org,
View Lorry Controller Status