op.c revision 7c478bd95313f5f23a4c958a745db2134aa03244
/* op.c
*
* Copyright (c) 1991-2001, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
/*
* "You see: Mr. Drogo, he married poor Miss Primula Brandybuck. She was
* our Mr. Bilbo's first cousin on the mother's side (her mother being the
* youngest of the Old Took's daughters); and Mr. Drogo was his second
* cousin. So Mr. Frodo is his first *and* second cousin, once removed
* either way, as the saying is, if you follow me." --the Gaffer
*/
#include "EXTERN.h"
#define PERL_IN_OP_C
#include "perl.h"
#include "keywords.h"
/* #define PL_OP_SLAB_ALLOC */
#ifdef PL_OP_SLAB_ALLOC
#define SLAB_SIZE 8192
static int PL_OpSpace = 0;
else \
} while (0)
STATIC void *
{
return PL_OpPtr += PL_OpSpace;
}
#else
#endif
/*
* In the following definition, the ", Nullop" is just to make the compiler
* think the expression is of the right type: croak actually does a Siglongjmp.
*/
Nullop ) \
#define PAD_MAX 999999999
STATIC char*
{
}
{
PL_op_desc[o->op_type]));
return o;
}
{
return o;
}
{
return o;
}
STATIC void
{
}
STATIC void
{
"Bareword \"%s\" not allowed while \"strict subs\" in use",
SvPV_nolen(cSVOPo_sv)));
}
{
U8 *d;
*sp = d;
while (s < e) {
if (*s < 0x80 || *s == 0xff)
*d++ = *s++;
else {
U8 c = *s++;
*d++ = ((c >> 6) | 0xc0);
*d++ = ((c & 0x3f) | 0x80);
}
}
*ep = d;
return *sp;
}
/* "register" allocation */
{
{
/* 1999-02-27 mjd@plover.com */
char *p;
/* The next block assumes the buffer is at least 205 chars
long. At present, it's always at least 256 chars. */
if (p-name > 200) {
p = name+199;
}
else {
p[1] = '\0';
}
/* Move everything else down one character */
for (; p-name > 2; p--)
*p = *(p-1);
}
}
&& sv != &PL_sv_undef
{
"\"%s\" variable %s masks earlier declaration in same %s",
name,
--off;
break;
}
}
do {
&& sv != &PL_sv_undef
{
"\"our\" variable %s redeclared", name);
"\t(Did you mean \"local\" instead of \"our\"?)\n");
break;
}
} while ( off-- > 0 );
}
}
if (PL_in_my_stash) {
if (*name != '$')
}
}
if (!PL_min_intro_pending)
if (*name == '@')
else if (*name == '%')
return off;
}
{
}
}
return newoff;
}
{
register I32 i;
register PERL_CONTEXT *cx;
continue;
sv != &PL_sv_undef &&
{
if (!depth) {
if (newoff) {
continue;
return 0; /* don't clone from inactive stack frame */
}
depth = 1;
}
if (!newoff) { /* Not a mere clone operation. */
/* "It's closures all the way down." */
}
else {
{
/* install the missing pad entry in intervening
* nested subs and mark them cloneable.
* XXX fix pad_foo() to not use globals */
pad_addlex(sv);
}
else {
if (ckWARN(WARN_CLOSURE)
{
"Variable \"%s\" may be unavailable",
name);
}
break;
}
}
}
}
{
"Variable \"%s\" will not stay shared", name);
}
}
}
return newoff;
}
}
}
if (flags & FINDLEX_NOSEARCH)
return 0;
/* Nothing in current lexical context--try eval's context, if any.
* This is necessary to let the perldb get at lexically scoped variables.
* XXX This will also probably interact badly with eval tree caching.
*/
for (i = cx_ix; i >= 0; i--) {
default:
if (i == 0 && saweval) {
}
break;
case CXt_EVAL:
case OP_ENTEREVAL:
if (CxREALEVAL(cx)) {
saweval = i;
i-1, saweval, 0);
if (off) /* continue looking if not found here */
return off;
}
}
break;
case OP_DOFILE:
case OP_REQUIRE:
return 0;
}
break;
case CXt_FORMAT:
case CXt_SUB:
if (!saweval)
return 0;
saweval = i; /* so we know where we were called from */
continue;
}
}
}
return 0;
}
{
#ifdef USE_THREADS
/*
* Special case to get lexical (and hence per-thread) @_.
* XXX I need to find out how to tell at parse-time whether use
* of @_ should refer to a lexical (from a sub) or defgv (global
* scope and maybe weird sub-ish things like formats). See
* startsub in perly.y. It's possible that @_ could be lexical
* (at least from subs) even in non-threaded perl.
*/
return 0; /* success. (NOT_IN_PAD indicates failure) */
#endif /* USE_THREADS */
/* The one we're looking for is probably just before comppad_name_fill. */
sv != &PL_sv_undef &&
{
}
}
/* Check if if we're compiling an eval'', and adjust seq to be the
* eval's seq number. This depends on eval'' having a non-null
* CvOUTSIDE() while it is being compiled. The eval'' itself is
* identified by CvEVAL being true and CvGV being null. */
if (CxREALEVAL(cx))
}
/* See if it's in a nested scope */
if (off) {
/* If there is a pending local definition, this new alias must die */
if (pendoff)
return off; /* pad_findlex returns 0 for failure...*/
}
return NOT_IN_PAD; /* ...but we return NOT_IN_PAD for failure */
}
void
{
}
}
/* "Deintroduce" my variables that are leaving with this scope. */
}
}
{
if (PL_pad_reset_pending)
pad_reset();
do {
}
else {
for (;;) {
/*
* "foreach" index vars temporarily become aliases to non-"my"
* values. Thus we must skip, not just pad values that are
* marked as current pad values, but also those with names.
*/
if (++PL_padix <= names_fill &&
continue;
break;
}
}
#ifdef USE_THREADS
#else
#endif /* USE_THREADS */
}
SV *
{
#ifdef USE_THREADS
#else
if (!po)
#endif /* USE_THREADS */
}
void
{
if (!PL_curpad)
return;
if (!po)
#ifdef USE_THREADS
#else
#endif /* USE_THREADS */
#ifdef USE_ITHREADS
#endif
}
}
void
{
if (!po)
#ifdef USE_THREADS
#else
#endif /* USE_THREADS */
}
/* XXX pad_reset() is currently disabled because it results in serious bugs.
* It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
* on the stack by OPs that use them, there are several ways to get an alias
* to a shared TARG. Such an alias will change randomly and unpredictably.
* We avoid doing this until we can think of a Better Way.
* GSAR 97-10-29 */
void
{
#ifdef USE_BROKEN_PAD_RESET
#ifdef USE_THREADS
#else
#endif /* USE_THREADS */
if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
}
}
#endif
}
#ifdef USE_THREADS
/* find_threadsv is not reentrant */
{
char *p;
/* We currently only handle names of a single character */
if (!p)
return NOT_IN_PAD;
key = p - PL_threadsv_names;
if (svp)
else {
/*
* Some magic variables used to be automagically initialised
* in gv_fetchpv. Those which are now per-thread magicals get
* initialised here instead.
*/
switch (*name) {
case '_':
break;
case ';':
break;
case '&':
case '`':
case '\'':
/* FALL THROUGH */
case '1':
case '2':
case '3':
case '4':
case '5':
case '6':
case '7':
case '8':
case '9':
/* FALL THROUGH */
/* XXX %! tied to Errno.pm needs to be added here.
* See gv_fetchpv(). */
/* case '!': */
default:
}
"find_threadsv: new SV %p for $%s%c\n",
}
return key;
}
#endif /* USE_THREADS */
/* Destructor */
void
{
return;
if (o->op_private & OPpREFCOUNTED) {
switch (o->op_type) {
case OP_LEAVESUB:
case OP_LEAVESUBLV:
case OP_LEAVEEVAL:
case OP_LEAVE:
case OP_SCOPE:
case OP_LEAVEWRITE:
if (OpREFCNT_dec(o)) {
return;
}
break;
default:
break;
}
}
}
}
/* COP* is not cleared by op_clear() so that we may track line
* numbers etc even after null() */
op_clear(o);
#ifdef PL_OP_SLAB_ALLOC
if ((char *) o == PL_OpPtr)
{
}
#else
Safefree(o);
#endif
}
STATIC void
{
switch (o->op_type) {
case OP_NULL: /* Was holding old type, if any. */
case OP_ENTEREVAL: /* Was holding hints. */
#ifdef USE_THREADS
case OP_THREADSV: /* Was holding index into thr->threadsv AV. */
#endif
o->op_targ = 0;
break;
#ifdef USE_THREADS
case OP_ENTERITER:
if (!(o->op_flags & OPf_SPECIAL))
break;
/* FALL THROUGH */
#endif /* USE_THREADS */
default:
break;
/* FALL THROUGH */
case OP_GVSV:
case OP_GV:
case OP_AELEMFAST:
#ifdef USE_ITHREADS
if (PL_curpad) {
/* No GvIN_PAD_off(gv) here, because other references may still
* exist on the pad */
}
}
#else
#endif
break;
case OP_METHOD_NAMED:
case OP_CONST:
break;
case OP_GOTO:
case OP_NEXT:
case OP_LAST:
case OP_REDO:
break;
/* FALL THROUGH */
case OP_TRANS:
}
else {
}
break;
case OP_SUBST:
goto clear_pmop;
case OP_PUSHRE:
#ifdef USE_ITHREADS
if (PL_curpad) {
/* No GvIN_PAD_off(gv) here, because other references may still
* exist on the pad */
}
}
#else
#endif
/* FALL THROUGH */
case OP_MATCH:
case OP_QR:
break;
}
if (o->op_targ > 0) {
o->op_targ = 0;
}
}
STATIC void
{
#ifdef USE_ITHREADS
#else
/* NOTE: COP.cop_stash is not refcounted */
#endif
}
STATIC void
{
return;
op_clear(o);
}
/* Contextualizers */
OP *
{
if (o->op_next)
return o->op_next;
/* establish postfix order */
if (kid->op_sibling)
else
}
}
else
o->op_next = o;
return o->op_next;
}
OP *
{
}
return o;
}
{
if (ckWARN(WARN_SYNTAX)) {
if (PL_copline != NOLINE)
}
}
return scalar(o);
}
OP *
{
/* assumes no premature commitment */
{
return o;
}
switch (o->op_type) {
case OP_REPEAT:
if (o->op_private & OPpREPEAT_DOLIST)
break;
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
break;
case OP_SPLIT:
if (!kPMOP->op_pmreplroot)
deprecate("implicit split to @_");
}
/* FALL THROUGH */
case OP_MATCH:
case OP_QR:
case OP_SUBST:
case OP_NULL:
default:
}
break;
case OP_LEAVE:
case OP_LEAVETRY:
if (kid->op_sibling)
else
}
break;
case OP_SCOPE:
case OP_LINESEQ:
case OP_LIST:
if (kid->op_sibling)
else
}
break;
}
return o;
}
OP *
{
char* useless = 0;
if (o->op_type == OP_NEXTSTATE
|| o->op_type == OP_SETSTATE
|| o->op_type == OP_DBSTATE
|| o->op_targ == OP_SETSTATE
|| o->op_targ == OP_DBSTATE)))
/* assumes no premature commitment */
{
return o;
}
if ((o->op_private & OPpTARGET_MY)
{
return scalar(o); /* As if inside SASSIGN */
}
switch (o->op_type) {
default:
break;
/* FALL THROUGH */
case OP_REPEAT:
if (o->op_flags & OPf_STACKED)
break;
goto func_ops;
case OP_SUBSTR:
if (o->op_private == 4)
break;
/* FALL THROUGH */
case OP_GVSV:
case OP_WANTARRAY:
case OP_GV:
case OP_PADSV:
case OP_PADAV:
case OP_PADHV:
case OP_PADANY:
case OP_AV2ARYLEN:
case OP_REF:
case OP_REFGEN:
case OP_SREFGEN:
case OP_DEFINED:
case OP_HEX:
case OP_OCT:
case OP_LENGTH:
case OP_VEC:
case OP_INDEX:
case OP_RINDEX:
case OP_SPRINTF:
case OP_AELEM:
case OP_AELEMFAST:
case OP_ASLICE:
case OP_HELEM:
case OP_HSLICE:
case OP_UNPACK:
case OP_PACK:
case OP_JOIN:
case OP_LSLICE:
case OP_ANONLIST:
case OP_ANONHASH:
case OP_SORT:
case OP_REVERSE:
case OP_RANGE:
case OP_FLIP:
case OP_FLOP:
case OP_CALLER:
case OP_FILENO:
case OP_EOF:
case OP_TELL:
case OP_GETSOCKNAME:
case OP_GETPEERNAME:
case OP_READLINK:
case OP_TELLDIR:
case OP_GETPPID:
case OP_GETPGRP:
case OP_GETPRIORITY:
case OP_TIME:
case OP_TMS:
case OP_LOCALTIME:
case OP_GMTIME:
case OP_GHBYNAME:
case OP_GHBYADDR:
case OP_GHOSTENT:
case OP_GNBYNAME:
case OP_GNBYADDR:
case OP_GNETENT:
case OP_GPBYNAME:
case OP_GPBYNUMBER:
case OP_GPROTOENT:
case OP_GSBYNAME:
case OP_GSBYPORT:
case OP_GSERVENT:
case OP_GPWNAM:
case OP_GPWUID:
case OP_GGRNAM:
case OP_GGRGID:
case OP_GETLOGIN:
break;
case OP_RV2GV:
case OP_RV2SV:
case OP_RV2AV:
case OP_RV2HV:
useless = "a variable";
break;
case OP_CONST:
else {
useless = "a constant";
useless = 0;
useless = 0;
}
}
}
null(o); /* don't execute or even remember it */
break;
case OP_POSTINC:
break;
case OP_POSTDEC:
break;
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
break;
case OP_NULL:
if (o->op_flags & OPf_STACKED)
break;
/* FALL THROUGH */
case OP_NEXTSTATE:
case OP_DBSTATE:
case OP_ENTERTRY:
case OP_ENTER:
break;
/* FALL THROUGH */
case OP_SCOPE:
case OP_LEAVE:
case OP_LEAVETRY:
case OP_LEAVELOOP:
case OP_LINESEQ:
case OP_LIST:
break;
case OP_ENTEREVAL:
scalarkids(o);
break;
case OP_REQUIRE:
/* all requires must return a boolean value */
/* FALL THROUGH */
case OP_SCALAR:
return scalar(o);
case OP_SPLIT:
if (!kPMOP->op_pmreplroot)
deprecate("implicit split to @_");
}
break;
}
return o;
}
OP *
{
}
return o;
}
OP *
{
/* assumes no premature commitment */
{
return o;
}
if ((o->op_private & OPpTARGET_MY)
{
return o; /* As if inside SASSIGN */
}
switch (o->op_type) {
case OP_FLOP:
case OP_REPEAT:
break;
case OP_OR:
case OP_AND:
case OP_COND_EXPR:
break;
default:
case OP_MATCH:
case OP_QR:
case OP_SUBST:
case OP_NULL:
break;
return gen_constant_list(o);
}
case OP_LIST:
listkids(o);
break;
case OP_LEAVE:
case OP_LEAVETRY:
if (kid->op_sibling)
else
}
break;
case OP_SCOPE:
case OP_LINESEQ:
if (kid->op_sibling)
else
}
break;
case OP_REQUIRE:
/* all requires must return a boolean value */
return scalar(o);
}
return o;
}
OP *
{
if (o) {
if (o->op_type == OP_LINESEQ ||
o->op_type == OP_LEAVETRY)
{
if (kid->op_sibling) {
}
}
}
o->op_flags &= ~OPf_PARENS;
if (PL_hints & HINT_BLOCK_SCOPE)
o->op_flags |= OPf_PARENS;
}
else
return o;
}
{
}
return o;
}
OP *
{
if (!o || PL_error_count)
return o;
if ((o->op_private & OPpTARGET_MY)
{
return o;
}
switch (o->op_type) {
case OP_UNDEF:
PL_modcount++;
return o;
case OP_CONST:
if (!(o->op_private & (OPpCONST_ARYBASE)))
goto nomod;
PL_eval_start = 0;
}
else if (!type) {
PL_compiling.cop_arybase = 0;
}
goto nomod;
else
break;
case OP_STUB:
if (o->op_flags & OPf_PARENS)
break;
goto nomod;
case OP_ENTERSUB:
!(o->op_flags & OPf_STACKED)) {
break;
}
else { /* lvalue subroutine call */
o->op_private |= OPpLVAL_INTRO;
/* Backward compatibility mode: */
o->op_private |= OPpENTERSUB_INARGS;
break;
}
else { /* Compile-time error message: */
goto skip_kids;
"panic: unexpected lvalue entersub "
while (kid->op_sibling)
/* Indirect call */
{
yyerror("panic: unexpected optree near method call");
break;
}
break;
}
"panic: unexpected lvalue entersub "
break; /* Postpone until runtime */
}
"Unexpected constant lvalue entersub "
/* Restore RV2CV to check lvalueness */
}
else
break;
}
if (!cv)
goto restore_2cv;
break;
}
}
/* FALL THROUGH */
default:
/* grep, foreach, subcalls, refgen */
break;
? "do block"
: (o->op_type == OP_ENTERSUB
? "non-lvalue subroutine call"
: PL_op_desc[o->op_type])),
return o;
case OP_PREINC:
case OP_PREDEC:
case OP_POW:
case OP_MULTIPLY:
case OP_DIVIDE:
case OP_MODULO:
case OP_REPEAT:
case OP_ADD:
case OP_SUBTRACT:
case OP_CONCAT:
case OP_LEFT_SHIFT:
case OP_RIGHT_SHIFT:
case OP_BIT_AND:
case OP_BIT_XOR:
case OP_BIT_OR:
case OP_I_MULTIPLY:
case OP_I_DIVIDE:
case OP_I_MODULO:
case OP_I_ADD:
case OP_I_SUBTRACT:
if (!(o->op_flags & OPf_STACKED))
goto nomod;
PL_modcount++;
break;
case OP_COND_EXPR:
break;
case OP_RV2AV:
case OP_RV2HV:
return o; /* Treat \(@foo) like ordinary list. */
}
/* FALL THROUGH */
case OP_RV2GV:
if (scalar_mod_type(o, type))
goto nomod;
/* FALL THROUGH */
case OP_ASLICE:
case OP_HSLICE:
if (type == OP_LEAVESUBLV)
o->op_private |= OPpMAYBE_LVSUB;
/* FALL THROUGH */
case OP_AASSIGN:
case OP_NEXTSTATE:
case OP_DBSTATE:
case OP_CHOMP:
break;
case OP_RV2SV:
/* FALL THROUGH */
case OP_GV:
case OP_AV2ARYLEN:
case OP_SASSIGN:
case OP_ANDASSIGN:
case OP_ORASSIGN:
case OP_AELEMFAST:
PL_modcount++;
break;
case OP_PADAV:
case OP_PADHV:
return o; /* Treat \(@foo) like ordinary list. */
if (scalar_mod_type(o, type))
goto nomod;
if (type == OP_LEAVESUBLV)
o->op_private |= OPpMAYBE_LVSUB;
/* FALL THROUGH */
case OP_PADSV:
PL_modcount++;
if (!type)
break;
#ifdef USE_THREADS
case OP_THREADSV:
PL_modcount++; /* XXX ??? */
break;
#endif /* USE_THREADS */
case OP_PUSHMARK:
break;
case OP_KEYS:
if (type != OP_SASSIGN)
goto nomod;
goto lvalue_func;
case OP_SUBSTR:
goto nomod;
/* FALL THROUGH */
case OP_POS:
case OP_VEC:
if (type == OP_LEAVESUBLV)
o->op_private |= OPpMAYBE_LVSUB;
break;
case OP_AELEM:
case OP_HELEM:
if (type == OP_ENTERSUB &&
o->op_private |= OPpLVAL_DEFER;
if (type == OP_LEAVESUBLV)
o->op_private |= OPpMAYBE_LVSUB;
PL_modcount++;
break;
case OP_SCOPE:
case OP_LEAVE:
case OP_ENTER:
case OP_LINESEQ:
break;
case OP_NULL:
goto nomod;
break;
break;
}
/* FALL THROUGH */
case OP_LIST:
break;
case OP_RETURN:
if (type != OP_LEAVESUBLV)
goto nomod;
break; /* mod()ing was handled by ck_return() */
}
/* [20011101.069] File test operators interpret OPf_REF to mean that
their argument is a filehandle; thus \stat(".") should not set
it. AMS 20011102 */
return o;
if (type != OP_LEAVESUBLV)
else if (!type) {
o->op_private |= OPpLVAL_INTRO;
o->op_flags &= ~OPf_SPECIAL;
}
&& type != OP_LEAVESUBLV)
return o;
}
STATIC bool
{
switch (type) {
case OP_SASSIGN:
return FALSE;
/* FALL THROUGH */
case OP_PREINC:
case OP_PREDEC:
case OP_POSTINC:
case OP_POSTDEC:
case OP_I_PREINC:
case OP_I_PREDEC:
case OP_I_POSTINC:
case OP_I_POSTDEC:
case OP_POW:
case OP_MULTIPLY:
case OP_DIVIDE:
case OP_MODULO:
case OP_REPEAT:
case OP_ADD:
case OP_SUBTRACT:
case OP_I_MULTIPLY:
case OP_I_DIVIDE:
case OP_I_MODULO:
case OP_I_ADD:
case OP_I_SUBTRACT:
case OP_LEFT_SHIFT:
case OP_RIGHT_SHIFT:
case OP_BIT_AND:
case OP_BIT_XOR:
case OP_BIT_OR:
case OP_CONCAT:
case OP_SUBST:
case OP_TRANS:
case OP_READ:
case OP_SYSREAD:
case OP_RECV:
case OP_ANDASSIGN:
case OP_ORASSIGN:
return TRUE;
default:
return FALSE;
}
}
STATIC bool
{
switch (o->op_type) {
case OP_PIPE_OP:
case OP_SOCKPAIR:
if (argnum == 2)
return TRUE;
/* FALL THROUGH */
case OP_SYSOPEN:
case OP_OPEN:
case OP_SELECT: /* XXX c.f. SelectSaver.pm */
case OP_SOCKET:
case OP_OPEN_DIR:
case OP_ACCEPT:
if (argnum == 1)
return TRUE;
/* FALL THROUGH */
default:
return FALSE;
}
}
OP *
{
}
return o;
}
OP *
{
if (!o || PL_error_count)
return o;
switch (o->op_type) {
case OP_ENTERSUB:
!(o->op_flags & OPf_STACKED)) {
o->op_flags |= OPf_SPECIAL;
}
break;
case OP_COND_EXPR:
break;
case OP_RV2SV:
if (type == OP_DEFINED)
/* FALL THROUGH */
case OP_PADSV:
: OPpDEREF_SV);
}
break;
case OP_THREADSV:
break;
case OP_RV2AV:
case OP_RV2HV:
/* FALL THROUGH */
case OP_RV2GV:
if (type == OP_DEFINED)
break;
case OP_PADAV:
case OP_PADHV:
break;
case OP_SCALAR:
case OP_NULL:
break;
break;
case OP_AELEM:
case OP_HELEM:
: OPpDEREF_SV);
}
break;
case OP_SCOPE:
case OP_LEAVE:
case OP_ENTER:
case OP_LIST:
break;
break;
default:
break;
}
return scalar(o);
}
{
/* An attrlist is either a simple OP_CONST or an OP_LIST with kids,
* where the first kid is OP_PUSHMARK and the remaining ones
* are OP_CONST. We need to push the OP_CONST values.
*/
else {
}
}
return rop;
}
STATIC void
{
/* fake up C<use attributes $pkg,$rv,@attrs> */
ENTER; /* need to protect against side-effects of 'use' */
else
#define ATTRSMODULE "attributes"
dup_attrlist(attrs))));
}
void
{
if (!len) {
}
while (len) {
if (len) {
}
}
attrs)));
}
{
if (!o || PL_error_count)
return o;
return o;
o->op_private |= OPpOUR_INTRO;
return o;
type != OP_PUSHMARK)
{
PL_op_desc[o->op_type],
return o;
}
/* check for C<my Dog $spot> when deciding package */
else
stash = PL_curstash;
}
o->op_private |= OPpLVAL_INTRO;
return o;
}
OP *
{
if (o->op_flags & OPf_PARENS)
list(o);
if (attrs)
return o;
}
OP *
{
}
OP *
{
if (o)
o->op_flags |= OPf_PARENS;
return o;
}
OP *
{
OP *o;
? "@array" : "%hash");
"Applying %s to %s will act on scalar(%s)",
}
else
return o;
}
else
}
OP *
{
if (!o)
return o;
/* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */
}
OP *
{
if (o) {
}
else {
if (o->op_type == OP_LINESEQ) {
}
else
}
}
return o;
}
void
{
}
int
{
int retval = PL_savestack_ix;
if (full)
if (PL_comppad_name_floor < 0)
PL_min_intro_pending = 0;
SAVEHINTS();
PL_hints &= ~HINT_BLOCK_SCOPE;
}
return retval;
}
OP*
{
if (needblockscope)
return retval;
}
{
#ifdef USE_THREADS
return o;
#else
#endif /* USE_THREADS */
}
void
{
if (PL_in_eval) {
if (PL_eval_root)
return;
((PL_in_eval & EVAL_KEEPERR)
? OPf_SPECIAL : 0), o);
PL_eval_root->op_next = 0;
}
else {
if (!o)
return;
PL_main_root->op_next = 0;
PL_compcv = 0;
/* Register with debugger */
if (PERLDB_INTER) {
if (cv) {
dSP;
}
}
}
}
OP *
{
if (o->op_flags & OPf_PARENS)
list(o);
else {
char *s;
if (*s == ';' || *s == '=')
"Parentheses missing around \"%s\" list",
}
}
if (lex)
o = my(o);
else
return o;
}
OP *
{
#ifdef USE_THREADS
#else
#endif /* USE_THREADS */
}
return o;
}
OP *
{
scalar(o);
/* integerize op, unless it happens to be C<-foo>.
* XXX should pp_i_negate() do magic string negation instead? */
{
}
goto nope;
switch (type) {
case OP_NEGATE:
/* XXX might want a ck_negate() for this */
break;
case OP_SPRINTF:
case OP_UCFIRST:
case OP_LCFIRST:
case OP_UC:
case OP_LC:
case OP_SLT:
case OP_SGT:
case OP_SLE:
case OP_SGE:
case OP_SCMP:
/* XXX what about the numeric ops? */
if (PL_hints & HINT_LOCALE)
goto nope;
}
if (PL_error_count)
goto nope; /* Don't try to run w/ errors */
{
goto nope;
}
}
o->op_next = 0;
sv = *(PL_stack_sp--);
(void)SvREFCNT_inc(sv);
SvTEMP_off(sv);
}
op_free(o);
else {
/* try to smush double to int, but don't smush -2.0 to -2 */
{
}
else
}
}
nope:
return o;
if (!(PL_hints & HINT_INTEGER)) {
{
return o;
}
continue;
return o;
}
continue;
return o;
}
}
return o;
}
OP *
{
list(o);
if (PL_error_count)
return o; /* Don't attempt to run with errors */
o->op_next = 0;
pp_pushmark();
pp_anonlist();
linklist(o);
return list(o);
}
OP *
{
else
return o;
return fold_constants(o);
}
/* List constructors */
OP *
{
if (!first)
return last;
if (!last)
return first;
{
}
else {
}
return first;
}
OP *
{
if (!first)
if (!last)
#ifdef PL_OP_SLAB_ALLOC
#else
#endif
}
OP *
{
if (!first)
return last;
if (!last)
return first;
}
else {
}
}
return last;
}
}
/* Constructors */
OP *
{
}
OP *
{
null(o);
return o;
}
OP *
{
else if (first)
if (!last)
}
}
OP *
{
OP *o;
o->op_next = o;
scalar(o);
}
OP *
{
if (!first)
}
OP *
{
if (!first)
if (!last) {
}
else {
}
}
static int
utf8compare(const void *a, const void *b)
{
int i;
for (i = 0; i < 10; i++) {
return -1;
return 1;
}
return 0;
}
OP *
{
register I32 i;
register I32 j;
register short *tbl;
o->op_private |= OPpTRANS_FROM_UTF;
o->op_private |= OPpTRANS_TO_UTF;
if (complement) {
i = 0;
while (t < tend) {
cp[i++] = t;
t += UTF8SKIP(t);
if (t < tend && *t == 0xff) {
t++;
t += UTF8SKIP(t);
}
}
for (j = 0; j < i; j++) {
s += ulen;
if (diff > 0) {
if (diff > 1) {
}
}
if (s < tend && *s == 0xff)
}
}
}
if (!squash) {
if (t == r ||
{
o->op_private |= OPpTRANS_IDENTICAL;
}
}
/* see if we need more "t" chars */
t += ulen;
t++;
t += ulen;
}
else
}
/* now see if we need more "r" chars */
if (r < rend) {
r += ulen;
r++;
r += ulen;
}
else
}
else {
if (!havefinal++)
}
}
/* now see which range will peter our first, if either. */
else
if (rfirst == 0xffffffff) {
if (diff > 0)
else
}
else {
if (diff > 0)
(long)rfirst);
else
if (!grows)
}
}
if (del)
if (max > 0xffff)
bits = 32;
else if (max > 0xff)
bits = 16;
else
bits = 8;
if (transv)
if (grows)
o->op_private |= OPpTRANS_GROWS;
if (tsave)
if (rsave)
return o;
}
if (complement) {
for (i = 0; i < tlen; i++)
tbl[t[i]] = -1;
for (i = 0, j = 0; i < 256; i++) {
if (!tbl[i]) {
if (j >= rlen) {
if (del)
tbl[i] = -2;
else if (rlen)
tbl[i] = r[j-1];
else
tbl[i] = i;
}
else {
if (i < 128 && r[j] >= 128)
grows = 1;
tbl[i] = r[j++];
}
}
}
}
else {
if (!squash)
o->op_private |= OPpTRANS_IDENTICAL;
}
for (i = 0; i < 256; i++)
tbl[i] = -1;
for (i = 0, j = 0; i < tlen; i++,j++) {
if (j >= rlen) {
if (del) {
if (tbl[t[i]] == -1)
tbl[t[i]] = -2;
continue;
}
--j;
}
if (tbl[t[i]] == -1) {
if (t[i] < 128 && r[j] >= 128)
grows = 1;
tbl[t[i]] = r[j];
}
}
}
if (grows)
o->op_private |= OPpTRANS_GROWS;
return o;
}
OP *
{
if (PL_hints & HINT_RE_TAINT)
if (PL_hints & HINT_LOCALE)
/* link into pm list */
}
}
OP *
{
I32 repl_has_vars = 0;
}
}
else {
: OP_REGCMAYBE),0,expr);
? (OPf_SPECIAL | OPf_KIDS)
: OPf_KIDS);
/* establish postfix order */
}
else {
}
}
if (repl) {
curop = 0;
}
#ifdef USE_THREADS
&& strchr("&`'123456789+",
{
curop = 0;
}
#endif /* USE_THREADS */
else {
#ifdef USE_THREADS
repl_has_vars = 1;
break;
}
#else
repl_has_vars = 1;
break;
}
#endif /* USE_THREADS */
break;
break;
}
repl_has_vars = 1;
}
; /* Okay here, dangerous in newASSIGNOP */
else
break;
}
}
}
&& !(repl_has_vars
&& (!pm->op_pmregexp
}
else {
}
/* establish postfix order */
}
}
}
OP *
{
}
OP *
{
}
OP *
{
#ifdef USE_ITHREADS
#else
#endif
}
OP *
{
}
void
{
if (o) {
char *name;
op_free(o);
}
else {
}
PL_copline = NOLINE;
}
void
{
}
else {
/* Make copy of id so we don't free it twice */
/* Fake up a method call to VERSION */
}
}
}
else {
/* Make copy of id so we don't free it twice */
}
/* Fake up a require, handle override, if any */
gv))))));
}
else {
}
/* Fake up the BEGIN {}, which does its thing immediately. */
PL_copline = NOLINE;
}
void
{
}
#ifdef PERL_IMPLICIT_CONTEXT
void
{
dTHX;
}
#endif
void
{
if (ver) {
}
else
if (flags & PERL_LOADMOD_NOIMPORT) {
}
else if (flags & PERL_LOADMOD_IMPORT_OPS) {
}
else {
while (sv) {
}
}
{
}
}
OP *
{
gv))))));
}
else {
}
return doop;
}
OP *
{
}
{
if (!o)
return TRUE;
if (o->op_type == OP_COND_EXPR) {
if (t && f)
return TRUE;
if (t || f)
yyerror("Assignment to both a list and a scalar");
return FALSE;
}
return TRUE;
return TRUE;
return FALSE;
return FALSE;
}
OP *
{
OP *o;
if (optype) {
}
else {
}
}
if (list_assignment(left)) {
PL_modcount = 0;
if (PL_eval_start)
PL_eval_start = 0;
else {
return Nullop;
}
{
o->op_private |= OPpASSIGN_HASH;
break;
}
}
break;
}
break;
}
break;
break;
}
#ifdef USE_ITHREADS
#else
#endif
break;
}
}
else
break;
}
}
if (curop != o)
o->op_private |= OPpASSIGN_COMMON;
}
{
!(o->op_private & OPpASSIGN_COMMON) )
{
#ifdef USE_ITHREADS
#else
#endif
op_free(o); /* blow off assign */
/* "I don't know and I don't care." */
return right;
}
}
else {
if (PL_modcount < RETURN_UNLIMITED_NUMBER &&
{
}
}
}
}
return o;
}
if (!right)
}
else {
if (PL_eval_start)
PL_eval_start = 0;
else {
op_free(o);
return Nullop;
}
}
return o;
}
OP *
{
}
else {
}
#ifdef NATIVE_HINTS
#endif
if (label) {
}
else
if (PL_copline == NOLINE)
else {
PL_copline = NOLINE;
}
#ifdef USE_ITHREADS
#else
#endif
}
}
}
/* "Introduce" my variables to visible status. */
{
I32 i;
if (! PL_min_intro_pending)
return PL_cop_seqmax;
for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
}
}
PL_min_intro_pending = 0;
return PL_cop_seqmax++;
}
OP *
{
}
{
OP *o;
/* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
else
o = first;
if (o->op_next)
op_free(o);
}
}
return other;
}
else {
return first;
}
}
else
}
{
case OP_NULL:
{
}
break;
case OP_SASSIGN:
{
}
break;
}
if (warnop) {
"Value of %s%s can be \"0\"; test with defined()",
? " construct" : "() operator"));
}
}
if (!other)
return first;
/* establish postfix order */
return o;
}
OP *
{
OP *o;
if (!falseop)
if (!trueop)
return trueop;
}
else {
return falseop;
}
}
}
/* establish postfix order */
return o;
}
OP *
{
OP *o;
linklist(o); /* blow off optimizer unless constant */
return o;
}
OP *
{
OP* o;
if (expr) {
return block; /* do {} while 0 does once */
case OP_NULL:
break;
case OP_SASSIGN:
break;
}
}
}
if (listop)
if (o == listop)
o = scope(o);
return o;
}
OP *
Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *block, OP *cont)
{
OP *o;
case OP_NULL:
break;
case OP_SASSIGN:
break;
}
}
if (!block)
else if (cont) {
}
if (cont) {
}
if (expr) {
if (!next)
}
}
if (expr) {
return Nullop; /* listop already freed by new_logop */
}
if (listop)
}
else
o = listop;
if (!loop) {
loop->op_private = 0;
}
o->op_private |= loopflags;
if (next)
else
return o;
}
OP *
{
int padoff = 0;
if (sv) {
}
}
iterflags |= OPf_SPECIAL;
}
else
}
else {
#ifdef USE_THREADS
iterflags |= OPf_SPECIAL;
#else
#endif
}
iterflags |= OPf_STACKED;
}
{
/* Basically turn for($x..$y) into the same as for($x,$y), but we
* set the STACKED flag to indicate that these values are to be
*/
iterflags |= OPf_STACKED;
}
else {
}
#ifdef PL_OP_SLAB_ALLOC
{
}
#else
#endif
}
OP*
{
OP *o;
/* "last()" means "last" */
else {
: ""));
}
}
else {
}
return o;
}
void
{
#ifdef USE_THREADS
}
#endif /* USE_THREADS */
#ifdef USE_THREADS
#else
#endif /* USE_THREADS */
PL_curpad = 0;
}
/* Since closure prototypes have the same lifetime as the containing
* CV, they don't hold a refcount on the outside CV. This avoids
* the refcount loop between the outer CV (which keeps a refcount to
* the closure prototype in the pad entry for pp_anoncode()) and the
* closure prototype, and the ensuing memory leak. --GSAR */
/* may be during global destruction */
while (i >= 0) {
if (!sv)
continue;
PL_comppad = Nullav;
}
}
}
}
}
STATIC void
{
#ifdef DEBUGGING
(!outside ? "null"
if (!padlist)
return;
}
#endif /* DEBUGGING */
}
{
SAVECOMPPAD();
#ifdef USE_THREADS
#endif /* USE_THREADS */
if (outside)
PL_comppad_name = newAV();
PL_comppad = newAV();
comppadlist = newAV();
if (!off)
}
else { /* our own lexical */
if (*name == '&') {
/* anon code -- we'll come back for it */
}
else if (*name == '@')
else if (*name == '%')
else
SvPADMY_on(sv);
}
}
}
else {
}
}
/* Now that vars are all in place, clone nested closures. */
if (namesv
&& namesv != &PL_sv_undef
{
}
}
#ifdef DEBUG_CLOSURES
#endif
return cv;
}
CV *
{
LOCK_CRED_MUTEX; /* XXX create separate mutex */
UNLOCK_CRED_MUTEX; /* XXX create separate mutex */
return cv;
}
void
{
if (gv)
if (name)
if (p)
else
}
}
SV *
{
return Nullsv;
}
SV *
{
if (!o)
return Nullsv;
for (; o; o = o->op_next) {
return sv;
continue;
break;
if (sv)
return Nullsv;
return Nullsv;
}
else
return Nullsv;
}
if (sv)
return sv;
}
void
{
if (o)
SAVEFREEOP(o);
if (proto)
if (attrs)
if (block)
}
CV *
{
}
CV *
{
char *name;
char *aname;
}
else
SVt_PVCV);
if (o)
SAVEFREEOP(o);
if (proto)
if (attrs)
maximum a prototype before. */
&& ckWARN_d(WARN_PROTOTYPE))
{
}
}
if (ps)
else
goto noblock;
}
/* already defined (or promised)? */
bool const_changed = TRUE;
/* just a "sub foo;" when &foo is already defined */
goto done;
}
/* ahem, death to those who redefine active sort subs */
}
if (!block)
goto withattrs;
{
const_sv ? "Constant subroutine %s redefined"
: "Subroutine %s redefined", name);
}
}
}
if (attrs) {
/* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>
* before we clobber PL_compcv.
*/
else
stash = PL_curstash;
}
else {
/* possibly about to re-define existing subr -- ignore old cv */
else
stash = PL_curstash;
}
}
if (cv) { /* must reuse cv if autoloaded */
if (!block) {
/* got here with just attrs -- work done, so bug out */
goto done;
}
/* inner references to PL_compcv must be fixed up ... */
{
{
(void)SvREFCNT_inc(cv);
}
}
}
}
}
/* ... before we throw it away */
}
else {
if (name) {
}
}
#ifdef USE_THREADS
}
#endif /* USE_THREADS */
if (ps)
if (PL_error_count) {
if (name) {
s = s ? s+1 : name;
if (strEQ(s, "BEGIN")) {
char *not_safe =
"BEGIN not safe after errors--compilation aborted";
if (PL_in_eval & EVAL_KEEPERR)
else {
/* force display of errors found but not reported */
}
}
}
}
if (!block) {
PL_copline = NOLINE;
return cv;
}
}
else {
}
/* now that optimizer has done its work, adjust pad values */
continue;
/*
* The only things that a clonable function needs in its
* pad are references to outer lexicals and anonymous subs.
* The rest are created anew during cloning.
*/
namesv != &PL_sv_undef &&
{
}
}
}
else {
continue;
}
}
/* If a potential closure prototype, don't keep a refcount on outer CV.
* This is okay as the lifetime of the prototype is tied to the
* lifetime of the outer CV. Avoids memory leak due to reference
* loop. --GSAR */
if (!name)
char *s;
{
dSP;
}
}
s++;
else
s = tname;
if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I')
goto done;
if (strEQ(s, "BEGIN")) {
save_svref(&PL_rs);
if (!PL_beginav)
PL_beginav = newAV();
}
if (!PL_endav)
}
if (!PL_checkav)
PL_checkav = newAV();
}
if (!PL_initav)
}
}
done:
PL_copline = NOLINE;
return cv;
}
/* XXX unsafe for threads if eval_owner isn't held */
/*
=for apidoc newCONSTSUB
Creates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is
eligible for inlining at compile-time.
=cut
*/
void
{
SAVEHINTS();
PL_hints &= ~HINT_BLOCK_SCOPE;
if (stash) {
PL_curstash = stash;
#ifdef USE_ITHREADS
#else
#endif
}
start_subparse(FALSE, 0),
);
}
/*
=for apidoc U||newXS
Used by C<xsubpp> to hook up XSUBs as Perl subs.
=cut
*/
CV *
{
/* just a cached method */
cv = 0;
}
/* already defined (or promised) */
if (PL_copline != NOLINE)
}
cv = 0;
}
}
if (cv) /* must reuse cv if autoloaded */
else {
if (name) {
}
}
#ifdef USE_THREADS
#endif /* USE_THREADS */
(void)gv_fetchfile(filename);
an external constant string */
if (name) {
if (s)
s++;
else
s = name;
if (*s != 'B' && *s != 'E' && *s != 'C' && *s != 'I')
goto done;
if (strEQ(s, "BEGIN")) {
if (!PL_beginav)
PL_beginav = newAV();
}
else if (strEQ(s, "END")) {
if (!PL_endav)
}
else if (strEQ(s, "CHECK")) {
if (!PL_checkav)
PL_checkav = newAV();
}
else if (strEQ(s, "INIT")) {
if (!PL_initav)
}
}
else
done:
return cv;
}
void
{
char *name;
if (o)
else
name = "STDOUT";
GvMULTI_on(gv);
if (ckWARN(WARN_REDEFINE)) {
}
}
}
op_free(o);
PL_copline = NOLINE;
}
OP *
{
}
OP *
{
}
OP *
{
}
OP *
{
newSVOP(OP_ANONCODE, 0,
}
OP *
{
switch (o->op_type) {
case OP_PADSV:
case OP_RV2SV:
break;
default:
if (ckWARN_d(WARN_INTERNAL))
break;
}
return o;
}
OP *
{
switch (o->op_type) {
case OP_PADSV:
case OP_PADAV:
case OP_RV2SV:
case OP_RV2AV:
break;
default:
if (ckWARN_d(WARN_INTERNAL))
break;
}
return o;
}
OP *
{
return o;
}
}
OP *
{
}
OP *
{
return o;
}
}
OP *
{
/* STUB */
return o;
}
OP *
{
}
OP *
{
return o;
}
o->op_flags |= OPpDONE_SVREF;
return o;
}
}
/* Check routines. */
OP *
{
return o;
}
OP *
{
o->op_private = PL_hints;
return o;
}
OP *
{
o->op_flags |= OPf_STACKED;
return o;
}
OP *
{
if (newop &&
(newop->op_sibling ||
return o;
}
}
return ck_fun(o);
}
OP *
{
o = ck_fun(o);
o->op_private = 0;
case OP_ASLICE:
o->op_flags |= OPf_SPECIAL;
/* FALL THROUGH */
case OP_HSLICE:
o->op_private |= OPpSLICE;
break;
case OP_AELEM:
o->op_flags |= OPf_SPECIAL;
/* FALL THROUGH */
case OP_HELEM:
break;
default:
PL_op_desc[o->op_type]);
}
}
return o;
}
OP *
{
op_free(o);
}
return ck_fun(o);
}
return o;
}
OP *
{
if (!kid) {
null(o);
}
op_free(o);
enter->op_private = 0;
/* establish postfix order */
o->op_type = OP_LEAVETRY;
return o;
}
else
}
else {
op_free(o);
}
return o;
}
OP *
{
#ifdef VMS
if (table) {
o->op_private |= OPpEXIT_VMSISH;
}
#endif
return ck_fun(o);
}
OP *
{
if (o->op_flags & OPf_STACKED) {
o = ck_fun(o);
}
else
o = listkids(o);
return o;
}
OP *
{
o = ck_fun(o);
PL_op_desc[o->op_type]);
o->op_private |= OPpEXISTS_SUB;
}
o->op_flags |= OPf_SPECIAL;
PL_op_desc[o->op_type]);
}
return o;
}
#if 0
OP *
{
o = fold_constants(o);
return o;
}
#endif
OP *
{
char *name;
int iscv;
/* Is it a constant from cv_const_sv()? */
switch (o->op_type) {
case OP_RV2SV:
badtype = "a SCALAR";
break;
case OP_RV2AV:
badtype = "an ARRAY";
break;
case OP_RV2HV:
{
break;
}
}
badtype = "a HASH";
}
break;
case OP_RV2CV:
badtype = "a CODE";
break;
}
if (badtype)
return o;
}
switch (o->op_type) {
case OP_RV2SV:
badthing = "a SCALAR";
break;
case OP_RV2AV:
badthing = "an ARRAY";
break;
case OP_RV2HV:
badthing = "a HASH";
break;
}
if (badthing)
"Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
}
/*
* This is a little tricky. We only want to add the symbol if we
* didn't add it in the lexer. Otherwise we get duplicate strict
* warnings. But if we didn't add it in the lexer, we must at
* least pretend like we wanted to add it even if it existed before,
* or we get possible typo warnings. OPpCONST_ENTERED says
* whether the lexer already added THIS instance of this symbol.
*/
do {
? SVt_PVCV
? SVt_PV
? SVt_PVAV
? SVt_PVHV
: SVt_PVGV);
if (gv) {
#ifdef USE_ITHREADS
/* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
#else
#endif
kid->op_private = 0;
}
}
return o;
}
OP *
{
/* nothing */
}
op_free(o);
o = newop;
}
}
else {
op_free(o);
SVt_PVIO));
else
}
return o;
}
OP *
{
if (o->op_flags & OPf_STACKED) {
oa &= ~OA_OPTIONAL;
else
return no_fh_allowed(o);
}
{
}
numargs++;
switch (oa & 7) {
case OA_SCALAR:
/* list seen where single (scalar) arg expected? */
{
}
break;
case OA_LIST:
if (oa < 16) {
kid = 0;
continue;
}
else
break;
case OA_AVREF:
{
if (ckWARN(WARN_DEPRECATED))
}
break;
case OA_HVREF:
{
if (ckWARN(WARN_DEPRECATED))
}
break;
case OA_CVREF:
{
kid->op_sibling = 0;
}
break;
case OA_FILEREF:
{
SVt_PVIO) );
}
/* neophyte patrol: open(<FH>), close(<FH>) etc. */
}
else {
/* is this op a FH constructor? */
if (is_handle_constructor(o,numargs)) {
flags = 0;
/* Set a flag to tell rv2gv to vivify
* need to "prove" flag does not mean something
* else already - NI-S 1999/05/07
*/
}
{
}
{
name = "__ANONIO__";
len = 10;
}
if (name) {
if (*name != '$')
}
}
kid->op_sibling = 0;
}
}
break;
case OA_SCALARREF:
break;
}
oa >>= 4;
}
o->op_private |= numargs;
if (kid)
listkids(o);
}
op_free(o);
}
if (oa) {
while (oa & OA_OPTIONAL)
oa >>= 4;
}
return o;
}
OP *
{
o = ck_fun(o);
#if !defined(PERL_EXTERNAL_GLOB)
/* XXX this can be tightened up and made more failsafe. */
if (!gv) {
/* null-terminated import list */
}
#endif /* PERL_EXTERNAL_GLOB */
append_elem(OP_GLOB, o,
append_elem(OP_LIST, o,
return o;
}
scalarkids(o);
return o;
}
OP *
{
if (o->op_flags & OPf_STACKED) {
OP* k;
o = ck_sort(o);
kid = k;
}
o->op_flags &= ~OPf_STACKED;
}
if (type == OP_MAPWHILE)
else
o = ck_fun(o);
if (PL_error_count)
return o;
}
OP *
{
if (kid)
}
return ck_fun(o);
}
OP *
{
/* XXX length optimization goes here */
return ck_fun(o);
}
OP *
{
}
OP *
{
case OP_RV2AV:
/* This is needed for
if (defined %stash::)
to work. Do not break Tk.
*/
break; /* Globals via GV can be undef */
case OP_PADAV:
case OP_AASSIGN: /* Is this a good idea? */
"defined(@array) is deprecated");
"\t(Maybe you should just omit the defined()?)\n");
break;
case OP_RV2HV:
/* This is needed for
if (defined %stash::)
to work. Do not break Tk.
*/
break; /* Globals via GV can be undef */
case OP_PADHV:
"defined(%%hash) is deprecated");
"\t(Maybe you should just omit the defined()?)\n");
break;
default:
/* no warning */
break;
}
}
return ck_rfun(o);
}
OP *
{
}
OP *
{
if (!kid) {
o = force_list(o);
}
}
}
if (!kid)
return listkids(o);
}
OP *
{
/* has a disposable target? */
/* Cannot steal the second time! */
{
/* Can just relocate the target. */
{
/* Now we do not need PADSV and SASSIGN. */
op_free(o);
return kid;
}
}
return o;
}
OP *
{
o->op_private |= OPpRUNTIME;
return o;
}
OP *
{
op_free(o);
return cmop;
}
}
return o;
}
OP *
{
return o;
}
OP *
{
if (table) {
o->op_private |= OPpOPEN_IN_RAW;
o->op_private |= OPpOPEN_IN_CRLF;
}
o->op_private |= OPpOPEN_OUT_RAW;
o->op_private |= OPpOPEN_OUT_CRLF;
}
}
if (o->op_type == OP_BACKTICK)
return o;
return ck_fun(o);
}
OP *
{
o->op_private |= OPpREPEAT_DOLIST;
}
else
scalar(o);
return o;
}
OP *
{
char *s;
if (*s == ':' && s[1] == ':') {
*s = '/';
}
}
}
else
}
}
return ck_fun(o);
}
OP *
{
}
return o;
}
#if 0
OP *
{
/* STUB */
return o;
}
#endif
OP *
{
o->op_type = OP_SSELECT;
o = ck_fun(o);
return fold_constants(o);
}
}
o = ck_fun(o);
return o;
}
OP *
{
op_free(o);
#ifdef USE_THREADS
}
else {
}
#else
#endif /* USE_THREADS */
}
}
OP *
{
simplify_sort(o);
OP *k;
}
k->op_next = 0;
/* don't descend into loops */
else if (k->op_type == OP_ENTERLOOP
|| k->op_type == OP_ENTERITER)
{
}
}
}
else
}
peep(k);
}
else
o->op_flags |= OPf_SPECIAL;
}
}
/* provide list context for arguments */
return o;
}
STATIC void
{
OP *k;
int reversed;
if (!(o->op_flags & OPf_STACKED))
return;
return;
case OP_NCMP:
case OP_I_NCMP:
case OP_SCMP:
break;
default:
return;
}
k = kid; /* remember this node*/
return;
return;
return;
reversed = 0;
reversed = 1;
else
return;
kid = k; /* back to cmp */
return;
return;
|| ( reversed
return;
if (reversed)
o->op_private |= OPpSORT_REVERSE;
o->op_private |= OPpSORT_NUMERIC;
}
OP *
{
if (o->op_flags & OPf_STACKED)
return no_fh_allowed(o);
if (!kid) {
}
kid->op_sibling = 0;
}
if (!kid->op_sibling)
if (!kid->op_sibling)
if (kid->op_sibling)
return o;
}
OP *
{
if (ckWARN(WARN_SYNTAX)) {
char *pmstr = "STRING";
if (kPMOP->op_pmregexp)
"/%s/ should probably be written as \"%s\"",
}
}
return ck_fun(o);
}
OP *
{
char *proto = 0;
int optional = 0;
o->op_private |= OPpENTERSUB_HASTARG;
if (!cv)
}
}
}
o->op_private &= ~OPpCONST_STRICT;
}
}
o->op_private |= OPpENTERSUB_DB;
if (proto) {
switch (*proto) {
case '\0':
case ';':
optional = 1;
proto++;
continue;
case '$':
proto++;
arg++;
break;
case '%':
case '@':
arg++;
break;
case '&':
proto++;
arg++;
break;
case '*':
/* '*' allows any scalar type, including bareword */
proto++;
arg++;
goto wrapref; /* autoconvert GLOB -> GLOBref */
/* accidental subroutine, revert to bareword */
if (gvop) {
;
if (gvop &&
{
}
}
}
}
break;
case '\\':
proto++;
arg++;
switch (*proto++) {
case '*':
goto wrapref;
case '&':
goto wrapref;
case '$':
{
}
goto wrapref;
case '@':
goto wrapref;
case '%':
{
kid->op_sibling = 0;
}
break;
default: goto oops;
}
break;
case ' ':
proto++;
continue;
default:
oops:
}
}
else
}
return o;
}
OP *
{
return o;
}
OP *
{
{
o->op_flags |= OPf_SPECIAL;
}
}
return ck_fun(o);
}
OP *
{
o = ck_fun(o);
if (kid)
}
return o;
}
/* A peephole optimizer. We visit the ops in the order they're to execute. */
void
{
if (!o || o->op_seq)
return;
SAVEOP();
for (; o; o = o->op_next) {
if (o->op_seq)
break;
if (!PL_op_seqmax)
PL_op_seqmax++;
PL_op = o;
switch (o->op_type) {
case OP_SETSTATE:
case OP_NEXTSTATE:
case OP_DBSTATE:
o->op_seq = PL_op_seqmax++;
break;
case OP_CONST:
#ifdef USE_ITHREADS
/* Relocate sv to the pad for thread safety.
* Despite being a "constant", the SV is written to,
* for reference counts, sv_upgrade() etc. */
/* If op_sv is already a PADTMP then it is being used by
* another pad, so make a copy. */
}
else {
}
}
#endif
o->op_seq = PL_op_seqmax++;
break;
case OP_CONCAT:
goto ignore_optimization;
else {
/* assert(PL_opargs[o->op_type] & OA_TARGLEX); */
o->op_private |= OPpTARGET_MY;
}
}
}
o->op_seq = PL_op_seqmax++;
break;
case OP_STUB:
o->op_seq = PL_op_seqmax++;
break; /* Scalar stub must produce undef. List stub is noop */
}
goto nothin;
case OP_NULL:
if (o->op_targ == OP_NEXTSTATE
|| o->op_targ == OP_DBSTATE
|| o->op_targ == OP_SETSTATE)
{
}
goto nothin;
case OP_SCALAR:
case OP_LINESEQ:
case OP_SCOPE:
continue;
}
o->op_seq = PL_op_seqmax++;
break;
case OP_GV:
| OPpOUR_INTRO);
}
}
IV i;
<= 255 &&
i >= 0)
{
o->op_type = OP_AELEMFAST;
o->op_private = (U8)i;
}
}
/* XXX could check prototype here instead of just carping */
"%s() called too early to check prototype",
SvPV_nolen(sv));
}
}
o->op_seq = PL_op_seqmax++;
break;
case OP_MAPWHILE:
case OP_GREPWHILE:
case OP_AND:
case OP_OR:
case OP_ANDASSIGN:
case OP_ORASSIGN:
case OP_COND_EXPR:
case OP_RANGE:
o->op_seq = PL_op_seqmax++;
break;
case OP_ENTERLOOP:
case OP_ENTERITER:
o->op_seq = PL_op_seqmax++;
break;
case OP_QR:
case OP_MATCH:
case OP_SUBST:
o->op_seq = PL_op_seqmax++;
while (cPMOP->op_pmreplstart &&
break;
case OP_EXEC:
o->op_seq = PL_op_seqmax++;
if (o->op_next->op_sibling &&
"Statement unlikely to be reached");
"\t(Maybe you meant system() when you said exec()?)\n");
}
}
break;
case OP_HELEM: {
char *key;
o->op_seq = PL_op_seqmax++;
if ((o->op_private & (OPpLVAL_INTRO))
break;
break;
break;
break;
if (!indsvp) {
}
if (ind < 1)
if (SvREADONLY(*svp))
SvREFCNT_dec(*svp);
break;
}
case OP_HSLICE: {
char *key;
o->op_seq = PL_op_seqmax++;
if ((o->op_private & (OPpLVAL_INTRO))
/* I bet there's always a pushmark... */
/* hmmm, no optimization if list contains only one key. */
break;
break;
break;
break;
/* Again guessing that the pushmark can be jumped over.... */
->op_first->op_sibling;
/* Check that the key list contains only constants. */
break;
if (key_op)
break;
if (!indsvp) {
"in variable %s of type %s",
}
if (ind < 1)
if (SvREADONLY(*svp))
SvREFCNT_dec(*svp);
}
break;
}
default:
o->op_seq = PL_op_seqmax++;
break;
}
oldop = o;
}
}