#include "EXTERN.h"
#include "perl.h"
+#ifdef PERL_OBJECT
+#define CHECKCALL this->*check
+#else
+#define CHECKCALL *check
+#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.
? ( op_free((OP*)o), \
croak("%s trapped by operation mask", op_desc[type]), \
Nullop ) \
- : (*check[type])((OP*)o))
+ : (CHECKCALL[type])((OP*)o))
+static bool scalar_mod_type _((OP *o, I32 type));
+#ifndef PERL_OBJECT
static I32 list_assignment _((OP *o));
static void bad_type _((I32 n, char *t, char *name, OP *kid));
static OP *modkids _((OP *o, I32 type));
static OP *no_fh_allowed _((OP *o));
-static bool scalar_mod_type _((OP *o, I32 type));
static OP *scalarboolean _((OP *o));
static OP *too_few_arguments _((OP *o, char* name));
static OP *too_many_arguments _((OP *o, char* name));
CV* startcv, I32 cx_ix));
static OP *newDEFSVOP _((void));
static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
+#endif
-static char*
+STATIC char*
gv_ename(GV *gv)
{
SV* tmpsv = sv_newmortal();
return SvPV(tmpsv,na);
}
-static OP *
+STATIC OP *
no_fh_allowed(OP *o)
{
yyerror(form("Missing comma after first argument to %s function",
return o;
}
-static OP *
+STATIC OP *
too_few_arguments(OP *o, char *name)
{
yyerror(form("Not enough arguments for %s", name));
return o;
}
-static OP *
+STATIC OP *
too_many_arguments(OP *o, char *name)
{
yyerror(form("Too many arguments for %s", name));
return o;
}
-static void
+STATIC void
bad_type(I32 n, char *t, char *name, OP *kid)
{
yyerror(form("Type of arg %d to %s must be %s (not %s)",
return off;
}
-static PADOFFSET
+STATIC PADOFFSET
pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
{
dTHR;
sawampersand = TRUE;
SvREADONLY_on(sv);
/* FALL THROUGH */
+
+ /* XXX %! tied to Errno.pm needs to be added here.
+ * See gv_fetchpv(). */
+ /* case '!': */
+
default:
sv_magic(sv, 0, 0, name, 1);
}
break;
#endif /* USE_THREADS */
default:
- if (!(o->op_flags & OPf_REF) || (check[o->op_type] != ck_ftst))
+ if (!(o->op_flags & OPf_REF)
+ || (check[o->op_type] != FUNC_NAME_TO_PTR(ck_ftst)))
break;
/* FALL THROUGH */
case OP_GVSV:
Safefree(o);
}
-static void
+STATIC void
null(OP *o)
{
if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
return o;
}
-static OP *
+STATIC OP *
scalarboolean(OP *o)
{
if (dowarn &&
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_HEX:
case OP_OCT:
case OP_LENGTH:
- case OP_SUBSTR:
case OP_VEC:
case OP_INDEX:
case OP_RINDEX:
case OP_GGRNAM:
case OP_GGRGID:
case OP_GETLOGIN:
+ func_ops:
if (!(o->op_private & OPpLVAL_INTRO))
useless = op_desc[o->op_type];
break;
return o;
}
-static OP *
+STATIC OP *
modkids(OP *o, I32 type)
{
OP *kid;
return o;
}
-static I32 modcount;
-
OP *
mod(OP *o, I32 type)
{
case OP_KEYS:
if (type != OP_SASSIGN)
goto nomod;
+ goto lvalue_func;
+ case OP_SUBSTR:
+ if (o->op_private == 4) /* don't allow 4 arg substr as lvalue */
+ goto nomod;
/* FALL THROUGH */
case OP_POS:
case OP_VEC:
- case OP_SUBSTR:
+ lvalue_func:
pad_free(o->op_targ);
o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
assert(SvTYPE(PAD_SV(o->op_targ)) == SVt_NULL);
else if (!type) {
o->op_private |= OPpLVAL_INTRO;
o->op_flags &= ~OPf_SPECIAL;
+ hints |= HINT_BLOCK_SCOPE;
}
else if (type != OP_GREPSTART && type != OP_ENTERSUB)
o->op_flags |= OPf_REF;
case OP_CONCAT:
case OP_SUBST:
case OP_TRANS:
+ case OP_READ:
+ case OP_SYSREAD:
+ case OP_RECV:
case OP_ANDASSIGN: /* may work later */
case OP_ORASSIGN: /* may work later */
return TRUE;
return o;
}
+void
+save_hints(void)
+{
+ SAVEI32(hints);
+ SAVESPTR(GvHV(hintgv));
+ GvHV(hintgv) = newHVhv(GvHV(hintgv));
+ SAVEFREESV(GvHV(hintgv));
+}
+
int
block_start(int full)
{
dTHR;
int retval = savestack_ix;
+
SAVEI32(comppad_name_floor);
if (full) {
if ((comppad_name_fill = AvFILLp(comppad_name)) > 0)
SAVEI32(padix_floor);
padix_floor = padix;
pad_reset_pending = FALSE;
- SAVEI32(hints);
+ SAVEHINTS();
hints &= ~HINT_BLOCK_SCOPE;
return retval;
}
return retval;
}
-static OP *
+STATIC OP *
newDEFSVOP(void)
{
#ifdef USE_THREADS
curop = LINKLIST(o);
o->op_next = 0;
op = curop;
- runops();
+ CALLRUNOPS();
sv = *(stack_sp--);
if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
pad_swipe(o->op_targ);
if (type == OP_RV2GV)
return newGVOP(OP_GV, 0, (GV*)sv);
else {
- if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
+ /* try to smush double to int, but don't smush -2.0 to -2 */
+ if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK &&
+ type != OP_NEGATE)
+ {
IV iv = SvIV(sv);
- if ((double)iv == SvNV(sv)) { /* can we smush double to int */
+ if ((double)iv == SvNV(sv)) {
SvREFCNT_dec(sv);
sv = newSViv(iv);
}
op = curop = LINKLIST(o);
o->op_next = 0;
pp_pushmark(ARGS);
- runops();
+ CALLRUNOPS();
op = curop;
pp_anonlist(ARGS);
tmps_floor = oldtmps_floor;
pmop->op_flags = flags;
pmop->op_private = 0 | (flags >> 8);
+ if (hints & HINT_RE_TAINT)
+ pmop->op_pmpermflags |= PMf_RETAINT;
if (hints & HINT_LOCALE)
- pmop->op_pmpermflags = (pmop->op_pmflags |= PMf_LOCALE);
+ pmop->op_pmpermflags |= PMf_LOCALE;
+ pmop->op_pmflags = pmop->op_pmpermflags;
/* link into pm list */
if (type != OP_TRANS && curstash) {
{
PMOP *pm;
LOGOP *rcop;
+ I32 repl_has_vars = 0;
if (o->op_type == OP_TRANS)
return pmtrans(o, expr, repl);
for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
if (opargs[curop->op_type] & OA_DANGEROUS) {
#ifdef USE_THREADS
- if (curop->op_type == OP_THREADSV
- && strchr("&`'123456789+", curop->op_private)) {
- break;
+ if (curop->op_type == OP_THREADSV) {
+ repl_has_vars = 1;
+ if (strchr("&`'123456789+", curop->op_private))
+ break;
}
#else
if (curop->op_type == OP_GV) {
GV *gv = ((GVOP*)curop)->op_gv;
+ repl_has_vars = 1;
if (strchr("&`'123456789+", *GvENAME(gv)))
break;
}
curop->op_type == OP_PADAV ||
curop->op_type == OP_PADHV ||
curop->op_type == OP_PADANY) {
- /* is okay */
+ repl_has_vars = 1;
}
else
break;
lastop = curop;
}
}
- if (curop == repl) {
+ if (curop == repl
+ && !(repl_has_vars
+ && (!pm->op_pmregexp
+ || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) {
pm->op_pmflags |= PMf_CONST; /* const for long enough */
pm->op_pmpermflags |= PMf_CONST; /* const for long enough */
prepend_elem(o->op_type, scalar(repl), o);
}
else {
+ if (curop == repl && !pm->op_pmregexp) { /* Has variables. */
+ pm->op_pmflags |= PMf_MAYBE_CONST;
+ pm->op_pmpermflags |= PMf_MAYBE_CONST;
+ }
Newz(1101, rcop, 1, LOGOP);
rcop->op_type = OP_SUBSTCONT;
rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
list(force_list(listval)) );
}
-static I32
+STATIC I32
list_assignment(register OP *o)
{
if (!o)
}
if (list_assignment(left)) {
+ dTHR;
modcount = 0;
eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
left = mod(left, OP_AASSIGN);
list(force_list(left)) );
o->op_private = 0 | (flags >> 8);
if (!(left->op_private & OPpLVAL_INTRO)) {
- static int generation = 100;
OP *curop;
OP *lastop = o;
generation++;
return new_logop(type, flags, &first, &other);
}
-static OP *
+STATIC OP *
new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
{
dTHR;
case OP_NULL:
if (k2 && k2->op_type == OP_READLINE
&& (k2->op_flags & OPf_STACKED)
- && (k1->op_type == OP_RV2SV || k1->op_type == OP_PADSV))
+ && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
warnop = k2->op_type;
break;
|| (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
expr = newUNOP(OP_DEFINED, 0,
newASSIGNOP(0, newDEFSVOP(), 0, expr) );
+ } else if (expr->op_flags & OPf_KIDS) {
+ OP *k1 = ((UNOP*)expr)->op_first;
+ OP *k2 = (k1) ? k1->op_sibling : NULL;
+ switch (expr->op_type) {
+ case OP_NULL:
+ if (k2 && k2->op_type == OP_READLINE
+ && (k2->op_flags & OPf_STACKED)
+ && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
+ expr = newUNOP(OP_DEFINED, 0, expr);
+ break;
+
+ case OP_SASSIGN:
+ if (k1->op_type == OP_READDIR
+ || k1->op_type == OP_GLOB
+ || k1->op_type == OP_EACH)
+ expr = newUNOP(OP_DEFINED, 0, expr);
+ break;
+ }
}
}
|| (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
expr = newUNOP(OP_DEFINED, 0,
newASSIGNOP(0, newDEFSVOP(), 0, expr) );
+ } else if (expr && (expr->op_flags & OPf_KIDS)) {
+ OP *k1 = ((UNOP*)expr)->op_first;
+ OP *k2 = (k1) ? k1->op_sibling : NULL;
+ switch (expr->op_type) {
+ case OP_NULL:
+ if (k2 && k2->op_type == OP_READLINE
+ && (k2->op_flags & OPf_STACKED)
+ && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
+ expr = newUNOP(OP_DEFINED, 0, expr);
+ break;
+
+ case OP_SASSIGN:
+ if (k1->op_type == OP_READDIR
+ || k1->op_type == OP_GLOB
+ || k1->op_type == OP_EACH)
+ expr = newUNOP(OP_DEFINED, 0, expr);
+ break;
+ }
}
if (!block)
#endif
}
if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
- expr = scalar(ref(expr, OP_ITER));
+ expr = mod(force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART);
+ iterflags |= OPf_STACKED;
+ }
+ else if (expr->op_type == OP_NULL &&
+ (expr->op_flags & OPf_KIDS) &&
+ ((BINOP*)expr)->op_first->op_type == OP_FLOP)
+ {
+ /* 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
+ * treated as min/max values by 'pp_iterinit'.
+ */
+ UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
+ CONDOP* range = (CONDOP*) flip->op_first;
+ OP* left = range->op_first;
+ OP* right = left->op_sibling;
+ LISTOP* listop;
+
+ range->op_flags &= ~OPf_KIDS;
+ range->op_first = Nullop;
+
+ listop = (LISTOP*)newLISTOP(OP_LIST, 0, left, right);
+ listop->op_first->op_next = range->op_true;
+ left->op_next = range->op_false;
+ right->op_next = (OP*)listop;
+ listop->op_next = listop->op_first;
+
+ op_free(expr);
+ expr = (OP*)(listop);
+ null(expr);
iterflags |= OPf_STACKED;
}
+ else {
+ expr = mod(force_list(expr), OP_GREPSTART);
+ }
+
+
loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
- append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
- scalar(sv))));
+ append_elem(OP_LIST, expr, scalar(sv))));
assert(!loop->op_next);
Renew(loop, 1, LOOP);
loop->op_targ = padoff;
}
#ifdef DEBUG_CLOSURES
-static void
+STATIC void
cv_dump(cv)
CV* cv;
{
}
#endif /* DEBUG_CLOSURES */
-static CV *
+STATIC CV *
cv_clone2(CV *proto, CV *outside)
{
dTHR;
SV *
cv_const_sv(CV *cv)
{
- OP *o;
- SV *sv;
-
if (!cv || !SvPOK(cv) || SvCUR(cv))
return Nullsv;
+ return op_const_sv(CvSTART(cv), cv);
+}
- sv = Nullsv;
- for (o = CvSTART(cv); o; o = o->op_next) {
+SV *
+op_const_sv(OP *o, CV *cv)
+{
+ SV *sv = Nullsv;
+
+ if(!o)
+ return Nullsv;
+
+ if(o->op_type == OP_LINESEQ && cLISTOPo->op_first)
+ o = cLISTOPo->op_first->op_sibling;
+
+ for (; o; o = o->op_next) {
OPCODE type = o->op_type;
-
+
+ if(sv && o->op_next == o)
+ return sv;
if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
continue;
if (type == OP_LEAVESUB || type == OP_RETURN)
return Nullsv;
if (type == OP_CONST)
sv = cSVOPo->op_sv;
- else if (type == OP_PADSV) {
+ else if (type == OP_PADSV && cv) {
AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
{
dTHR;
char *name = o ? SvPVx(cSVOPo->op_sv, na) : Nullch;
- GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
+ GV *gv = gv_fetchpv(name ? name : "__ANON__",
+ GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch;
- register CV *cv;
+ register CV *cv=0;
I32 ix;
if (o)
if (proto)
SAVEFREEOP(proto);
+ if (SvTYPE(gv) != SVt_PVGV) { /* Prototype now, and had
+ maximum a prototype before. */
+ if (SvTYPE(gv) > SVt_NULL) {
+ if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1))
+ warn("Runaway prototype");
+ cv_ckproto((CV*)gv, NULL, ps);
+ }
+ if (ps)
+ sv_setpv((SV*)gv, ps);
+ else
+ sv_setiv((SV*)gv, -1);
+ SvREFCNT_dec(compcv);
+ cv = compcv = NULL;
+ sub_generation++;
+ goto noblock;
+ }
+
if (!name || GvCVGEN(gv))
cv = Nullcv;
else if (cv = GvCV(gv)) {
/* already defined (or promised)? */
if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
SV* const_sv;
+ bool const_changed = TRUE;
if (!block) {
/* just a "sub foo;" when &foo is already defined */
SAVEFREESV(compcv);
goto done;
}
/* ahem, death to those who redefine active sort subs */
- if (curstack == sortstack && sortcop == CvSTART(cv))
+ if (curstackinfo->si_type == PERLSI_SORT && sortcop == CvSTART(cv))
croak("Can't redefine active sort subroutine %s", name);
- const_sv = cv_const_sv(cv);
- if (const_sv || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
+ if(const_sv = cv_const_sv(cv))
+ const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
+ if ((const_sv && const_changed) || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
&& HvNAME(GvSTASH(CvGV(cv)))
&& strEQ(HvNAME(GvSTASH(CvGV(cv))),
"autouse"))) {
}
}
if (!block) {
+ noblock:
copline = NOLINE;
LEAVE_SCOPE(floor);
return cv;
ENTER;
SAVESPTR(compiling.cop_filegv);
SAVEI16(compiling.cop_line);
- SAVEI32(perldb);
save_svref(&rs);
sv_setsv(rs, nrs);
}
CV *
-newXS(char *name, void (*subaddr) (CV *), char *filename)
+newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
{
dTHR;
GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
if (o->op_flags & OPf_REF)
return o;
- if (o->op_flags & OPf_KIDS) {
+ if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
SVOP *kid = (SVOP*)cUNOPo->op_first;
if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
case OP_PADAV:
if (o->op_next->op_type == OP_RV2AV
- && (o->op_next->op_flags && OPf_REF))
+ && (o->op_next->op_flags & OPf_REF))
{
null(o->op_next);
o->op_next = o->op_next->op_next;
case OP_PADHV:
if (o->op_next->op_type == OP_RV2HV
- && (o->op_next->op_flags && OPf_REF))
+ && (o->op_next->op_flags & OPf_REF))
{
null(o->op_next);
o->op_next = o->op_next->op_next;
o->op_seq = op_seqmax++;
if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
if (o->op_next->op_sibling &&
+ o->op_next->op_sibling->op_type != OP_EXIT &&
+ o->op_next->op_sibling->op_type != OP_WARN &&
o->op_next->op_sibling->op_type != OP_DIE) {
line_t oldline = curcop->cop_line;
https://perl5.git.perl.org / perl5.git / blobdiff