op_ppaddr PL_op->op_ppaddr strconst x
op_targ PL_op->op_targ PADOFFSET
op_type PL_op OPCODE x
-op_seq PL_op->op_seq U16
+op_opt PL_op->op_opt U8
+op_static PL_op->op_static U8
op_flags PL_op->op_flags U8
op_private PL_op->op_private U8
op_first cUNOP->op_first opindex
#include "perl.h"
#include "regcomp.h"
+static HV *Sequence;
+
void
Perl_dump_indent(pTHX_ I32 level, PerlIO *file, const char* pat, ...)
{
do_pmop_dump(0, Perl_debug_log, pm);
}
+/* An op sequencer. We visit the ops in the order they're to execute. */
+
+STATIC void
+sequence(pTHX_ register OP *o)
+{
+ SV *op;
+ char *key;
+ STRLEN len;
+ static UV seq;
+ OP *oldop = 0,
+ *l;
+
+ if (!Sequence)
+ Sequence = newHV();
+
+ if (!o)
+ return;
+
+ op = newSVuv((UV) o);
+ key = SvPV(op, len);
+ if (hv_exists(Sequence, key, len))
+ return;
+
+ for (; o; o = o->op_next) {
+ op = newSVuv((UV) o);
+ key = SvPV(op, len);
+ if (hv_exists(Sequence, key, len))
+ break;
+
+ switch (o->op_type) {
+ case OP_STUB:
+ if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
+ hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ break;
+ }
+ goto nothin;
+ case OP_NULL:
+ if (oldop && o->op_next)
+ continue;
+ break;
+ case OP_SCALAR:
+ case OP_LINESEQ:
+ case OP_SCOPE:
+ nothin:
+ if (oldop && o->op_next)
+ continue;
+ hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ break;
+
+ case OP_MAPWHILE:
+ case OP_GREPWHILE:
+ case OP_AND:
+ case OP_OR:
+ case OP_DOR:
+ case OP_ANDASSIGN:
+ case OP_ORASSIGN:
+ case OP_DORASSIGN:
+ case OP_COND_EXPR:
+ case OP_RANGE:
+ hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ for (l = cLOGOPo->op_other; l->op_type == OP_NULL; l = l->op_next)
+ ;
+ sequence(aTHX_ l);
+ break;
+
+ case OP_ENTERLOOP:
+ case OP_ENTERITER:
+ hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ for (l = cLOOPo->op_redoop; l->op_type == OP_NULL; l = l->op_next)
+ ;
+ sequence(aTHX_ l);
+ for (l = cLOOPo->op_nextop; l->op_type == OP_NULL; l = l->op_next)
+ ;
+ sequence(aTHX_ l);
+ for (l = cLOOPo->op_lastop; l->op_type == OP_NULL; l = l->op_next)
+ ;
+ sequence(aTHX_ l);
+ break;
+
+ case OP_QR:
+ case OP_MATCH:
+ case OP_SUBST:
+ hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ for (l = cPMOPo->op_pmreplstart; l->op_type == OP_NULL; l = l->op_next)
+ ;
+ sequence(aTHX_ l);
+ break;
+
+ case OP_HELEM:
+ break;
+
+ default:
+ hv_store(Sequence, key, len, newSVuv(++seq), 0);
+ break;
+ }
+ oldop = o;
+ }
+}
+
+STATIC UV
+sequence_num(pTHX_ OP *o)
+{
+ SV *op,
+ **seq;
+ char *key;
+ STRLEN len;
+ if (!o) return 0;
+ op = newSVuv((UV) o);
+ key = SvPV(op, len);
+ seq = hv_fetch(Sequence, key, len, 0);
+ return seq ? SvUV(*seq): 0;
+}
+
void
Perl_do_op_dump(pTHX_ I32 level, PerlIO *file, OP *o)
{
+ UV seq;
+ sequence(aTHX_ o);
Perl_dump_indent(aTHX_ level, file, "{\n");
level++;
- if (o->op_seq)
- PerlIO_printf(file, "%-4d", o->op_seq);
+ seq = sequence_num(aTHX_ o);
+ if (seq)
+ PerlIO_printf(file, "%-4d", seq);
else
PerlIO_printf(file, " ");
PerlIO_printf(file,
"%*sTYPE = %s ===> ",
(int)(PL_dumpindent*level-4), "", OP_NAME(o));
- if (o->op_next) {
- if (o->op_seq)
- PerlIO_printf(file, "%d\n", o->op_next->op_seq);
- else
- PerlIO_printf(file, "(%d)\n", o->op_next->op_seq);
- }
+ if (o->op_next)
+ PerlIO_printf(file, seq ? "%d\n" : "(%d)\n", sequence_num(aTHX_ o->op_next));
else
PerlIO_printf(file, "DONE\n");
if (o->op_targ) {
case OP_ENTERLOOP:
Perl_dump_indent(aTHX_ level, file, "REDO ===> ");
if (cLOOPo->op_redoop)
- PerlIO_printf(file, "%d\n", cLOOPo->op_redoop->op_seq);
+ PerlIO_printf(file, "%d\n", sequence_num(aTHX_ cLOOPo->op_redoop));
else
PerlIO_printf(file, "DONE\n");
Perl_dump_indent(aTHX_ level, file, "NEXT ===> ");
if (cLOOPo->op_nextop)
- PerlIO_printf(file, "%d\n", cLOOPo->op_nextop->op_seq);
+ PerlIO_printf(file, "%d\n", sequence_num(aTHX_ cLOOPo->op_nextop));
else
PerlIO_printf(file, "DONE\n");
Perl_dump_indent(aTHX_ level, file, "LAST ===> ");
if (cLOOPo->op_lastop)
- PerlIO_printf(file, "%d\n", cLOOPo->op_lastop->op_seq);
+ PerlIO_printf(file, "%d\n", sequence_num(aTHX_ cLOOPo->op_lastop));
else
PerlIO_printf(file, "DONE\n");
break;
case OP_AND:
Perl_dump_indent(aTHX_ level, file, "OTHER ===> ");
if (cLOGOPo->op_other)
- PerlIO_printf(file, "%d\n", cLOGOPo->op_other->op_seq);
+ PerlIO_printf(file, "%d\n", sequence_num(aTHX_ cLOGOPo->op_other));
else
PerlIO_printf(file, "DONE\n");
break;
case SVt_PVFM:
do_hv_dump(level, file, " COMP_STASH", CvSTASH(sv));
if (CvSTART(sv))
- Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)CvSTART(sv)->op_seq);
+ Perl_dump_indent(aTHX_ level, file, " START = 0x%"UVxf" ===> %"IVdf"\n", PTR2UV(CvSTART(sv)), (IV)sequence_num(aTHX_ CvSTART(sv)));
Perl_dump_indent(aTHX_ level, file, " ROOT = 0x%"UVxf"\n", PTR2UV(CvROOT(sv)));
if (CvROOT(sv) && dumpops)
do_op_dump(level+1, file, CvROOT(sv));
#define ck_sort Perl_ck_sort
#define ck_spair Perl_ck_spair
#define ck_split Perl_ck_split
+#define ck_state Perl_ck_state
#define ck_subr Perl_ck_subr
#define ck_substr Perl_ck_substr
#define ck_svconst Perl_ck_svconst
#define ck_sort(a) Perl_ck_sort(aTHX_ a)
#define ck_spair(a) Perl_ck_spair(aTHX_ a)
#define ck_split(a) Perl_ck_split(aTHX_ a)
+#define ck_state(a) Perl_ck_state(aTHX_ a)
#define ck_subr(a) Perl_ck_subr(aTHX_ a)
#define ck_substr(a) Perl_ck_substr(aTHX_ a)
#define ck_svconst(a) Perl_ck_svconst(aTHX_ a)
#define PL_oldname (vTHX->Ioldname)
#define PL_oldoldbufptr (vTHX->Ioldoldbufptr)
#define PL_op_mask (vTHX->Iop_mask)
-#define PL_op_seqmax (vTHX->Iop_seqmax)
#define PL_origalen (vTHX->Iorigalen)
#define PL_origargc (vTHX->Iorigargc)
#define PL_origargv (vTHX->Iorigargv)
#define PL_Ioldname PL_oldname
#define PL_Ioldoldbufptr PL_oldoldbufptr
#define PL_Iop_mask PL_op_mask
-#define PL_Iop_seqmax PL_op_seqmax
#define PL_Iorigalen PL_origalen
#define PL_Iorigargc PL_origargc
#define PL_Iorigargv PL_origargv
{
for(; o; o = o->op_next) {
SV *opsv;
- if (o->op_seq == 0)
+ if (o->op_opt == 0)
break;
- o->op_seq = 0;
+ o->op_opt = 0;
opsv = sv_newmortal();
sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ (OP*)o)), PTR2IV(o));
XPUSHs(opsv);
#define OP_desc(o) PL_op_desc[o->op_type]
#define OP_targ(o) o->op_targ
#define OP_type(o) o->op_type
-#define OP_seq(o) o->op_seq
+#define OP_opt(o) o->op_opt
+#define OP_static(o) o->op_static
#define OP_flags(o) o->op_flags
#define OP_private(o) o->op_private
OP_type(o)
B::OP o
-U16
-OP_seq(o)
+U8
+OP_opt(o)
+ B::OP o
+
+U8
+OP_static(o)
B::OP o
U8
$insn_data{op_ppaddr} = [96, \&PUT_strconst, "GET_strconst"];
$insn_data{op_targ} = [97, \&PUT_PADOFFSET, "GET_PADOFFSET"];
$insn_data{op_type} = [98, \&PUT_U16, "GET_U16"];
-$insn_data{op_seq} = [99, \&PUT_U16, "GET_U16"];
-$insn_data{op_flags} = [100, \&PUT_U8, "GET_U8"];
-$insn_data{op_private} = [101, \&PUT_U8, "GET_U8"];
-$insn_data{op_first} = [102, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_last} = [103, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_other} = [104, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_pmreplroot} = [105, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_pmreplstart} = [106, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_pmnext} = [107, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_pmstashpv} = [108, \&PUT_pvindex, "GET_pvindex"];
-$insn_data{op_pmreplrootpo} = [109, \&PUT_PADOFFSET, "GET_PADOFFSET"];
-$insn_data{op_pmstash} = [110, \&PUT_svindex, "GET_svindex"];
-$insn_data{op_pmreplrootgv} = [111, \&PUT_svindex, "GET_svindex"];
-$insn_data{pregcomp} = [112, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{op_pmflags} = [113, \&PUT_U16, "GET_U16"];
-$insn_data{op_pmpermflags} = [114, \&PUT_U16, "GET_U16"];
-$insn_data{op_pmdynflags} = [115, \&PUT_U8, "GET_U8"];
-$insn_data{op_sv} = [116, \&PUT_svindex, "GET_svindex"];
-$insn_data{op_padix} = [117, \&PUT_PADOFFSET, "GET_PADOFFSET"];
-$insn_data{op_pv} = [118, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{op_pv_tr} = [119, \&PUT_op_tr_array, "GET_op_tr_array"];
-$insn_data{op_redoop} = [120, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_nextop} = [121, \&PUT_opindex, "GET_opindex"];
-$insn_data{op_lastop} = [122, \&PUT_opindex, "GET_opindex"];
-$insn_data{cop_label} = [123, \&PUT_pvindex, "GET_pvindex"];
-$insn_data{cop_stashpv} = [124, \&PUT_pvindex, "GET_pvindex"];
-$insn_data{cop_file} = [125, \&PUT_pvindex, "GET_pvindex"];
-$insn_data{cop_stash} = [126, \&PUT_svindex, "GET_svindex"];
-$insn_data{cop_filegv} = [127, \&PUT_svindex, "GET_svindex"];
-$insn_data{cop_seq} = [128, \&PUT_U32, "GET_U32"];
-$insn_data{cop_arybase} = [129, \&PUT_I32, "GET_I32"];
-$insn_data{cop_line} = [130, \&PUT_U32, "GET_U32"];
-$insn_data{cop_io} = [131, \&PUT_svindex, "GET_svindex"];
-$insn_data{cop_warnings} = [132, \&PUT_svindex, "GET_svindex"];
-$insn_data{main_start} = [133, \&PUT_opindex, "GET_opindex"];
-$insn_data{main_root} = [134, \&PUT_opindex, "GET_opindex"];
-$insn_data{main_cv} = [135, \&PUT_svindex, "GET_svindex"];
-$insn_data{curpad} = [136, \&PUT_svindex, "GET_svindex"];
-$insn_data{push_begin} = [137, \&PUT_svindex, "GET_svindex"];
-$insn_data{push_init} = [138, \&PUT_svindex, "GET_svindex"];
-$insn_data{push_end} = [139, \&PUT_svindex, "GET_svindex"];
-$insn_data{curstash} = [140, \&PUT_svindex, "GET_svindex"];
-$insn_data{defstash} = [141, \&PUT_svindex, "GET_svindex"];
-$insn_data{data} = [142, \&PUT_U8, "GET_U8"];
-$insn_data{incav} = [143, \&PUT_svindex, "GET_svindex"];
-$insn_data{load_glob} = [144, \&PUT_svindex, "GET_svindex"];
-$insn_data{regex_padav} = [145, \&PUT_svindex, "GET_svindex"];
-$insn_data{dowarn} = [146, \&PUT_U8, "GET_U8"];
-$insn_data{comppad_name} = [147, \&PUT_svindex, "GET_svindex"];
-$insn_data{xgv_stash} = [148, \&PUT_svindex, "GET_svindex"];
-$insn_data{signal} = [149, \&PUT_strconst, "GET_strconst"];
-$insn_data{formfeed} = [150, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_opt} = [99, \&PUT_U8, "GET_U8"];
+$insn_data{op_static} = [100, \&PUT_U8, "GET_U8"];
+$insn_data{op_flags} = [101, \&PUT_U8, "GET_U8"];
+$insn_data{op_private} = [102, \&PUT_U8, "GET_U8"];
+$insn_data{op_first} = [103, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_last} = [104, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_other} = [105, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmreplroot} = [106, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmreplstart} = [107, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmnext} = [108, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_pmstashpv} = [109, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{op_pmreplrootpo} = [110, \&PUT_PADOFFSET, "GET_PADOFFSET"];
+$insn_data{op_pmstash} = [111, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_pmreplrootgv} = [112, \&PUT_svindex, "GET_svindex"];
+$insn_data{pregcomp} = [113, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pmflags} = [114, \&PUT_U16, "GET_U16"];
+$insn_data{op_pmpermflags} = [115, \&PUT_U16, "GET_U16"];
+$insn_data{op_pmdynflags} = [116, \&PUT_U8, "GET_U8"];
+$insn_data{op_sv} = [117, \&PUT_svindex, "GET_svindex"];
+$insn_data{op_padix} = [118, \&PUT_PADOFFSET, "GET_PADOFFSET"];
+$insn_data{op_pv} = [119, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pv_tr} = [120, \&PUT_op_tr_array, "GET_op_tr_array"];
+$insn_data{op_redoop} = [121, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_nextop} = [122, \&PUT_opindex, "GET_opindex"];
+$insn_data{op_lastop} = [123, \&PUT_opindex, "GET_opindex"];
+$insn_data{cop_label} = [124, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_stashpv} = [125, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_file} = [126, \&PUT_pvindex, "GET_pvindex"];
+$insn_data{cop_stash} = [127, \&PUT_svindex, "GET_svindex"];
+$insn_data{cop_filegv} = [128, \&PUT_svindex, "GET_svindex"];
+$insn_data{cop_seq} = [129, \&PUT_U32, "GET_U32"];
+$insn_data{cop_arybase} = [130, \&PUT_I32, "GET_I32"];
+$insn_data{cop_line} = [131, \&PUT_U32, "GET_U32"];
+$insn_data{cop_io} = [132, \&PUT_svindex, "GET_svindex"];
+$insn_data{cop_warnings} = [133, \&PUT_svindex, "GET_svindex"];
+$insn_data{main_start} = [134, \&PUT_opindex, "GET_opindex"];
+$insn_data{main_root} = [135, \&PUT_opindex, "GET_opindex"];
+$insn_data{main_cv} = [136, \&PUT_svindex, "GET_svindex"];
+$insn_data{curpad} = [137, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_begin} = [138, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_init} = [139, \&PUT_svindex, "GET_svindex"];
+$insn_data{push_end} = [140, \&PUT_svindex, "GET_svindex"];
+$insn_data{curstash} = [141, \&PUT_svindex, "GET_svindex"];
+$insn_data{defstash} = [142, \&PUT_svindex, "GET_svindex"];
+$insn_data{data} = [143, \&PUT_U8, "GET_U8"];
+$insn_data{incav} = [144, \&PUT_svindex, "GET_svindex"];
+$insn_data{load_glob} = [145, \&PUT_svindex, "GET_svindex"];
+$insn_data{regex_padav} = [146, \&PUT_svindex, "GET_svindex"];
+$insn_data{dowarn} = [147, \&PUT_U8, "GET_U8"];
+$insn_data{comppad_name} = [148, \&PUT_svindex, "GET_svindex"];
+$insn_data{xgv_stash} = [149, \&PUT_svindex, "GET_svindex"];
+$insn_data{signal} = [150, \&PUT_strconst, "GET_strconst"];
+$insn_data{formfeed} = [151, \&PUT_svindex, "GET_svindex"];
my ($insn_name, $insn_data);
while (($insn_name, $insn_data) = each %insn_data) {
#
package B::C::Section;
-our $VERSION = '1.03';
+our $VERSION = '1.04';
use B ();
use base B::Section;
return objsym($start);
}
-# Current workaround/fix for op_free() trying to free statically
-# defined OPs is to set op_seq = -1 and check for that in op_free().
-# Instead of hardwiring -1 in place of $op->seq, we use $op_seq
-# so that it can be changed back easily if necessary. In fact, to
-# stop compilers from moaning about a U16 being initialised with an
-# uncast -1 (the printf format is %d so we can't tweak it), we have
-# to "know" that op_seq is a U16 and use 65535. Ugh.
-my $op_seq = 65535;
+# Set the values for op_opt and op_static in each op. The value of
+# op_opt is irrelevant, and the value of op_static needs to be 1 to tell
+# op_free that this is a statically defined op and that is shouldn't be
+# freed.
+my $op_os = "0, 1, 0";
# Look this up here so we can do just a number compare
# rather than looking up the name of every BASEOP in B::OP
$init->add(sprintf("(void)find_threadsv(%s);",
cstring($threadsv_names[$op->targ])));
}
- $opsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x",
+ $opsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr, $op->targ,
- $type, $op_seq, $op->flags, $op->private));
+ $type, $op->flags, $op->private));
my $ix = $opsect->index;
$init->add(sprintf("op_list[$ix].op_ppaddr = %s;", $op->ppaddr))
unless $optimize_ppaddr;
sub B::FAKEOP::save {
my ($op, $level) = @_;
- $opsect->add(sprintf("%s, %s, %s, %u, %u, %u, 0x%x, 0x%x",
+ $opsect->add(sprintf("%s, %s, %s, %u, %u, $op_os, 0x%x, 0x%x",
$op->next, $op->sibling, $op->fake_ppaddr, $op->targ,
- $op->type, $op_seq, $op->flags, $op->private));
+ $op->type, $op->flags, $op->private));
my $ix = $opsect->index;
$init->add(sprintf("op_list[$ix].op_ppaddr = %s;", $op->ppaddr))
unless $optimize_ppaddr;
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $unopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x",
+ $unopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, ${$op->first}));
my $ix = $unopsect->index;
$init->add(sprintf("unop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $binopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+ $binopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x, s\\_%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, ${$op->first}, ${$op->last}));
my $ix = $binopsect->index;
$init->add(sprintf("binop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $listopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+ $listopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x, s\\_%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, ${$op->first}, ${$op->last}));
my $ix = $listopsect->index;
$init->add(sprintf("listop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $logopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x",
+ $logopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x, s\\_%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, ${$op->first}, ${$op->other}));
my $ix = $logopsect->index;
$init->add(sprintf("logop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
#warn sprintf("LOOP: redoop %s, nextop %s, lastop %s\n",
# peekop($op->redoop), peekop($op->nextop),
# peekop($op->lastop)); # debug
- $loopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x",
+ $loopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x, s\\_%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, ${$op->first}, ${$op->last},
${$op->redoop}, ${$op->nextop},
${$op->lastop}));
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $pvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+ $pvopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, %s",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, cstring($op->pv)));
my $ix = $pvopsect->index;
$init->add(sprintf("pvop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
my $sv = $op->sv;
my $svsym = '(SV*)' . $sv->save;
my $is_const_addr = $svsym =~ m/Null|\&/;
- $svopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s",
+ $svopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, %s",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private,
( $is_const_addr ? $svsym : 'Nullsv' )));
my $ix = $svopsect->index;
my ($op, $level) = @_;
my $sym = objsym($op);
return $sym if defined $sym;
- $padopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %d",
+ $padopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, %d",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private,$op->padix));
my $ix = $padopsect->index;
$init->add(sprintf("padop_list[$ix].op_ppaddr = %s;", $op->ppaddr))
$warn_sv = $warnings->save;
}
- $copsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, %s, NULL, NULL, %u, %d, %u, %s",
+ $copsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, %s, NULL, NULL, %u, %d, %u, %s",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr,
- $op->targ, $op->type, $op_seq, $op->flags,
+ $op->targ, $op->type, $op->flags,
$op->private, cstring($op->label), $op->cop_seq,
$op->arybase, $op->line,
( $optimize_warn_sv ? $warn_sv : 'NULL' )));
# pmnext handling is broken in perl itself, I think. Bad op_pmnext
# fields aren't noticed in perl's runtime (unless you try reset) but we
# segfault when trying to dereference it to find op->op_pmnext->op_type
- $pmopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %s, %s, 0, %u, 0x%x, 0x%x, 0x%x",
+ $pmopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, $op_os, 0x%x, 0x%x, s\\_%x, s\\_%x, %s, %s, 0, %u, 0x%x, 0x%x, 0x%x",
${$op->next}, ${$op->sibling}, $op->fake_ppaddr, $op->targ,
- $op->type, $op_seq, $op->flags, $op->private,
+ $op->type, $op->flags, $op->private,
${$op->first}, ${$op->last},
$replrootfield, $replstartfield,
( $ithreads ? $op->pmoffset : 0 ),
use Exporter (); # use #5
-our $VERSION = "0.58";
+our $VERSION = "0.59";
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(set_style set_style_standard add_callback
concise_subref concise_cv concise_main);
"(?(#seq)?)#noise#arg(?([#targarg])?)"],
"debug" =>
["#class (#addr)\n\top_next\t\t#nextaddr\n\top_sibling\t#sibaddr\n\t"
- . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n\top_seq\t\t"
- . "#seqnum\n\top_flags\t#flagval\n\top_private\t#privval\n"
+ . "op_ppaddr\tPL_ppaddr[OP_#NAME]\n\top_type\t\t#typenum\n"
+ . "\top_flags\t#flagval\n\top_private\t#privval\n"
. "(?(\top_first\t#firstaddr\n)?)(?(\top_last\t\t#lastaddr\n)?)"
. "(?(\top_sv\t\t#svaddr\n)?)",
" GOTO #addr\n",
push @$targ, $ar;
push @todo, [$op->pmreplstart, $ar];
} elsif ($name =~ /^enter(loop|iter)$/) {
- $labels{$op->nextop->seq} = "NEXT";
- $labels{$op->lastop->seq} = "LAST";
- $labels{$op->redoop->seq} = "REDO";
+ $labels{${$op->nextop}} = "NEXT";
+ $labels{${$op->lastop}} = "LAST";
+ $labels{${$op->redoop}} = "REDO";
}
}
}
}
$h{seq} = $h{hyphseq} = seq($op);
$h{seq} = "" if $h{seq} eq "-";
- $h{seqnum} = $op->seq;
+ $h{opt} = $op->opt;
+ $h{static} = $op->static;
$h{next} = $op->next;
$h{next} = (class($h{next}) eq "NULL") ? "(end)" : seq($h{next});
$h{nextaddr} = sprintf("%#x", $ {$op->next});
$h{privval} = $op->private;
$h{private} = private_flags($h{name}, $op->private);
$h{addr} = sprintf("%#x", $$op);
- $h{label} = $labels{$op->seq};
+ $h{label} = $labels{$$op};
$h{typenum} = $op->type;
$h{noise} = $linenoise[$op->type];
$_->(\%h, $op, \$format, \$level) for @callbacks;
# *** Warning: fragile kludge ahead ***
# Because the B::* modules run in the same interpreter as the code
-# they're compiling, their presence tends to distort the view we have
-# of the code we're looking at. In particular, perl gives sequence
-# numbers to both OPs in general and COPs in particular. If the
-# program we're looking at were run on its own, these numbers would
-# start at 1. Because all of B::Concise and all the modules it uses
-# are compiled first, though, by the time we get to the user's program
-# the sequence numbers are alreay at pretty high numbers, which would
-# be distracting if you're trying to tell OPs apart. Therefore we'd
-# like to subtract an offset from all the sequence numbers we display,
-# to restore the simpler view of the world. The trick is to know what
-# that offset will be, when we're still compiling B::Concise! If we
+# they're compiling, their presence tends to distort the view we have of
+# the code we're looking at. In particular, perl gives sequence numbers
+# to COPs. If the program we're looking at were run on its own, this
+# would start at 1. Because all of B::Concise and all the modules it
+# uses are compiled first, though, by the time we get to the user's
+# program the sequence number is already pretty high, which could be
+# distracting if you're trying to tell OPs apart. Therefore we'd like to
+# subtract an offset from all the sequence numbers we display, to
+# restore the simpler view of the world. The trick is to know what that
+# offset will be, when we're still compiling B::Concise! If we
# hardcoded a value, it would have to change every time B::Concise or
-# other modules we use do. To help a little, what we do here is
-# compile a little code at the end of the module, and compute the base
-# sequence number for the user's program as being a small offset
-# later, so all we have to worry about are changes in the offset.
-# (Note that we now only play this game with COP sequence numbers. OP
-# sequence numbers aren't used to refer to OPs from a distance, and
-# they don't have much significance, so we just generate our own
-# sequence numbers which are easier to control. This way we also don't
-# stand in the way of a possible future removal of OP sequence
-# numbers).
+# other modules we use do. To help a little, what we do here is compile
+# a little code at the end of the module, and compute the base sequence
+# number for the user's program as being a small offset later, so all we
+# have to worry about are changes in the offset.
# When you say "perl -MO=Concise -e '$a'", the output should look like:
=item B<#seq>
-The sequence number of the OP. Note that this is now a sequence number
-generated by B::Concise, rather than the real op_seq value (for which
-see B<#seqnum>).
+The sequence number of the OP. Note that this is a sequence number
+generated by B::Concise.
-=item B<#seqnum>
+=item B<#opt>
-The real sequence number of the OP, as a regular number and not adjusted
-to be relative to the start of the real program. (This will generally be
-a fairly large number because all of B<B::Concise> is compiled before
-your program is).
+Whether or not the op has been optimised by the peephole optimiser.
+
+=item B<#static>
+
+Whether or not the op is statically defined. This flag is used by the
+B::C compiler backend and indicates that the op should not be freed.
=item B<#sibaddr>
package B::Debug;
-our $VERSION = '1.01';
+our $VERSION = '1.02';
use strict;
use B qw(peekop class walkoptree walkoptree_exec
sub B::OP::debug {
my ($op) = @_;
- printf <<'EOT', class($op), $$op, ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op->seq, $op->flags, $op->private;
+ printf <<'EOT', class($op), $$op, ${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ, $op->type, $op->opt, $op->static, $op->flags, $op->private;
%s (0x%lx)
op_next 0x%x
op_sibling 0x%x
op_ppaddr %s
op_targ %d
op_type %d
- op_seq %d
+ op_opt %d
+ op_static %d
op_flags %d
op_private %d
EOT
BSET_op_type(PL_op, arg);
break;
}
- case INSN_OP_SEQ: /* 99 */
+ case INSN_OP_OPT: /* 99 */
{
- U16 arg;
- BGET_U16(arg);
- PL_op->op_seq = arg;
+ U8 arg;
+ BGET_U8(arg);
+ PL_op->op_opt = arg;
+ break;
+ }
+ case INSN_OP_STATIC: /* 100 */
+ {
+ U8 arg;
+ BGET_U8(arg);
+ PL_op->op_static = arg;
break;
}
- case INSN_OP_FLAGS: /* 100 */
+ case INSN_OP_FLAGS: /* 101 */
{
U8 arg;
BGET_U8(arg);
PL_op->op_flags = arg;
break;
}
- case INSN_OP_PRIVATE: /* 101 */
+ case INSN_OP_PRIVATE: /* 102 */
{
U8 arg;
BGET_U8(arg);
PL_op->op_private = arg;
break;
}
- case INSN_OP_FIRST: /* 102 */
+ case INSN_OP_FIRST: /* 103 */
{
opindex arg;
BGET_opindex(arg);
cUNOP->op_first = arg;
break;
}
- case INSN_OP_LAST: /* 103 */
+ case INSN_OP_LAST: /* 104 */
{
opindex arg;
BGET_opindex(arg);
cBINOP->op_last = arg;
break;
}
- case INSN_OP_OTHER: /* 104 */
+ case INSN_OP_OTHER: /* 105 */
{
opindex arg;
BGET_opindex(arg);
cLOGOP->op_other = arg;
break;
}
- case INSN_OP_PMREPLROOT: /* 105 */
+ case INSN_OP_PMREPLROOT: /* 106 */
{
opindex arg;
BGET_opindex(arg);
cPMOP->op_pmreplroot = arg;
break;
}
- case INSN_OP_PMREPLSTART: /* 106 */
+ case INSN_OP_PMREPLSTART: /* 107 */
{
opindex arg;
BGET_opindex(arg);
cPMOP->op_pmreplstart = arg;
break;
}
- case INSN_OP_PMNEXT: /* 107 */
+ case INSN_OP_PMNEXT: /* 108 */
{
opindex arg;
BGET_opindex(arg);
break;
}
#ifdef USE_ITHREADS
- case INSN_OP_PMSTASHPV: /* 108 */
+ case INSN_OP_PMSTASHPV: /* 109 */
{
pvindex arg;
BGET_pvindex(arg);
BSET_op_pmstashpv(cPMOP, arg);
break;
}
- case INSN_OP_PMREPLROOTPO: /* 109 */
+ case INSN_OP_PMREPLROOTPO: /* 110 */
{
PADOFFSET arg;
BGET_PADOFFSET(arg);
break;
}
#else
- case INSN_OP_PMSTASH: /* 110 */
+ case INSN_OP_PMSTASH: /* 111 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&cPMOP->op_pmstash = arg;
break;
}
- case INSN_OP_PMREPLROOTGV: /* 111 */
+ case INSN_OP_PMREPLROOTGV: /* 112 */
{
svindex arg;
BGET_svindex(arg);
break;
}
#endif
- case INSN_PREGCOMP: /* 112 */
+ case INSN_PREGCOMP: /* 113 */
{
pvcontents arg;
BGET_pvcontents(arg);
BSET_pregcomp(PL_op, arg);
break;
}
- case INSN_OP_PMFLAGS: /* 113 */
+ case INSN_OP_PMFLAGS: /* 114 */
{
U16 arg;
BGET_U16(arg);
cPMOP->op_pmflags = arg;
break;
}
- case INSN_OP_PMPERMFLAGS: /* 114 */
+ case INSN_OP_PMPERMFLAGS: /* 115 */
{
U16 arg;
BGET_U16(arg);
cPMOP->op_pmpermflags = arg;
break;
}
- case INSN_OP_PMDYNFLAGS: /* 115 */
+ case INSN_OP_PMDYNFLAGS: /* 116 */
{
U8 arg;
BGET_U8(arg);
cPMOP->op_pmdynflags = arg;
break;
}
- case INSN_OP_SV: /* 116 */
+ case INSN_OP_SV: /* 117 */
{
svindex arg;
BGET_svindex(arg);
cSVOP->op_sv = arg;
break;
}
- case INSN_OP_PADIX: /* 117 */
+ case INSN_OP_PADIX: /* 118 */
{
PADOFFSET arg;
BGET_PADOFFSET(arg);
cPADOP->op_padix = arg;
break;
}
- case INSN_OP_PV: /* 118 */
+ case INSN_OP_PV: /* 119 */
{
pvcontents arg;
BGET_pvcontents(arg);
cPVOP->op_pv = arg;
break;
}
- case INSN_OP_PV_TR: /* 119 */
+ case INSN_OP_PV_TR: /* 120 */
{
op_tr_array arg;
BGET_op_tr_array(arg);
cPVOP->op_pv = arg;
break;
}
- case INSN_OP_REDOOP: /* 120 */
+ case INSN_OP_REDOOP: /* 121 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_redoop = arg;
break;
}
- case INSN_OP_NEXTOP: /* 121 */
+ case INSN_OP_NEXTOP: /* 122 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_nextop = arg;
break;
}
- case INSN_OP_LASTOP: /* 122 */
+ case INSN_OP_LASTOP: /* 123 */
{
opindex arg;
BGET_opindex(arg);
cLOOP->op_lastop = arg;
break;
}
- case INSN_COP_LABEL: /* 123 */
+ case INSN_COP_LABEL: /* 124 */
{
pvindex arg;
BGET_pvindex(arg);
break;
}
#ifdef USE_ITHREADS
- case INSN_COP_STASHPV: /* 124 */
+ case INSN_COP_STASHPV: /* 125 */
{
pvindex arg;
BGET_pvindex(arg);
BSET_cop_stashpv(cCOP, arg);
break;
}
- case INSN_COP_FILE: /* 125 */
+ case INSN_COP_FILE: /* 126 */
{
pvindex arg;
BGET_pvindex(arg);
break;
}
#else
- case INSN_COP_STASH: /* 126 */
+ case INSN_COP_STASH: /* 127 */
{
svindex arg;
BGET_svindex(arg);
BSET_cop_stash(cCOP, arg);
break;
}
- case INSN_COP_FILEGV: /* 127 */
+ case INSN_COP_FILEGV: /* 128 */
{
svindex arg;
BGET_svindex(arg);
break;
}
#endif
- case INSN_COP_SEQ: /* 128 */
+ case INSN_COP_SEQ: /* 129 */
{
U32 arg;
BGET_U32(arg);
cCOP->cop_seq = arg;
break;
}
- case INSN_COP_ARYBASE: /* 129 */
+ case INSN_COP_ARYBASE: /* 130 */
{
I32 arg;
BGET_I32(arg);
cCOP->cop_arybase = arg;
break;
}
- case INSN_COP_LINE: /* 130 */
+ case INSN_COP_LINE: /* 131 */
{
line_t arg;
BGET_U32(arg);
cCOP->cop_line = arg;
break;
}
- case INSN_COP_IO: /* 131 */
+ case INSN_COP_IO: /* 132 */
{
svindex arg;
BGET_svindex(arg);
cCOP->cop_io = arg;
break;
}
- case INSN_COP_WARNINGS: /* 132 */
+ case INSN_COP_WARNINGS: /* 133 */
{
svindex arg;
BGET_svindex(arg);
cCOP->cop_warnings = arg;
break;
}
- case INSN_MAIN_START: /* 133 */
+ case INSN_MAIN_START: /* 134 */
{
opindex arg;
BGET_opindex(arg);
PL_main_start = arg;
break;
}
- case INSN_MAIN_ROOT: /* 134 */
+ case INSN_MAIN_ROOT: /* 135 */
{
opindex arg;
BGET_opindex(arg);
PL_main_root = arg;
break;
}
- case INSN_MAIN_CV: /* 135 */
+ case INSN_MAIN_CV: /* 136 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&PL_main_cv = arg;
break;
}
- case INSN_CURPAD: /* 136 */
+ case INSN_CURPAD: /* 137 */
{
svindex arg;
BGET_svindex(arg);
BSET_curpad(PL_curpad, arg);
break;
}
- case INSN_PUSH_BEGIN: /* 137 */
+ case INSN_PUSH_BEGIN: /* 138 */
{
svindex arg;
BGET_svindex(arg);
BSET_push_begin(PL_beginav, arg);
break;
}
- case INSN_PUSH_INIT: /* 138 */
+ case INSN_PUSH_INIT: /* 139 */
{
svindex arg;
BGET_svindex(arg);
BSET_push_init(PL_initav, arg);
break;
}
- case INSN_PUSH_END: /* 139 */
+ case INSN_PUSH_END: /* 140 */
{
svindex arg;
BGET_svindex(arg);
BSET_push_end(PL_endav, arg);
break;
}
- case INSN_CURSTASH: /* 140 */
+ case INSN_CURSTASH: /* 141 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&PL_curstash = arg;
break;
}
- case INSN_DEFSTASH: /* 141 */
+ case INSN_DEFSTASH: /* 142 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&PL_defstash = arg;
break;
}
- case INSN_DATA: /* 142 */
+ case INSN_DATA: /* 143 */
{
U8 arg;
BGET_U8(arg);
BSET_data(none, arg);
break;
}
- case INSN_INCAV: /* 143 */
+ case INSN_INCAV: /* 144 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&GvAV(PL_incgv) = arg;
break;
}
- case INSN_LOAD_GLOB: /* 144 */
+ case INSN_LOAD_GLOB: /* 145 */
{
svindex arg;
BGET_svindex(arg);
break;
}
#ifdef USE_ITHREADS
- case INSN_REGEX_PADAV: /* 145 */
+ case INSN_REGEX_PADAV: /* 146 */
{
svindex arg;
BGET_svindex(arg);
break;
}
#endif
- case INSN_DOWARN: /* 146 */
+ case INSN_DOWARN: /* 147 */
{
U8 arg;
BGET_U8(arg);
PL_dowarn = arg;
break;
}
- case INSN_COMPPAD_NAME: /* 147 */
+ case INSN_COMPPAD_NAME: /* 148 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&PL_comppad_name = arg;
break;
}
- case INSN_XGV_STASH: /* 148 */
+ case INSN_XGV_STASH: /* 149 */
{
svindex arg;
BGET_svindex(arg);
*(SV**)&GvSTASH(bstate->bs_sv) = arg;
break;
}
- case INSN_SIGNAL: /* 149 */
+ case INSN_SIGNAL: /* 150 */
{
strconst arg;
BGET_strconst(arg);
BSET_signal(bstate->bs_sv, arg);
break;
}
- case INSN_FORMFEED: /* 150 */
+ case INSN_FORMFEED: /* 151 */
{
svindex arg;
BGET_svindex(arg);
INSN_OP_PPADDR, /* 96 */
INSN_OP_TARG, /* 97 */
INSN_OP_TYPE, /* 98 */
- INSN_OP_SEQ, /* 99 */
- INSN_OP_FLAGS, /* 100 */
- INSN_OP_PRIVATE, /* 101 */
- INSN_OP_FIRST, /* 102 */
- INSN_OP_LAST, /* 103 */
- INSN_OP_OTHER, /* 104 */
- INSN_OP_PMREPLROOT, /* 105 */
- INSN_OP_PMREPLSTART, /* 106 */
- INSN_OP_PMNEXT, /* 107 */
- INSN_OP_PMSTASHPV, /* 108 */
- INSN_OP_PMREPLROOTPO, /* 109 */
- INSN_OP_PMSTASH, /* 110 */
- INSN_OP_PMREPLROOTGV, /* 111 */
- INSN_PREGCOMP, /* 112 */
- INSN_OP_PMFLAGS, /* 113 */
- INSN_OP_PMPERMFLAGS, /* 114 */
- INSN_OP_PMDYNFLAGS, /* 115 */
- INSN_OP_SV, /* 116 */
- INSN_OP_PADIX, /* 117 */
- INSN_OP_PV, /* 118 */
- INSN_OP_PV_TR, /* 119 */
- INSN_OP_REDOOP, /* 120 */
- INSN_OP_NEXTOP, /* 121 */
- INSN_OP_LASTOP, /* 122 */
- INSN_COP_LABEL, /* 123 */
- INSN_COP_STASHPV, /* 124 */
- INSN_COP_FILE, /* 125 */
- INSN_COP_STASH, /* 126 */
- INSN_COP_FILEGV, /* 127 */
- INSN_COP_SEQ, /* 128 */
- INSN_COP_ARYBASE, /* 129 */
- INSN_COP_LINE, /* 130 */
- INSN_COP_IO, /* 131 */
- INSN_COP_WARNINGS, /* 132 */
- INSN_MAIN_START, /* 133 */
- INSN_MAIN_ROOT, /* 134 */
- INSN_MAIN_CV, /* 135 */
- INSN_CURPAD, /* 136 */
- INSN_PUSH_BEGIN, /* 137 */
- INSN_PUSH_INIT, /* 138 */
- INSN_PUSH_END, /* 139 */
- INSN_CURSTASH, /* 140 */
- INSN_DEFSTASH, /* 141 */
- INSN_DATA, /* 142 */
- INSN_INCAV, /* 143 */
- INSN_LOAD_GLOB, /* 144 */
- INSN_REGEX_PADAV, /* 145 */
- INSN_DOWARN, /* 146 */
- INSN_COMPPAD_NAME, /* 147 */
- INSN_XGV_STASH, /* 148 */
- INSN_SIGNAL, /* 149 */
- INSN_FORMFEED, /* 150 */
- MAX_INSN = 150
+ INSN_OP_OPT, /* 99 */
+ INSN_OP_STATIC, /* 100 */
+ INSN_OP_FLAGS, /* 101 */
+ INSN_OP_PRIVATE, /* 102 */
+ INSN_OP_FIRST, /* 103 */
+ INSN_OP_LAST, /* 104 */
+ INSN_OP_OTHER, /* 105 */
+ INSN_OP_PMREPLROOT, /* 106 */
+ INSN_OP_PMREPLSTART, /* 107 */
+ INSN_OP_PMNEXT, /* 108 */
+ INSN_OP_PMSTASHPV, /* 109 */
+ INSN_OP_PMREPLROOTPO, /* 110 */
+ INSN_OP_PMSTASH, /* 111 */
+ INSN_OP_PMREPLROOTGV, /* 112 */
+ INSN_PREGCOMP, /* 113 */
+ INSN_OP_PMFLAGS, /* 114 */
+ INSN_OP_PMPERMFLAGS, /* 115 */
+ INSN_OP_PMDYNFLAGS, /* 116 */
+ INSN_OP_SV, /* 117 */
+ INSN_OP_PADIX, /* 118 */
+ INSN_OP_PV, /* 119 */
+ INSN_OP_PV_TR, /* 120 */
+ INSN_OP_REDOOP, /* 121 */
+ INSN_OP_NEXTOP, /* 122 */
+ INSN_OP_LASTOP, /* 123 */
+ INSN_COP_LABEL, /* 124 */
+ INSN_COP_STASHPV, /* 125 */
+ INSN_COP_FILE, /* 126 */
+ INSN_COP_STASH, /* 127 */
+ INSN_COP_FILEGV, /* 128 */
+ INSN_COP_SEQ, /* 129 */
+ INSN_COP_ARYBASE, /* 130 */
+ INSN_COP_LINE, /* 131 */
+ INSN_COP_IO, /* 132 */
+ INSN_COP_WARNINGS, /* 133 */
+ INSN_MAIN_START, /* 134 */
+ INSN_MAIN_ROOT, /* 135 */
+ INSN_MAIN_CV, /* 136 */
+ INSN_CURPAD, /* 137 */
+ INSN_PUSH_BEGIN, /* 138 */
+ INSN_PUSH_INIT, /* 139 */
+ INSN_PUSH_END, /* 140 */
+ INSN_CURSTASH, /* 141 */
+ INSN_DEFSTASH, /* 142 */
+ INSN_DATA, /* 143 */
+ INSN_INCAV, /* 144 */
+ INSN_LOAD_GLOB, /* 145 */
+ INSN_REGEX_PADAV, /* 146 */
+ INSN_DOWARN, /* 147 */
+ INSN_COMPPAD_NAME, /* 148 */
+ INSN_XGV_STASH, /* 149 */
+ INSN_SIGNAL, /* 150 */
+ INSN_FORMFEED, /* 151 */
+ MAX_INSN = 151
};
enum {
PERLVAR(Inomemok, bool) /* let malloc context handle nomem */
PERLVARI(Ian, U32, 0) /* malloc sequence number */
PERLVARI(Icop_seqmax, U32, 0) /* statement sequence number */
-PERLVARI(Iop_seqmax, U16, 0) /* op sequence number */
PERLVARI(Ievalseq, U32, 0) /* eval sequence number */
PERLVAR(Iorigenviron, char **)
PERLVAR(Iorigalen, U32)
register OP *kid, *nextkid;
OPCODE type;
- if (!o || o->op_seq == (U16)-1)
+ if (!o || o->op_static)
return;
if (o->op_private & OPpREFCOUNTED) {
o->op_ppaddr = PL_ppaddr[OP_RV2AV];
o->op_flags &= ~OPf_REF; /* treat \(1..2) like an ordinary list */
o->op_flags |= OPf_PARENS; /* and flatten \(1..2,3) */
- o->op_seq = 0; /* needs to be revisited in peep() */
+ o->op_opt = 0; /* needs to be revisited in peep() */
curop = ((UNOP*)o)->op_first;
((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
op_free(curop);
{
register OP* oldop = 0;
- if (!o || o->op_seq)
+ if (!o || o->op_opt)
return;
ENTER;
SAVEOP();
SAVEVPTR(PL_curcop);
for (; o; o = o->op_next) {
- if (o->op_seq)
+ if (o->op_opt)
break;
- /* The special value -1 is used by the B::C compiler backend to indicate
- * that an op is statically defined and should not be freed */
- if (!PL_op_seqmax || PL_op_seqmax == (U16)-1)
- PL_op_seqmax = 1;
PL_op = o;
switch (o->op_type) {
case OP_SETSTATE:
case OP_NEXTSTATE:
case OP_DBSTATE:
PL_curcop = ((COP*)o); /* for warnings */
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
case OP_CONST:
o->op_targ = ix;
}
#endif
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
case OP_CONCAT:
op_null(o->op_next);
}
ignore_optimization:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
case OP_STUB:
if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break; /* Scalar stub must produce undef. List stub is noop */
}
goto nothin;
to peep() from mistakenly concluding that optimisation
has already occurred. This doesn't fix the real problem,
though (See 20010220.007). AMS 20010719 */
+ /* op_seq functionality is now replaced by op_opt */
if (oldop && o->op_next) {
oldop->op_next = o->op_next;
continue;
oldop->op_next = o->op_next;
continue;
}
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
case OP_GV:
op_null(o->op_next);
}
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
case OP_MAPWHILE:
case OP_DORASSIGN:
case OP_COND_EXPR:
case OP_RANGE:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
while (cLOGOP->op_other->op_type == OP_NULL)
cLOGOP->op_other = cLOGOP->op_other->op_next;
peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
case OP_ENTERLOOP:
case OP_ENTERITER:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
while (cLOOP->op_redoop->op_type == OP_NULL)
cLOOP->op_redoop = cLOOP->op_redoop->op_next;
peep(cLOOP->op_redoop);
case OP_QR:
case OP_MATCH:
case OP_SUBST:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
while (cPMOP->op_pmreplstart &&
cPMOP->op_pmreplstart->op_type == OP_NULL)
cPMOP->op_pmreplstart = cPMOP->op_pmreplstart->op_next;
break;
case OP_EXEC:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
if (ckWARN(WARN_SYNTAX) && o->op_next
&& o->op_next->op_type == OP_NEXTSTATE) {
if (o->op_next->op_sibling &&
char *key = NULL;
STRLEN keylen;
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
if (((BINOP*)o)->op_last->op_type != OP_CONST)
break;
OP *oleft, *oright;
OP *o2;
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
/* check that RHS of sort is a single plain array */
oright = cUNOPo->op_first;
default:
- o->op_seq = PL_op_seqmax++;
+ o->op_opt = 1;
break;
}
oldop = o;
* parent takes over role of remembering starting op.)
* op_ppaddr Pointer to current ppcode's function.
* op_type The type of the operation.
+ * op_opt Whether or not the op has been optimised by the
+ * peephole optimiser.
+ * op_static Whether or not the op is statically defined.
+ * This flag is used by the B::C compiler backend
+ * and indicates that the op should not be freed.
+ * op_spare Five spare bits!
* op_flags Flags common to all operations. See OPf_* below.
* op_private Flags peculiar to a particular operation (BUT,
* by default, set to the number of children until
OP* op_sibling; \
OP* (CPERLscope(*op_ppaddr))(pTHX); \
PADOFFSET op_targ; \
- OPCODE op_type; \
- U16 op_seq; \
+ unsigned op_type:9; \
+ unsigned op_opt:1; \
+ unsigned op_static:1; \
+ unsigned op_spare:5; \
U8 op_flags; \
U8 op_private;
#endif
#define PL_oldoldbufptr (*Perl_Ioldoldbufptr_ptr(aTHX))
#undef PL_op_mask
#define PL_op_mask (*Perl_Iop_mask_ptr(aTHX))
-#undef PL_op_seqmax
-#define PL_op_seqmax (*Perl_Iop_seqmax_ptr(aTHX))
#undef PL_origalen
#define PL_origalen (*Perl_Iorigalen_ptr(aTHX))
#undef PL_origargc
#define PL_xrv_arenaroot (*Perl_Ixrv_arenaroot_ptr(aTHX))
#undef PL_xrv_root
#define PL_xrv_root (*Perl_Ixrv_root_ptr(aTHX))
-#undef PL_yycharBINCOMPAT
-#define PL_yycharBINCOMPAT (*Perl_IyycharBINCOMPAT_ptr(aTHX))
-#undef PL_yydebugBINCOMPAT
-#define PL_yydebugBINCOMPAT (*Perl_IyydebugBINCOMPAT_ptr(aTHX))
-#undef PL_yyerrflagBINCOMPAT
-#define PL_yyerrflagBINCOMPAT (*Perl_IyyerrflagBINCOMPAT_ptr(aTHX))
-#undef PL_yylvalBINCOMPAT
-#define PL_yylvalBINCOMPAT (*Perl_IyylvalBINCOMPAT_ptr(aTHX))
-#undef PL_yynerrsBINCOMPAT
-#define PL_yynerrsBINCOMPAT (*Perl_IyynerrsBINCOMPAT_ptr(aTHX))
-#undef PL_yyvalBINCOMPAT
-#define PL_yyvalBINCOMPAT (*Perl_IyyvalBINCOMPAT_ptr(aTHX))
#undef PL_Sv
#define PL_Sv (*Perl_TSv_ptr(aTHX))
#undef PL_Xpv
Note that formats are treated as anon subs, and are cloned each time
write is called (if necessary).
+The flag SVf_PADSTALE is cleared on lexicals each time the my() is executed,
+and set on scope exit. This allows the 'Variable $x is not available' warning
+to be generated in evals, such as
+
+ { my $x = 1; sub f { eval '$x'} } f();
+
AV * CvPADLIST(CV *cv)
=for hackers
PL_egid = proto_perl->Iegid;
PL_nomemok = proto_perl->Inomemok;
PL_an = proto_perl->Ian;
- PL_op_seqmax = proto_perl->Iop_seqmax;
PL_evalseq = proto_perl->Ievalseq;
PL_origenviron = proto_perl->Iorigenviron; /* XXX not quite right */
PL_origalen = proto_perl->Iorigalen;