require Exporter;
@ISA = qw(Exporter DynaLoader);
@EXPORT_OK = qw(byteload_fh byteload_string minus_c ppname
- class peekop cast_I32 cstring cchar hash
+ class peekop cast_I32 cstring cchar hash threadsv_names
main_root main_start main_cv svref_2object
walkoptree walkoptree_slow walkoptree_exec walksymtable
parents comppadlist sv_undef compile_stats timing_info);
#include "INTERN.h"
#include "bytecode.h"
#include "byterun.h"
-#include "ccop.h"
static char *svclassnames[] = {
"B::NULL",
"B::IO",
};
+typedef enum {
+ OPc_NULL, /* 0 */
+ OPc_BASEOP, /* 1 */
+ OPc_UNOP, /* 2 */
+ OPc_BINOP, /* 3 */
+ OPc_LOGOP, /* 4 */
+ OPc_CONDOP, /* 5 */
+ OPc_LISTOP, /* 6 */
+ OPc_PMOP, /* 7 */
+ OPc_SVOP, /* 8 */
+ OPc_GVOP, /* 9 */
+ OPc_PVOP, /* 10 */
+ OPc_CVOP, /* 11 */
+ OPc_LOOP, /* 12 */
+ OPc_COP /* 13 */
+} opclass;
+
+static char *opclassnames[] = {
+ "B::NULL",
+ "B::OP",
+ "B::UNOP",
+ "B::BINOP",
+ "B::LOGOP",
+ "B::CONDOP",
+ "B::LISTOP",
+ "B::PMOP",
+ "B::SVOP",
+ "B::GVOP",
+ "B::PVOP",
+ "B::CVOP",
+ "B::LOOP",
+ "B::COP"
+};
+
+static opclass
+cc_opclass(o)
+OP * o;
+{
+ if (!o)
+ return OPc_NULL;
+
+ if (o->op_type == 0)
+ return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
+
+ if (o->op_type == OP_SASSIGN)
+ return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
+
+ switch (opargs[o->op_type] & OA_CLASS_MASK) {
+ case OA_BASEOP:
+ return OPc_BASEOP;
+
+ case OA_UNOP:
+ return OPc_UNOP;
+
+ case OA_BINOP:
+ return OPc_BINOP;
+
+ case OA_LOGOP:
+ return OPc_LOGOP;
+
+ case OA_CONDOP:
+ return OPc_CONDOP;
+
+ case OA_LISTOP:
+ return OPc_LISTOP;
+
+ case OA_PMOP:
+ return OPc_PMOP;
+
+ case OA_SVOP:
+ return OPc_SVOP;
+
+ case OA_GVOP:
+ return OPc_GVOP;
+
+ case OA_PVOP:
+ return OPc_PVOP;
+
+ case OA_LOOP:
+ return OPc_LOOP;
+
+ case OA_COP:
+ return OPc_COP;
+
+ case OA_BASEOP_OR_UNOP:
+ /*
+ * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
+ * whether bare parens were seen. perly.y uses OPf_SPECIAL to
+ * signal whether an OP or an UNOP was chosen.
+ * Frederic.Chauveau@pasteur.fr says we need to check for OPf_KIDS too.
+ */
+ return ((o->op_flags & OPf_SPECIAL) ? OPc_BASEOP :
+ (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP);
+
+ case OA_FILESTATOP:
+ /*
+ * The file stat OPs are created via UNI(OP_foo) in toke.c but use
+ * the OPf_REF flag to distinguish between OP types instead of the
+ * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
+ * return OPc_UNOP so that walkoptree can find our children. If
+ * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
+ * (no argument to the operator) it's an OP; with OPf_REF set it's
+ * a GVOP (and op_gv is the GV for the filehandle argument).
+ */
+ return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
+ (o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP);
+
+ case OA_LOOPEXOP:
+ /*
+ * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
+ * label was omitted (in which case it's a BASEOP) or else a term was
+ * seen. In this last case, all except goto are definitely PVOP but
+ * goto is either a PVOP (with an ordinary constant label), an UNOP
+ * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
+ * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
+ * get set.
+ */
+ if (o->op_flags & OPf_STACKED)
+ return OPc_UNOP;
+ else if (o->op_flags & OPf_SPECIAL)
+ return OPc_BASEOP;
+ else
+ return OPc_PVOP;
+ }
+ warn("can't determine class of operator %s, assuming BASEOP\n",
+ op_name[o->op_type]);
+ return OPc_BASEOP;
+}
+
+static char *
+cc_opclassname(o)
+OP * o;
+{
+ return opclassnames[cc_opclass(o)];
+}
+
static SV *
make_sv_object(arg, sv)
SV *arg;
SV *opsv;
char *method;
{
- dTHR;
dSP;
OP *o;
int opnum
CODE:
ST(0) = sv_newmortal();
- if (opnum >= 0 && opnum < sizeof(ppnames)/sizeof(char*))
- sv_setpv(ST(0), ppnames[opnum]);
+ if (opnum >= 0 && opnum < maxo) {
+ sv_setpvn(ST(0), "pp_", 3);
+ sv_catpv(ST(0), op_name[opnum]);
+ }
void
hash(sv)
cchar(sv)
SV * sv
+void
+threadsv_names()
+ PPCODE:
+ int i;
+ STRLEN len = strlen(threadsv_names);
+
+ EXTEND(sp, len);
+ for (i = 0; i < len; i++)
+ PUSHs(sv_2mortal(newSVpv(&threadsv_names[i], 1)));
+
+
#define OP_next(o) o->op_next
#define OP_sibling(o) o->op_sibling
-#define OP_ppaddr(o) ppnames[o->op_type]
#define OP_desc(o) op_desc[o->op_type]
#define OP_targ(o) o->op_targ
#define OP_type(o) o->op_type
char *
OP_ppaddr(o)
B::OP o
+ CODE:
+ ST(0) = sv_newmortal();
+ sv_setpvn(ST(0), "pp_", 3);
+ sv_catpv(ST(0), op_name[o->op_type]);
char *
OP_desc(o)
#define PMOP_pmreplstart(o) o->op_pmreplstart
#define PMOP_pmnext(o) o->op_pmnext
#define PMOP_pmregexp(o) o->op_pmregexp
-#define PMOP_pmshort(o) o->op_pmshort
#define PMOP_pmflags(o) o->op_pmflags
#define PMOP_pmpermflags(o) o->op_pmpermflags
-#define PMOP_pmslen(o) o->op_pmslen
MODULE = B PACKAGE = B::PMOP PREFIX = PMOP_
PMOP_pmnext(o)
B::PMOP o
-B::SV
-PMOP_pmshort(o)
- B::PMOP o
-
U16
PMOP_pmflags(o)
B::PMOP o
PMOP_pmpermflags(o)
B::PMOP o
-U8
-PMOP_pmslen(o)
- B::PMOP o
-
void
PMOP_precomp(o)
B::PMOP o
$insn_data{op_pmreplstart} = [98, \&PUT_objindex, "GET_objindex"];
$insn_data{op_pmnext} = [99, \&PUT_objindex, "GET_objindex"];
$insn_data{pregcomp} = [100, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{op_pmshort} = [101, \&PUT_objindex, "GET_objindex"];
-$insn_data{op_pmflags} = [102, \&PUT_U16, "GET_U16"];
-$insn_data{op_pmpermflags} = [103, \&PUT_U16, "GET_U16"];
-$insn_data{op_pmslen} = [104, \&PUT_U8, "GET_U8"];
-$insn_data{op_sv} = [105, \&PUT_objindex, "GET_objindex"];
-$insn_data{op_gv} = [106, \&PUT_objindex, "GET_objindex"];
-$insn_data{op_pv} = [107, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{op_pv_tr} = [108, \&PUT_op_tr_array, "GET_op_tr_array"];
-$insn_data{op_redoop} = [109, \&PUT_objindex, "GET_objindex"];
-$insn_data{op_nextop} = [110, \&PUT_objindex, "GET_objindex"];
-$insn_data{op_lastop} = [111, \&PUT_objindex, "GET_objindex"];
-$insn_data{cop_label} = [112, \&PUT_pvcontents, "GET_pvcontents"];
-$insn_data{cop_stash} = [113, \&PUT_objindex, "GET_objindex"];
-$insn_data{cop_filegv} = [114, \&PUT_objindex, "GET_objindex"];
-$insn_data{cop_seq} = [115, \&PUT_U32, "GET_U32"];
-$insn_data{cop_arybase} = [116, \&PUT_I32, "GET_I32"];
-$insn_data{cop_line} = [117, \&PUT_U16, "GET_U16"];
-$insn_data{main_start} = [118, \&PUT_objindex, "GET_objindex"];
-$insn_data{main_root} = [119, \&PUT_objindex, "GET_objindex"];
-$insn_data{curpad} = [120, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_pmflags} = [101, \&PUT_U16, "GET_U16"];
+$insn_data{op_pmpermflags} = [102, \&PUT_U16, "GET_U16"];
+$insn_data{op_sv} = [103, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_gv} = [104, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_pv} = [105, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{op_pv_tr} = [106, \&PUT_op_tr_array, "GET_op_tr_array"];
+$insn_data{op_redoop} = [107, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_nextop} = [108, \&PUT_objindex, "GET_objindex"];
+$insn_data{op_lastop} = [109, \&PUT_objindex, "GET_objindex"];
+$insn_data{cop_label} = [110, \&PUT_pvcontents, "GET_pvcontents"];
+$insn_data{cop_stash} = [111, \&PUT_objindex, "GET_objindex"];
+$insn_data{cop_filegv} = [112, \&PUT_objindex, "GET_objindex"];
+$insn_data{cop_seq} = [113, \&PUT_U32, "GET_U32"];
+$insn_data{cop_arybase} = [114, \&PUT_I32, "GET_I32"];
+$insn_data{cop_line} = [115, \&PUT_U16, "GET_U16"];
+$insn_data{main_start} = [116, \&PUT_objindex, "GET_objindex"];
+$insn_data{main_root} = [117, \&PUT_objindex, "GET_objindex"];
+$insn_data{curpad} = [118, \&PUT_objindex, "GET_objindex"];
my ($insn_name, $insn_data);
while (($insn_name, $insn_data) = each %insn_data) {
init_sections set_callback save_unused_subs objsym);
use B qw(minus_c sv_undef walkoptree walksymtable main_root main_start peekop
- class cstring cchar svref_2object compile_stats comppadlist hash);
+ class cstring cchar svref_2object compile_stats comppadlist hashi
+ threadsv_names);
use B::Asmdata qw(@specialsv_name);
use FileHandle;
my $pv_copy_on_grow;
my ($debug_cops, $debug_av, $debug_cv, $debug_mg);
+my @threadsv_names;
+BEGIN {
+ @threadsv_names = threadsv_names();
+}
+
# Code sections
my ($init, $decl, $symsect, $binopsect, $condopsect, $copsect, $cvopsect,
$gvopsect, $listopsect, $logopsect, $loopsect, $opsect, $pmopsect,
sub AVf_REAL () { 1 }
+# XXX This shouldn't really be hardcoded here but it saves
+# looking up the name of every BASEOP in B::OP
+sub OP_THREADSV () { 345 }
+
sub savesym {
my ($obj, $value) = @_;
my $sym = sprintf("s\\_%x", $$obj);
my ($op, $level) = @_;
my $type = $op->type;
$nullop_count++ unless $type;
+ if ($type == OP_THREADSV) {
+ # saves looking up ppaddr but it's a bit naughty to hard code this
+ $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",
${$op->next}, ${$op->sibling}, $op->ppaddr, $op->targ,
$type, $op_seq, $op->flags, $op->private));
sub B::PMOP::save {
my ($op, $level) = @_;
- my $shortsym = $op->pmshort->save;
my $replroot = $op->pmreplroot;
my $replstart = $op->pmreplstart;
my $replrootfield = sprintf("s\\_%x", $$replroot);
# 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, %u, %s, %s, 0, 0, %s, 0x%x, 0x%x, %u",
+ $pmopsect->add(sprintf("s\\_%x, s\\_%x, %s, %u, %u, %u, 0x%x, 0x%x, s\\_%x, s\\_%x, %u, %s, %s, 0, 0, 0x%x, 0x%x",
${$op->next}, ${$op->sibling}, $ppaddr, $op->targ,
$op->type, $op_seq, $op->flags, $op->private,
${$op->first}, ${$op->last}, $op->children,
- $replrootfield, $replstartfield, $shortsym,
- $op->pmflags, $op->pmpermflags, $op->pmslen));
+ $replrootfield, $replstartfield,
+ $op->pmflags, $op->pmpermflags,));
my $pm = sprintf("pmop_list[%d]", $pmopsect->index);
my $re = $op->precomp;
if (defined($re)) {
}
}
- print "static int $init_name()\n{\n";
+ print <<"EOT";
+static int $init_name()
+{
+ dTHR;
+EOT
$init->output(\*STDOUT, "\t%s\n");
print "\treturn 0;\n}\n";
if ($verbose) {
long xcv_depth; /* >= 2 indicates recursive call */
AV * xcv_padlist;
CV * xcv_outside;
+#ifdef USE_THREADS
+ perl_mutex *xcv_mutexp;
+ struct perl_thread *xcv_owner; /* current owner thread */
+#endif /* USE_THREADS */
U8 xcv_flags;
} XPVCV_or_similar;
#define ANYINIT(i) i
sub output_boilerplate {
print <<'EOT';
-#ifdef __cplusplus
-extern "C" {
-#endif
-
#include "EXTERN.h"
#include "perl.h"
#ifndef PATCHLEVEL
#include "patchlevel.h"
#endif
-#ifdef __cplusplus
-}
-# define EXTERN_C extern "C"
-#else
-# define EXTERN_C extern
-#endif
-
/* Workaround for mapstart: the only op which needs a different ppaddr */
#undef pp_mapstart
#define pp_mapstart pp_grepstart
-#if PATCHLEVEL < 4
-#define vivify_ref(sv, to_what) provide_ref(op, sv)
-#endif
-
static void xs_init _((void));
static PerlInterpreter *my_perl;
EOT
PERL_SYS_INIT(&argc,&argv);
-#if PATCHLEVEL > 3 || (PATCHLEVEL == 3 && SUBVERSION >= 1)
perl_init_i18nl10n(1);
-#else
- perl_init_i18nl14n(1);
-#endif
if (!do_undump) {
my_perl = perl_alloc();
$ppname = shift;
$runtime_list_ref = [];
$declare_ref = {};
- runtime("dSP;");
+ runtime("djSP;");
declare("I32", "oldsave");
declare("SV", "**svp");
map { declare("SV", "*$_") } qw(sv src dst left right);
if ($private & OPpLVAL_INTRO) {
runtime("SAVECLEARSV(curpad[$ix]);");
} elsif ($private & OPpDEREF) {
- loadop($op) if $patchlevel < 4;
runtime(sprintf("vivify_ref(curpad[%d], %d);",
$ix, $private & OPpDEREF));
$pad[$ix]->invalidate;
write_back_lexicals(REGISTER|TEMPORARY);
write_back_stack();
my $sym = doop($op);
- runtime("if (op != ($sym)->op_next) op = (*op->op_ppaddr)();");
+ runtime("if (op != ($sym)->op_next) op = (*op->op_ppaddr)(ARGS);");
runtime("SPAGAIN;");
$know_op = 0;
invalidate_lexicals(REGISTER|TEMPORARY);
my $sym = doop($op);
# XXX Is this the right way to distinguish between it returning
# CvSTART(cv) (via doform) and pop_return()?
- runtime("if (op) op = (*op->op_ppaddr)();");
+ runtime("if (op) op = (*op->op_ppaddr)(ARGS);");
runtime("SPAGAIN;");
$know_op = 0;
invalidate_lexicals(REGISTER|TEMPORARY);
WriteMakefile(
NAME => "B",
- VERSION => "a4",
- OBJECT => "B.o ccop.o byterun.o",
+ VERSION => "a5",
+ OBJECT => "B.o byterun.o",
depend => {
- "B.o" => "B.c ccop.h bytecode.h byterun.h",
- "ccop.o" => "ccop.c ccop.h"
+ "B.o" => "B.c bytecode.h byterun.h",
},
clean => {
FILES => "perl byteperl btest btest.c *.o B.c *~"
# at the moment because a standlone Perl program needs to set up curpad
# which is overwritten on exit from an XSUB.
#
-byteperl: byteperl.o B.o ccop.o byterun.o
- $(CC) -o byteperl byteperl.o B.o ccop.o byterun.o $(LDFLAGS) -L$(PERL_ARCHLIB)/CORE -lperl $(LIBS)
+byteperl: byteperl.o B.o byterun.o
+ $(CC) -o byteperl byteperl.o B.o byterun.o $(LDFLAGS) -L$(PERL_ARCHLIB)/CORE -lperl $(LIBS)
EOT
}
if (-f "byterun.h") {
rename("byterun.h", "byterun.h.old");
}
-if (-f "Asmdata.pm") {
- rename("Asmdata.pm", "Asmdata.pm.old");
+if (-f "B/Asmdata.pm") {
+ rename("B/Asmdata.pm", "B/Asmdata.pm.old");
}
#
# Start with boilerplate for Asmdata.pm
#
-open(ASMDATA_PM, ">Asmdata.pm") or die "Asmdata.pm: $!";
+open(ASMDATA_PM, ">B/Asmdata.pm") or die "Asmdata.pm: $!";
print ASMDATA_PM $perl_header, <<'EOT';
package B::Asmdata;
use Exporter;
op_pmreplstart cPMOP->op_pmreplstart opindex
op_pmnext *(OP**)&cPMOP->op_pmnext opindex
pregcomp op pvcontents x
-op_pmshort cPMOP->op_pmshort svindex
op_pmflags cPMOP->op_pmflags U16
op_pmpermflags cPMOP->op_pmpermflags U16
-op_pmslen cPMOP->op_pmslen char
op_sv cSVOP->op_sv svindex
op_gv *(SV**)&cGVOP->op_gv svindex
op_pv cPVOP->op_pv pvcontents
-#ifdef __cplusplus
-extern "C" {
-#endif
-
#include "EXTERN.h"
#include "perl.h"
#ifndef PATCHLEVEL
#endif
#include "byterun.h"
-#ifdef __cplusplus
-}
-# define EXTERN_C extern "C"
-#else
-# define EXTERN_C extern
-#endif
-
static void xs_init _((void));
static PerlInterpreter *my_perl;
BSET_pregcomp(op, arg);
break;
}
- case INSN_OP_PMSHORT: /* 101 */
- {
- svindex arg;
- BGET_objindex(arg);
- cPMOP->op_pmshort = arg;
- break;
- }
- case INSN_OP_PMFLAGS: /* 102 */
+ case INSN_OP_PMFLAGS: /* 101 */
{
U16 arg;
BGET_U16(arg);
cPMOP->op_pmflags = arg;
break;
}
- case INSN_OP_PMPERMFLAGS: /* 103 */
+ case INSN_OP_PMPERMFLAGS: /* 102 */
{
U16 arg;
BGET_U16(arg);
cPMOP->op_pmpermflags = arg;
break;
}
- case INSN_OP_PMSLEN: /* 104 */
- {
- char arg;
- BGET_U8(arg);
- cPMOP->op_pmslen = arg;
- break;
- }
- case INSN_OP_SV: /* 105 */
+ case INSN_OP_SV: /* 103 */
{
svindex arg;
BGET_objindex(arg);
cSVOP->op_sv = arg;
break;
}
- case INSN_OP_GV: /* 106 */
+ case INSN_OP_GV: /* 104 */
{
svindex arg;
BGET_objindex(arg);
*(SV**)&cGVOP->op_gv = arg;
break;
}
- case INSN_OP_PV: /* 107 */
+ case INSN_OP_PV: /* 105 */
{
pvcontents arg;
BGET_pvcontents(arg);
cPVOP->op_pv = arg;
break;
}
- case INSN_OP_PV_TR: /* 108 */
+ case INSN_OP_PV_TR: /* 106 */
{
op_tr_array arg;
BGET_op_tr_array(arg);
cPVOP->op_pv = arg;
break;
}
- case INSN_OP_REDOOP: /* 109 */
+ case INSN_OP_REDOOP: /* 107 */
{
opindex arg;
BGET_objindex(arg);
cLOOP->op_redoop = arg;
break;
}
- case INSN_OP_NEXTOP: /* 110 */
+ case INSN_OP_NEXTOP: /* 108 */
{
opindex arg;
BGET_objindex(arg);
cLOOP->op_nextop = arg;
break;
}
- case INSN_OP_LASTOP: /* 111 */
+ case INSN_OP_LASTOP: /* 109 */
{
opindex arg;
BGET_objindex(arg);
cLOOP->op_lastop = arg;
break;
}
- case INSN_COP_LABEL: /* 112 */
+ case INSN_COP_LABEL: /* 110 */
{
pvcontents arg;
BGET_pvcontents(arg);
cCOP->cop_label = arg;
break;
}
- case INSN_COP_STASH: /* 113 */
+ case INSN_COP_STASH: /* 111 */
{
svindex arg;
BGET_objindex(arg);
*(SV**)&cCOP->cop_stash = arg;
break;
}
- case INSN_COP_FILEGV: /* 114 */
+ case INSN_COP_FILEGV: /* 112 */
{
svindex arg;
BGET_objindex(arg);
*(SV**)&cCOP->cop_filegv = arg;
break;
}
- case INSN_COP_SEQ: /* 115 */
+ case INSN_COP_SEQ: /* 113 */
{
U32 arg;
BGET_U32(arg);
cCOP->cop_seq = arg;
break;
}
- case INSN_COP_ARYBASE: /* 116 */
+ case INSN_COP_ARYBASE: /* 114 */
{
I32 arg;
BGET_I32(arg);
cCOP->cop_arybase = arg;
break;
}
- case INSN_COP_LINE: /* 117 */
+ case INSN_COP_LINE: /* 115 */
{
line_t arg;
BGET_U16(arg);
cCOP->cop_line = arg;
break;
}
- case INSN_MAIN_START: /* 118 */
+ case INSN_MAIN_START: /* 116 */
{
opindex arg;
BGET_objindex(arg);
main_start = arg;
break;
}
- case INSN_MAIN_ROOT: /* 119 */
+ case INSN_MAIN_ROOT: /* 117 */
{
opindex arg;
BGET_objindex(arg);
main_root = arg;
break;
}
- case INSN_CURPAD: /* 120 */
+ case INSN_CURPAD: /* 118 */
{
svindex arg;
BGET_objindex(arg);
INSN_OP_PMREPLSTART, /* 98 */
INSN_OP_PMNEXT, /* 99 */
INSN_PREGCOMP, /* 100 */
- INSN_OP_PMSHORT, /* 101 */
- INSN_OP_PMFLAGS, /* 102 */
- INSN_OP_PMPERMFLAGS, /* 103 */
- INSN_OP_PMSLEN, /* 104 */
- INSN_OP_SV, /* 105 */
- INSN_OP_GV, /* 106 */
- INSN_OP_PV, /* 107 */
- INSN_OP_PV_TR, /* 108 */
- INSN_OP_REDOOP, /* 109 */
- INSN_OP_NEXTOP, /* 110 */
- INSN_OP_LASTOP, /* 111 */
- INSN_COP_LABEL, /* 112 */
- INSN_COP_STASH, /* 113 */
- INSN_COP_FILEGV, /* 114 */
- INSN_COP_SEQ, /* 115 */
- INSN_COP_ARYBASE, /* 116 */
- INSN_COP_LINE, /* 117 */
- INSN_MAIN_START, /* 118 */
- INSN_MAIN_ROOT, /* 119 */
- INSN_CURPAD, /* 120 */
- MAX_INSN = 120
+ INSN_OP_PMFLAGS, /* 101 */
+ INSN_OP_PMPERMFLAGS, /* 102 */
+ INSN_OP_SV, /* 103 */
+ INSN_OP_GV, /* 104 */
+ INSN_OP_PV, /* 105 */
+ INSN_OP_PV_TR, /* 106 */
+ INSN_OP_REDOOP, /* 107 */
+ INSN_OP_NEXTOP, /* 108 */
+ INSN_OP_LASTOP, /* 109 */
+ INSN_COP_LABEL, /* 110 */
+ INSN_COP_STASH, /* 111 */
+ INSN_COP_FILEGV, /* 112 */
+ INSN_COP_SEQ, /* 113 */
+ INSN_COP_ARYBASE, /* 114 */
+ INSN_COP_LINE, /* 115 */
+ INSN_MAIN_START, /* 116 */
+ INSN_MAIN_ROOT, /* 117 */
+ INSN_CURPAD, /* 118 */
+ MAX_INSN = 118
};
enum {
use Config;
-$libdir = "$Config{installarchlib}/CORE";
+$libdir = $ENV{PERL_SRC} || "$Config{installarchlib}/CORE";
if (!grep(/^-[cS]$/, @ARGV)) {
$linkargs = sprintf("%s -L$libdir -lperl %s", @Config{qw(ldflags libs)});
-#define DOOP(ppname) PUTBACK; op = ppname(); SPAGAIN
+#define DOOP(ppname) PUTBACK; op = ppname(ARGS); SPAGAIN
#define PP_LIST(g) do { \
dMARK; \
SPAGAIN; \
} while(0)
-#if PATCHLEVEL < 3
-#define RUN() run()
-#else
-#define RUN() runops()
-#endif
-
-#if PATCHLEVEL > 3
/* Anyone using eval "" deserves this mess */
#define PP_EVAL(ppaddr, nxt) do { \
dJMPENV; \
JMPENV_PUSH(ret); \
switch (ret) { \
case 0: \
- op = ppaddr(); \
+ op = ppaddr(ARGS); \
retstack[retstack_ix - 1] = Nullop; \
- if (op != nxt) RUN(); \
+ if (op != nxt) runops(); \
JMPENV_POP; \
break; \
case 1: JMPENV_POP; JMPENV_JUMP(1); \
case 3: JMPENV_POP; SPAGAIN; goto label;\
} \
} while (0)
-#else
-/* Anyone using eval "" deserves this mess */
-#define PP_EVAL(ppaddr, nxt) do { \
- Sigjmp_buf oldtop; \
- Copy(top_env,oldtop,1,Sigjmp_buf); \
- PUTBACK; \
- switch (Sigsetjmp(top_env,1)) { \
- case 0: \
- op = ppaddr(); \
- retstack[retstack_ix - 1] = Nullop; \
- Copy(oldtop,top_env,1,Sigjmp_buf); \
- if (op != nxt) RUN(); \
- break; \
- case 1: Copy(oldtop,top_env,1,Sigjmp_buf); Siglongjmp(top_env,1); \
- case 2: Copy(oldtop,top_env,1,Sigjmp_buf); Siglongjmp(top_env,2); \
- case 3: \
- Copy(oldtop,top_env,1,Sigjmp_buf); \
- if (restartop != nxt) \
- Siglongjmp(top_env, 3); \
- } \
- op = nxt; \
- SPAGAIN; \
- } while (0)
-
-#define PP_ENTERTRY(jmpbuf,label) do { \
- Copy(top_env,jmpbuf,1,Sigjmp_buf); \
- switch (Sigsetjmp(top_env,1)) { \
- case 1: Copy(jmpbuf,top_env,1,Sigjmp_buf); Siglongjmp(top_env,1); \
- case 2: Copy(jmpbuf,top_env,1,Sigjmp_buf); Siglongjmp(top_env,2); \
- case 3: Copy(jmpbuf,top_env,1,Sigjmp_buf); SPAGAIN; goto label; \
- } \
- } while (0)
-#endif
"B::COP"
};
-static opclass
-cc_baseop(o)
-OP *o;
-{
- return OPc_BASEOP;
-}
-
-static opclass
-cc_unop(o)
-OP *o;
-{
- return OPc_UNOP;
-}
-
-static opclass
-cc_binop(o)
-OP *o;
-{
- return OPc_BINOP;
-}
-
-static opclass
-cc_logop(o)
-OP *o;
-{
- return OPc_LOGOP;
-}
-
-static opclass
-cc_condop(o)
-OP *o;
-{
- return OPc_CONDOP;
-}
-
-static opclass
-cc_listop(o)
-OP *o;
+opclass
+cc_opclass(o)
+OP * o;
{
- return OPc_LISTOP;
-}
+ if (!o)
+ return OPc_NULL;
-static opclass
-cc_pmop(o)
-OP *o;
-{
- return OPc_PMOP;
-}
+ if (o->op_type == 0)
+ return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
-static opclass
-cc_svop(o)
-OP *o;
-{
- return OPc_SVOP;
-}
+ if (o->op_type == OP_SASSIGN)
+ return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
-static opclass
-cc_gvop(o)
-OP *o;
-{
- return OPc_GVOP;
-}
-
-static opclass
-cc_pvop(o)
-OP *o;
-{
- return OPc_PVOP;
-}
+ switch (opargs[o->op_type] & OA_CLASS_MASK) {
+ case OA_BASEOP:
+ return OPc_BASEOP;
-static opclass
-cc_cvop(o)
-OP *o;
-{
- return OPc_CVOP;
-}
+ case OA_UNOP:
+ return OPc_UNOP;
-static opclass
-cc_loop(o)
-OP *o;
-{
- return OPc_LOOP;
-}
+ case OA_BINOP:
+ return OPc_BINOP;
-static opclass
-cc_cop(o)
-OP *o;
-{
- return OPc_COP;
-}
+ case OA_LOGOP:
+ return OPc_LOGOP;
-/* Nullified ops with children still need to be able to find o->op_first */
-static opclass
-cc_nullop(o)
-OP *o;
-{
- return ((o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP);
-}
+ case OA_CONDOP:
+ return OPc_CONDOP;
-static opclass
-cc_stub(o)
-OP *o;
-{
- warn("compiler stub for %s, assuming BASEOP\n", ppnames[o->op_type]);
- return OPc_BASEOP; /* XXX lie */
-}
+ case OA_LISTOP:
+ return OPc_LISTOP;
-/*
- * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on whether
- * bare parens were seen. perly.y uses OPf_SPECIAL to signal whether an
- * OP or an UNOP was chosen.
- * Frederic.Chauveau@pasteur.fr says we need to check for OPf_KIDS too.
- */
-static opclass
-cc_baseop_or_unop(o)
-OP *o;
-{
- return ((o->op_flags & OPf_SPECIAL) ? OPc_BASEOP :
- (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP);
-}
+ case OA_PMOP:
+ return OPc_PMOP;
-/*
- * The file stat OPs are created via UNI(OP_foo) in toke.c but use
- * the OPf_REF flag to distinguish between OP types instead of the
- * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
- * return OPc_UNOP so that walkoptree can find our children. If
- * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
- * (no argument to the operator) it's an OP; with OPf_REF set it's
- * a GVOP (and op_gv is the GV for the filehandle argument).
- */
-static opclass
-cc_filestatop(o)
-OP *o;
-{
- return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
- (o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP);
-}
+ case OA_SVOP:
+ return OPc_SVOP;
-/*
- * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
- * label was omitted (in which case it's a BASEOP) or else a term was
- * seen. In this last case, all except goto are definitely PVOP but goto
- * is either a PVOP (with an ordinary constant label), an UNOP with
- * OPf_STACKED (with a non-constant non-sub) or an UNOP for OP_REFGEN
- * (with goto &sub) in which case OPf_STACKED also seems to get set.
- */
+ case OA_GVOP:
+ return OPc_GVOP;
-static opclass
-cc_loopexop(o)
-OP *o;
-{
- if (o->op_flags & OPf_STACKED)
- return OPc_UNOP;
- else if (o->op_flags & OPf_SPECIAL)
- return OPc_BASEOP;
- else
+ case OA_PVOP:
return OPc_PVOP;
-}
-
-static opclass
-cc_sassign(o)
-OP *o;
-{
- return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
-}
-static opclass (*ccopaddr[])_((OP *o)) = {
- cc_nullop, /* null */
- cc_baseop, /* stub */
- cc_baseop_or_unop, /* scalar */
- cc_baseop, /* pushmark */
- cc_baseop, /* wantarray */
- cc_svop, /* const */
- cc_gvop, /* gvsv */
- cc_gvop, /* gv */
- cc_binop, /* gelem */
- cc_baseop, /* padsv */
- cc_baseop, /* padav */
- cc_baseop, /* padhv */
- cc_baseop, /* padany */
- cc_pmop, /* pushre */
- cc_unop, /* rv2gv */
- cc_unop, /* rv2sv */
- cc_unop, /* av2arylen */
- cc_unop, /* rv2cv */
- cc_svop, /* anoncode */
- cc_baseop_or_unop, /* prototype */
- cc_unop, /* refgen */
- cc_unop, /* srefgen */
- cc_baseop_or_unop, /* ref */
- cc_listop, /* bless */
- cc_baseop_or_unop, /* backtick */
- cc_listop, /* glob */
- cc_baseop_or_unop, /* readline */
- cc_stub, /* rcatline */
- cc_unop, /* regcmaybe */
- cc_logop, /* regcomp */
- cc_pmop, /* match */
- cc_pmop, /* subst */
- cc_logop, /* substcont */
- cc_pvop, /* trans */
- cc_sassign, /* sassign */
- cc_binop, /* aassign */
- cc_baseop_or_unop, /* chop */
- cc_baseop_or_unop, /* schop */
- cc_baseop_or_unop, /* chomp */
- cc_baseop_or_unop, /* schomp */
- cc_baseop_or_unop, /* defined */
- cc_baseop_or_unop, /* undef */
- cc_baseop_or_unop, /* study */
- cc_baseop_or_unop, /* pos */
- cc_unop, /* preinc */
- cc_unop, /* i_preinc */
- cc_unop, /* predec */
- cc_unop, /* i_predec */
- cc_unop, /* postinc */
- cc_unop, /* i_postinc */
- cc_unop, /* postdec */
- cc_unop, /* i_postdec */
- cc_binop, /* pow */
- cc_binop, /* multiply */
- cc_binop, /* i_multiply */
- cc_binop, /* divide */
- cc_binop, /* i_divide */
- cc_binop, /* modulo */
- cc_binop, /* i_modulo */
- cc_binop, /* repeat */
- cc_binop, /* add */
- cc_binop, /* i_add */
- cc_binop, /* subtract */
- cc_binop, /* i_subtract */
- cc_binop, /* concat */
- cc_listop, /* stringify */
- cc_binop, /* left_shift */
- cc_binop, /* right_shift */
- cc_binop, /* lt */
- cc_binop, /* i_lt */
- cc_binop, /* gt */
- cc_binop, /* i_gt */
- cc_binop, /* le */
- cc_binop, /* i_le */
- cc_binop, /* ge */
- cc_binop, /* i_ge */
- cc_binop, /* eq */
- cc_binop, /* i_eq */
- cc_binop, /* ne */
- cc_binop, /* i_ne */
- cc_binop, /* ncmp */
- cc_binop, /* i_ncmp */
- cc_binop, /* slt */
- cc_binop, /* sgt */
- cc_binop, /* sle */
- cc_binop, /* sge */
- cc_binop, /* seq */
- cc_binop, /* sne */
- cc_binop, /* scmp */
- cc_binop, /* bit_and */
- cc_binop, /* bit_xor */
- cc_binop, /* bit_or */
- cc_unop, /* negate */
- cc_unop, /* i_negate */
- cc_unop, /* not */
- cc_unop, /* complement */
- cc_listop, /* atan2 */
- cc_baseop_or_unop, /* sin */
- cc_baseop_or_unop, /* cos */
- cc_baseop_or_unop, /* rand */
- cc_baseop_or_unop, /* srand */
- cc_baseop_or_unop, /* exp */
- cc_baseop_or_unop, /* log */
- cc_baseop_or_unop, /* sqrt */
- cc_baseop_or_unop, /* int */
- cc_baseop_or_unop, /* hex */
- cc_baseop_or_unop, /* oct */
- cc_baseop_or_unop, /* abs */
- cc_baseop_or_unop, /* length */
- cc_listop, /* substr */
- cc_listop, /* vec */
- cc_listop, /* index */
- cc_listop, /* rindex */
- cc_listop, /* sprintf */
- cc_listop, /* formline */
- cc_baseop_or_unop, /* ord */
- cc_baseop_or_unop, /* chr */
- cc_listop, /* crypt */
- cc_baseop_or_unop, /* ucfirst */
- cc_baseop_or_unop, /* lcfirst */
- cc_baseop_or_unop, /* uc */
- cc_baseop_or_unop, /* lc */
- cc_baseop_or_unop, /* quotemeta */
- cc_unop, /* rv2av */
- cc_gvop, /* aelemfast */
- cc_binop, /* aelem */
- cc_listop, /* aslice */
- cc_baseop_or_unop, /* each */
- cc_baseop_or_unop, /* values */
- cc_baseop_or_unop, /* keys */
- cc_baseop_or_unop, /* delete */
- cc_baseop_or_unop, /* exists */
- cc_unop, /* rv2hv */
- cc_binop, /* helem */
- cc_listop, /* hslice */
- cc_listop, /* unpack */
- cc_listop, /* pack */
- cc_listop, /* split */
- cc_listop, /* join */
- cc_listop, /* list */
- cc_binop, /* lslice */
- cc_listop, /* anonlist */
- cc_listop, /* anonhash */
- cc_listop, /* splice */
- cc_listop, /* push */
- cc_baseop_or_unop, /* pop */
- cc_baseop_or_unop, /* shift */
- cc_listop, /* unshift */
- cc_listop, /* sort */
- cc_listop, /* reverse */
- cc_listop, /* grepstart */
- cc_logop, /* grepwhile */
- cc_listop, /* mapstart */
- cc_logop, /* mapwhile */
- cc_condop, /* range */
- cc_unop, /* flip */
- cc_unop, /* flop */
- cc_logop, /* and */
- cc_logop, /* or */
- cc_logop, /* xor */
- cc_condop, /* cond_expr */
- cc_logop, /* andassign */
- cc_logop, /* orassign */
- cc_unop, /* method */
- cc_unop, /* entersub */
- cc_unop, /* leavesub */
- cc_baseop_or_unop, /* caller */
- cc_listop, /* warn */
- cc_listop, /* die */
- cc_baseop_or_unop, /* reset */
- cc_listop, /* lineseq */
- cc_cop, /* nextstate */
- cc_cop, /* dbstate */
- cc_baseop, /* unstack */
- cc_baseop, /* enter */
- cc_listop, /* leave */
- cc_listop, /* scope */
- cc_loop, /* enteriter */
- cc_baseop, /* iter */
- cc_loop, /* enterloop */
- cc_binop, /* leaveloop */
- cc_listop, /* return */
- cc_loopexop, /* last */
- cc_loopexop, /* next */
- cc_loopexop, /* redo */
- cc_loopexop, /* dump */
- cc_loopexop, /* goto */
- cc_baseop_or_unop, /* exit */
- cc_listop, /* open */
- cc_baseop_or_unop, /* close */
- cc_listop, /* pipe_op */
- cc_baseop_or_unop, /* fileno */
- cc_baseop_or_unop, /* umask */
- cc_baseop_or_unop, /* binmode */
- cc_listop, /* tie */
- cc_baseop_or_unop, /* untie */
- cc_baseop_or_unop, /* tied */
- cc_listop, /* dbmopen */
- cc_baseop_or_unop, /* dbmclose */
- cc_listop, /* sselect */
- cc_listop, /* select */
- cc_baseop_or_unop, /* getc */
- cc_listop, /* read */
- cc_baseop_or_unop, /* enterwrite */
- cc_unop, /* leavewrite */
- cc_listop, /* prtf */
- cc_listop, /* print */
- cc_listop, /* sysopen */
-#if PATCHLEVEL > 3
- cc_listop, /* sysseek */
-#endif
- cc_listop, /* sysread */
- cc_listop, /* syswrite */
- cc_listop, /* send */
- cc_listop, /* recv */
- cc_baseop_or_unop, /* eof */
- cc_baseop_or_unop, /* tell */
- cc_listop, /* seek */
- cc_listop, /* truncate */
- cc_listop, /* fcntl */
- cc_listop, /* ioctl */
- cc_listop, /* flock */
- cc_listop, /* socket */
- cc_listop, /* sockpair */
- cc_listop, /* bind */
- cc_listop, /* connect */
- cc_listop, /* listen */
- cc_listop, /* accept */
- cc_listop, /* shutdown */
- cc_listop, /* gsockopt */
- cc_listop, /* ssockopt */
- cc_baseop_or_unop, /* getsockname */
- cc_baseop_or_unop, /* getpeername */
- cc_filestatop, /* lstat */
- cc_filestatop, /* stat */
- cc_filestatop, /* ftrread */
- cc_filestatop, /* ftrwrite */
- cc_filestatop, /* ftrexec */
- cc_filestatop, /* fteread */
- cc_filestatop, /* ftewrite */
- cc_filestatop, /* fteexec */
- cc_filestatop, /* ftis */
- cc_filestatop, /* fteowned */
- cc_filestatop, /* ftrowned */
- cc_filestatop, /* ftzero */
- cc_filestatop, /* ftsize */
- cc_filestatop, /* ftmtime */
- cc_filestatop, /* ftatime */
- cc_filestatop, /* ftctime */
- cc_filestatop, /* ftsock */
- cc_filestatop, /* ftchr */
- cc_filestatop, /* ftblk */
- cc_filestatop, /* ftfile */
- cc_filestatop, /* ftdir */
- cc_filestatop, /* ftpipe */
- cc_filestatop, /* ftlink */
- cc_filestatop, /* ftsuid */
- cc_filestatop, /* ftsgid */
- cc_filestatop, /* ftsvtx */
- cc_filestatop, /* fttty */
- cc_filestatop, /* fttext */
- cc_filestatop, /* ftbinary */
- cc_baseop_or_unop, /* chdir */
- cc_listop, /* chown */
- cc_baseop_or_unop, /* chroot */
- cc_listop, /* unlink */
- cc_listop, /* chmod */
- cc_listop, /* utime */
- cc_listop, /* rename */
- cc_listop, /* link */
- cc_listop, /* symlink */
- cc_baseop_or_unop, /* readlink */
- cc_listop, /* mkdir */
- cc_baseop_or_unop, /* rmdir */
- cc_listop, /* open_dir */
- cc_baseop_or_unop, /* readdir */
- cc_baseop_or_unop, /* telldir */
- cc_listop, /* seekdir */
- cc_baseop_or_unop, /* rewinddir */
- cc_baseop_or_unop, /* closedir */
- cc_baseop, /* fork */
- cc_baseop, /* wait */
- cc_listop, /* waitpid */
- cc_listop, /* system */
- cc_listop, /* exec */
- cc_listop, /* kill */
- cc_baseop, /* getppid */
- cc_baseop_or_unop, /* getpgrp */
- cc_listop, /* setpgrp */
- cc_listop, /* getpriority */
- cc_listop, /* setpriority */
- cc_baseop, /* time */
- cc_baseop, /* tms */
- cc_baseop_or_unop, /* localtime */
- cc_baseop_or_unop, /* gmtime */
- cc_baseop_or_unop, /* alarm */
- cc_baseop_or_unop, /* sleep */
- cc_listop, /* shmget */
- cc_listop, /* shmctl */
- cc_listop, /* shmread */
- cc_listop, /* shmwrite */
- cc_listop, /* msgget */
- cc_listop, /* msgctl */
- cc_listop, /* msgsnd */
- cc_listop, /* msgrcv */
- cc_listop, /* semget */
- cc_listop, /* semctl */
- cc_listop, /* semop */
- cc_baseop_or_unop, /* require */
- cc_unop, /* dofile */
- cc_baseop_or_unop, /* entereval */
- cc_unop, /* leaveeval */
- cc_logop, /* entertry */
- cc_listop, /* leavetry */
- cc_baseop_or_unop, /* ghbyname */
- cc_listop, /* ghbyaddr */
- cc_baseop, /* ghostent */
- cc_baseop_or_unop, /* gnbyname */
- cc_listop, /* gnbyaddr */
- cc_baseop, /* gnetent */
- cc_baseop_or_unop, /* gpbyname */
- cc_listop, /* gpbynumber */
- cc_baseop, /* gprotoent */
- cc_listop, /* gsbyname */
- cc_listop, /* gsbyport */
- cc_baseop, /* gservent */
- cc_baseop_or_unop, /* shostent */
- cc_baseop_or_unop, /* snetent */
- cc_baseop_or_unop, /* sprotoent */
- cc_baseop_or_unop, /* sservent */
- cc_baseop, /* ehostent */
- cc_baseop, /* enetent */
- cc_baseop, /* eprotoent */
- cc_baseop, /* eservent */
- cc_baseop_or_unop, /* gpwnam */
- cc_baseop_or_unop, /* gpwuid */
- cc_baseop, /* gpwent */
- cc_baseop, /* spwent */
- cc_baseop, /* epwent */
- cc_baseop_or_unop, /* ggrnam */
- cc_baseop_or_unop, /* ggrgid */
- cc_baseop, /* ggrent */
- cc_baseop, /* sgrent */
- cc_baseop, /* egrent */
- cc_baseop, /* getlogin */
- cc_listop, /* syscall */
-#if PATCHLEVEL > 4 || (PATCHLEVEL == 4 && SUBVERSION > 50)
- cc_baseop_or_unop, /* lock */
-#endif
-};
-
-opclass
-cc_opclass(o)
-OP * o;
-{
- return o ? (*ccopaddr[o->op_type])(o) : OPc_NULL;
+ case OA_LOOP:
+ return OPc_LOOP;
+
+ case OA_COP:
+ return OPc_COP;
+
+ case OA_BASEOP_OR_UNOP:
+ /*
+ * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
+ * whether bare parens were seen. perly.y uses OPf_SPECIAL to
+ * signal whether an OP or an UNOP was chosen.
+ * Frederic.Chauveau@pasteur.fr says we need to check for OPf_KIDS too.
+ */
+ return ((o->op_flags & OPf_SPECIAL) ? OPc_BASEOP :
+ (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP);
+
+ case OA_FILESTATOP:
+ /*
+ * The file stat OPs are created via UNI(OP_foo) in toke.c but use
+ * the OPf_REF flag to distinguish between OP types instead of the
+ * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
+ * return OPc_UNOP so that walkoptree can find our children. If
+ * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
+ * (no argument to the operator) it's an OP; with OPf_REF set it's
+ * a GVOP (and op_gv is the GV for the filehandle argument).
+ */
+ return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
+ (o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP);
+
+ case OA_LOOPEXOP:
+ /*
+ * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
+ * label was omitted (in which case it's a BASEOP) or else a term was
+ * seen. In this last case, all except goto are definitely PVOP but
+ * goto is either a PVOP (with an ordinary constant label), an UNOP
+ * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
+ * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
+ * get set.
+ */
+ if (o->op_flags & OPf_STACKED)
+ return OPc_UNOP;
+ else if (o->op_flags & OPf_SPECIAL)
+ return OPc_BASEOP;
+ else
+ return OPc_PVOP;
+ }
+ warn("can't determine class of operator %s, assuming BASEOP\n",
+ ppnames[o->op_type]);
+ return OPc_BASEOP;
}
char *
cc_opclassname(o)
OP * o;
{
- return opclassnames[o ? (*ccopaddr[o->op_type])(o) : OPc_NULL];
+ return opclassnames[cc_opclass(o)];
}
opclass cc_opclass _((OP *o));
char * cc_opclassname _((OP *o));
-
-#ifndef DOINIT
-EXT char *ppnames[];
-#else
-EXT char *ppnames[] = {
- "pp_null",
- "pp_stub",
- "pp_scalar",
- "pp_pushmark",
- "pp_wantarray",
- "pp_const",
- "pp_gvsv",
- "pp_gv",
- "pp_gelem",
- "pp_padsv",
- "pp_padav",
- "pp_padhv",
- "pp_padany",
- "pp_pushre",
- "pp_rv2gv",
- "pp_rv2sv",
- "pp_av2arylen",
- "pp_rv2cv",
- "pp_anoncode",
- "pp_prototype",
- "pp_refgen",
- "pp_srefgen",
- "pp_ref",
- "pp_bless",
- "pp_backtick",
- "pp_glob",
- "pp_readline",
- "pp_rcatline",
- "pp_regcmaybe",
- "pp_regcomp",
- "pp_match",
- "pp_subst",
- "pp_substcont",
- "pp_trans",
- "pp_sassign",
- "pp_aassign",
- "pp_chop",
- "pp_schop",
- "pp_chomp",
- "pp_schomp",
- "pp_defined",
- "pp_undef",
- "pp_study",
- "pp_pos",
- "pp_preinc",
- "pp_i_preinc",
- "pp_predec",
- "pp_i_predec",
- "pp_postinc",
- "pp_i_postinc",
- "pp_postdec",
- "pp_i_postdec",
- "pp_pow",
- "pp_multiply",
- "pp_i_multiply",
- "pp_divide",
- "pp_i_divide",
- "pp_modulo",
- "pp_i_modulo",
- "pp_repeat",
- "pp_add",
- "pp_i_add",
- "pp_subtract",
- "pp_i_subtract",
- "pp_concat",
- "pp_stringify",
- "pp_left_shift",
- "pp_right_shift",
- "pp_lt",
- "pp_i_lt",
- "pp_gt",
- "pp_i_gt",
- "pp_le",
- "pp_i_le",
- "pp_ge",
- "pp_i_ge",
- "pp_eq",
- "pp_i_eq",
- "pp_ne",
- "pp_i_ne",
- "pp_ncmp",
- "pp_i_ncmp",
- "pp_slt",
- "pp_sgt",
- "pp_sle",
- "pp_sge",
- "pp_seq",
- "pp_sne",
- "pp_scmp",
- "pp_bit_and",
- "pp_bit_xor",
- "pp_bit_or",
- "pp_negate",
- "pp_i_negate",
- "pp_not",
- "pp_complement",
- "pp_atan2",
- "pp_sin",
- "pp_cos",
- "pp_rand",
- "pp_srand",
- "pp_exp",
- "pp_log",
- "pp_sqrt",
- "pp_int",
- "pp_hex",
- "pp_oct",
- "pp_abs",
- "pp_length",
- "pp_substr",
- "pp_vec",
- "pp_index",
- "pp_rindex",
- "pp_sprintf",
- "pp_formline",
- "pp_ord",
- "pp_chr",
- "pp_crypt",
- "pp_ucfirst",
- "pp_lcfirst",
- "pp_uc",
- "pp_lc",
- "pp_quotemeta",
- "pp_rv2av",
- "pp_aelemfast",
- "pp_aelem",
- "pp_aslice",
- "pp_each",
- "pp_values",
- "pp_keys",
- "pp_delete",
- "pp_exists",
- "pp_rv2hv",
- "pp_helem",
- "pp_hslice",
- "pp_unpack",
- "pp_pack",
- "pp_split",
- "pp_join",
- "pp_list",
- "pp_lslice",
- "pp_anonlist",
- "pp_anonhash",
- "pp_splice",
- "pp_push",
- "pp_pop",
- "pp_shift",
- "pp_unshift",
- "pp_sort",
- "pp_reverse",
- "pp_grepstart",
- "pp_grepwhile",
- "pp_mapstart",
- "pp_mapwhile",
- "pp_range",
- "pp_flip",
- "pp_flop",
- "pp_and",
- "pp_or",
- "pp_xor",
- "pp_cond_expr",
- "pp_andassign",
- "pp_orassign",
- "pp_method",
- "pp_entersub",
- "pp_leavesub",
- "pp_caller",
- "pp_warn",
- "pp_die",
- "pp_reset",
- "pp_lineseq",
- "pp_nextstate",
- "pp_dbstate",
- "pp_unstack",
- "pp_enter",
- "pp_leave",
- "pp_scope",
- "pp_enteriter",
- "pp_iter",
- "pp_enterloop",
- "pp_leaveloop",
- "pp_return",
- "pp_last",
- "pp_next",
- "pp_redo",
- "pp_dump",
- "pp_goto",
- "pp_exit",
- "pp_open",
- "pp_close",
- "pp_pipe_op",
- "pp_fileno",
- "pp_umask",
- "pp_binmode",
- "pp_tie",
- "pp_untie",
- "pp_tied",
- "pp_dbmopen",
- "pp_dbmclose",
- "pp_sselect",
- "pp_select",
- "pp_getc",
- "pp_read",
- "pp_enterwrite",
- "pp_leavewrite",
- "pp_prtf",
- "pp_print",
- "pp_sysopen",
-#if PATCHLEVEL > 3
- "pp_sysseek",
-#endif
- "pp_sysread",
- "pp_syswrite",
- "pp_send",
- "pp_recv",
- "pp_eof",
- "pp_tell",
- "pp_seek",
- "pp_truncate",
- "pp_fcntl",
- "pp_ioctl",
- "pp_flock",
- "pp_socket",
- "pp_sockpair",
- "pp_bind",
- "pp_connect",
- "pp_listen",
- "pp_accept",
- "pp_shutdown",
- "pp_gsockopt",
- "pp_ssockopt",
- "pp_getsockname",
- "pp_getpeername",
- "pp_lstat",
- "pp_stat",
- "pp_ftrread",
- "pp_ftrwrite",
- "pp_ftrexec",
- "pp_fteread",
- "pp_ftewrite",
- "pp_fteexec",
- "pp_ftis",
- "pp_fteowned",
- "pp_ftrowned",
- "pp_ftzero",
- "pp_ftsize",
- "pp_ftmtime",
- "pp_ftatime",
- "pp_ftctime",
- "pp_ftsock",
- "pp_ftchr",
- "pp_ftblk",
- "pp_ftfile",
- "pp_ftdir",
- "pp_ftpipe",
- "pp_ftlink",
- "pp_ftsuid",
- "pp_ftsgid",
- "pp_ftsvtx",
- "pp_fttty",
- "pp_fttext",
- "pp_ftbinary",
- "pp_chdir",
- "pp_chown",
- "pp_chroot",
- "pp_unlink",
- "pp_chmod",
- "pp_utime",
- "pp_rename",
- "pp_link",
- "pp_symlink",
- "pp_readlink",
- "pp_mkdir",
- "pp_rmdir",
- "pp_open_dir",
- "pp_readdir",
- "pp_telldir",
- "pp_seekdir",
- "pp_rewinddir",
- "pp_closedir",
- "pp_fork",
- "pp_wait",
- "pp_waitpid",
- "pp_system",
- "pp_exec",
- "pp_kill",
- "pp_getppid",
- "pp_getpgrp",
- "pp_setpgrp",
- "pp_getpriority",
- "pp_setpriority",
- "pp_time",
- "pp_tms",
- "pp_localtime",
- "pp_gmtime",
- "pp_alarm",
- "pp_sleep",
- "pp_shmget",
- "pp_shmctl",
- "pp_shmread",
- "pp_shmwrite",
- "pp_msgget",
- "pp_msgctl",
- "pp_msgsnd",
- "pp_msgrcv",
- "pp_semget",
- "pp_semctl",
- "pp_semop",
- "pp_require",
- "pp_dofile",
- "pp_entereval",
- "pp_leaveeval",
- "pp_entertry",
- "pp_leavetry",
- "pp_ghbyname",
- "pp_ghbyaddr",
- "pp_ghostent",
- "pp_gnbyname",
- "pp_gnbyaddr",
- "pp_gnetent",
- "pp_gpbyname",
- "pp_gpbynumber",
- "pp_gprotoent",
- "pp_gsbyname",
- "pp_gsbyport",
- "pp_gservent",
- "pp_shostent",
- "pp_snetent",
- "pp_sprotoent",
- "pp_sservent",
- "pp_ehostent",
- "pp_enetent",
- "pp_eprotoent",
- "pp_eservent",
- "pp_gpwnam",
- "pp_gpwuid",
- "pp_gpwent",
- "pp_spwent",
- "pp_epwent",
- "pp_ggrnam",
- "pp_ggrgid",
- "pp_ggrent",
- "pp_sgrent",
- "pp_egrent",
- "pp_getlogin",
- "pp_syscall",
-#if PATCHLEVEL > 4 || (PATCHLEVEL == 4 && SUBVERSION > 50)
- "pp_lock",
-#endif
-};
-#endif
if [ -f bperl ]; then
perl=./bperl
else
- perl="perl -Iblib/arch"
+ perl="perl -Mblib"
+fi
+if [ "X$PERL_SRC" != "X" ]; then
+ testdir=$PERL_SRC/t
+else
+ testdir=t
fi
for pl in ${1+"$@"}
do
$perl -MO=C,-obtest.tc $pl \
&& mv btest.tc btest.c \
&& $perl cc_harness -o btest btest.c \
- && (cd t; $cwd/btest)
+ && (cd $testdir; $cwd/btest)
done
if [ -f bperl ]; then
perl=./bperl
else
- perl="perl -Iblib/arch"
+ perl="perl -Mblib"
+fi
+if [ "X$PERL_SRC" != "X" ]; then
+ testdir=$PERL_SRC/t
+else
+ testdir=t
fi
for pl in ${1+"$@"}
do
$perl -MO=CC,-obtest.tc $pl \
&& mv btest.tc btest.c \
&& $perl cc_harness -O2 -o btest btest.c\
- && (cd t; $cwd/btest)
+ && (cd $testdir; $cwd/btest)
done
projects / p5sagit/p5-mst-13.2.git / commitdiff