diff options
Diffstat (limited to 'op.c')
| -rw-r--r-- | op.c | 1181 |
1 files changed, 752 insertions, 429 deletions
@@ -1,45 +1,31 @@ -/* $RCSfile: cmd.h,v $$Revision: 4.1 $$Date: 92/08/07 17:19:19 $ +/* op.c * - * Copyright (c) 1991, Larry Wall + * Copyright (c) 1991-1994, 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. * - * $Log: cmd.h,v $ + */ + +/* + * "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" #include "perl.h" -/* Lowest byte of opargs */ -#define OA_MARK 1 -#define OA_FOLDCONST 2 -#define OA_RETSCALAR 4 -#define OA_TARGET 8 -#define OA_RETINTEGER 16 -#define OA_OTHERINT 32 -#define OA_DANGEROUS 64 - -/* Remaining nybbles of opargs */ -#define OA_SCALAR 1 -#define OA_LIST 2 -#define OA_AVREF 3 -#define OA_HVREF 4 -#define OA_CVREF 5 -#define OA_FILEREF 6 -#define OA_SCALARREF 7 -#define OA_OPTIONAL 8 - -void -cpy7bit(d,s,l) -register char *d; -register char *s; -register I32 l; -{ - while (l--) - *d++ = *s++ & 127; - *d = '\0'; -} +static I32 list_assignment _((OP *op)); +static OP *bad_type _((I32 n, char *t, OP *op, OP *kid)); +static OP *modkids _((OP *op, I32 type)); +static OP *no_fh_allowed _((OP *op)); +static OP *scalarboolean _((OP *op)); +static OP *too_few_arguments _((OP *op)); +static OP *too_many_arguments _((OP *op)); +static void null _((OP* op)); static OP * no_fh_allowed(op) @@ -77,19 +63,42 @@ OP *op; OP *kid; { sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)", - n, op_name[op->op_type], t, op_name[kid->op_type]); + (int) n, op_name[op->op_type], t, op_name[kid->op_type]); yyerror(tokenbuf); return op; } +void +assertref(op) +OP *op; +{ + int type = op->op_type; + if (type != OP_AELEM && type != OP_HELEM) { + sprintf(tokenbuf, "Can't use %s as left arg of implicit ->", + op_name[type]); + yyerror(tokenbuf); + if (type == OP_RV2HV || type == OP_ENTERSUB) + warn("(Did you mean $ instead of %c?)\n", + type == OP_RV2HV ? '%' : '&'); + } +} + /* "register" allocation */ PADOFFSET pad_allocmy(name) char *name; { - PADOFFSET off = pad_alloc(OP_PADSV, SVs_PADMY); - SV *sv = NEWSV(0,0); + PADOFFSET off; + SV *sv; + + if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) { + if (!isprint(name[1])) + sprintf(name+1, "^%c", name[1] ^ 64); /* XXX is tokenbuf, really */ + croak("Can't use global %s in \"my\"",name); + } + off = pad_alloc(OP_PADSV, SVs_PADMY); + sv = NEWSV(1102,0); sv_upgrade(sv, SVt_PVNV); sv_setpv(sv, name); av_store(comppad_name, off, sv); @@ -115,7 +124,7 @@ char *name; SV **svp = AvARRAY(comppad_name); register I32 i; register CONTEXT *cx; - bool saweval; + int saweval; AV *curlist; AV *curname; CV *cv; @@ -124,6 +133,7 @@ char *name; /* The one we're looking for is probably just before comppad_name_fill. */ for (off = comppad_name_fill; off > 0; off--) { if ((sv = svp[off]) && + sv != &sv_undef && seq <= SvIVX(sv) && seq > (I32)SvNVX(sv) && strEQ(SvPVX(sv), name)) @@ -137,14 +147,14 @@ char *name; * XXX This will also probably interact badly with eval tree caching. */ - saweval = FALSE; + saweval = 0; for (i = cxstack_ix; i >= 0; i--) { cx = &cxstack[i]; switch (cx->cx_type) { default: break; case CXt_EVAL: - saweval = TRUE; + saweval = i; break; case CXt_SUB: if (!saweval) @@ -152,12 +162,13 @@ char *name; cv = cx->blk_sub.cv; if (debstash && CvSTASH(cv) == debstash) /* ignore DB'* scope */ continue; - seq = cxstack[i+1].blk_oldcop->cop_seq; + seq = cxstack[saweval].blk_oldcop->cop_seq; curlist = CvPADLIST(cv); curname = (AV*)*av_fetch(curlist, 0, FALSE); svp = AvARRAY(curname); for (off = AvFILL(curname); off > 0; off--) { if ((sv = svp[off]) && + sv != &sv_undef && seq <= SvIVX(sv) && seq > (I32)SvNVX(sv) && strEQ(SvPVX(sv), name)) @@ -165,7 +176,7 @@ char *name; PADOFFSET newoff = pad_alloc(OP_PADSV, SVs_PADMY); AV *oldpad = (AV*)*av_fetch(curlist, CvDEPTH(cv), FALSE); SV *oldsv = *av_fetch(oldpad, off, TRUE); - SV *sv = NEWSV(0,0); + SV *sv = NEWSV(1103,0); sv_upgrade(sv, SVt_PVNV); sv_setpv(sv, name); av_store(comppad_name, newoff, sv); @@ -179,6 +190,31 @@ char *name; } } + if (!saweval) + return 0; + + /* It's stupid to dup this code. main should be stored in a CV. */ + seq = cxstack[saweval].blk_oldcop->cop_seq; + svp = AvARRAY(padname); + for (off = AvFILL(padname); off > 0; off--) { + if ((sv = svp[off]) && + sv != &sv_undef && + seq <= SvIVX(sv) && + seq > (I32)SvNVX(sv) && + strEQ(SvPVX(sv), name)) + { + PADOFFSET newoff = pad_alloc(OP_PADSV, SVs_PADMY); + SV *oldsv = *av_fetch(pad, off, TRUE); + SV *sv = NEWSV(1103,0); + sv_upgrade(sv, SVt_PVNV); + sv_setpv(sv, name); + av_store(comppad_name, newoff, sv); + SvNVX(sv) = (double)curcop->cop_seq; + SvIVX(sv) = 999999999; /* A ref, intro immediately */ + av_store(comppad, newoff, SvREFCNT_inc(oldsv)); + return newoff; + } + } return 0; } @@ -191,13 +227,13 @@ I32 fill; SV *sv; if (min_intro_pending && fill < min_intro_pending) { for (off = max_intro_pending; off >= min_intro_pending; off--) { - if (sv = svp[off]) + if ((sv = svp[off]) && sv != &sv_undef) warn("%s never introduced", SvPVX(sv)); } } /* "Deintroduce" my variables that are leaving with this scope. */ for (off = AvFILL(comppad_name); off > fill; off--) { - if (sv = svp[off]) + if ((sv = svp[off]) && sv != &sv_undef) SvIVX(sv) = cop_seqmax; } } @@ -212,6 +248,8 @@ U32 tmptype; if (AvARRAY(comppad) != curpad) croak("panic: pad_alloc"); + if (pad_reset_pending) + pad_reset(); if (tmptype & SVs_PADMY) { do { sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE); @@ -226,17 +264,17 @@ U32 tmptype; } SvFLAGS(sv) |= tmptype; curpad = AvARRAY(comppad); - DEBUG_X(fprintf(stderr, "Pad alloc %d for %s\n", retval, op_name[optype])); + DEBUG_X(fprintf(stderr, "Pad alloc %ld for %s\n", (long) retval, op_name[optype])); return (PADOFFSET)retval; } SV * -#ifndef STANDARD_C +#ifndef CAN_PROTOTYPE pad_sv(po) PADOFFSET po; #else pad_sv(PADOFFSET po) -#endif /* STANDARD_C */ +#endif /* CAN_PROTOTYPE */ { if (!po) croak("panic: pad_sv po"); @@ -245,40 +283,43 @@ pad_sv(PADOFFSET po) } void -#ifndef STANDARD_C +#ifndef CAN_PROTOTYPE pad_free(po) PADOFFSET po; #else pad_free(PADOFFSET po) -#endif /* STANDARD_C */ +#endif /* CAN_PROTOTYPE */ { + if (!curpad) + return; if (AvARRAY(comppad) != curpad) croak("panic: pad_free curpad"); if (!po) croak("panic: pad_free po"); DEBUG_X(fprintf(stderr, "Pad free %d\n", po)); - if (curpad[po]) + if (curpad[po] && curpad[po] != &sv_undef) SvPADTMP_off(curpad[po]); - if (po < padix) + if ((I32)po < padix) padix = po - 1; } void -#ifndef STANDARD_C +#ifndef CAN_PROTOTYPE pad_swipe(po) PADOFFSET po; #else pad_swipe(PADOFFSET po) -#endif /* STANDARD_C */ +#endif /* CAN_PROTOTYPE */ { if (AvARRAY(comppad) != curpad) croak("panic: pad_swipe curpad"); if (!po) croak("panic: pad_swipe po"); DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po)); - curpad[po] = NEWSV(0,0); SvPADTMP_off(curpad[po]); - if (po < padix) + curpad[po] = NEWSV(1107,0); + SvPADTMP_on(curpad[po]); + if ((I32)po < padix) padix = po - 1; } @@ -290,11 +331,12 @@ pad_reset() if (AvARRAY(comppad) != curpad) croak("panic: pad_reset curpad"); DEBUG_X(fprintf(stderr, "Pad reset\n")); - for (po = AvMAX(comppad); po > 0; po--) { - if (curpad[po]) + for (po = AvMAX(comppad); po > padix_floor; po--) { + if (curpad[po] && curpad[po] != &sv_undef) SvPADTMP_off(curpad[po]); } - padix = 0; + padix = padix_floor; + pad_reset_pending = FALSE; } /* Destructor */ @@ -320,9 +362,12 @@ OP *op; case OP_NULL: op->op_targ = 0; /* Was holding old type, if any. */ break; + case OP_ENTEREVAL: + op->op_targ = 0; /* Was holding hints. */ + break; case OP_GVSV: case OP_GV: - SvREFCNT_dec((SV*)cGVOP->op_gv); + SvREFCNT_dec(cGVOP->op_gv); break; case OP_NEXTSTATE: case OP_DBSTATE: @@ -331,6 +376,17 @@ OP *op; case OP_CONST: SvREFCNT_dec(cSVOP->op_sv); break; + case OP_TRANS: + Safefree(cPVOP->op_pv); + break; + case OP_SUBST: + op_free(cPMOP->op_pmreplroot); + /* FALL THROUGH */ + case OP_MATCH: + regfree(cPMOP->op_pmregexp); + break; + default: + break; } if (op->op_targ > 0) @@ -350,17 +406,6 @@ OP* op; op->op_ppaddr = ppaddr[OP_NULL]; } -static void -unlist(op) -OP* op; -{ - OP* kid = cLISTOP->op_first; - assert(kid->op_type == OP_PUSHMARK); - cLISTOP->op_first = kid->op_sibling; - null(kid); - null(op); -} - /* Contextualizers */ #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o)) @@ -402,13 +447,19 @@ OP *op; return op; } -OP * +static OP * scalarboolean(op) OP *op; { if (dowarn && - op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) - warn("Found = in conditional, should be =="); + op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) { + line_t oldline = curcop->cop_line; + + if (copline != NOLINE) + curcop->cop_line = copline; + warn("Found = in conditional, should be =="); + curcop->cop_line = oldline; + } return scalar(op); } @@ -418,7 +469,8 @@ OP *op; { OP *kid; - if (!op || (op->op_flags & OPf_KNOW)) /* assumes no premature commitment */ + /* assumes no premature commitment */ + if (!op || (op->op_flags & OPf_KNOW) || error_count) return op; op->op_flags &= ~OPf_LIST; @@ -434,6 +486,12 @@ OP *op; for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) scalar(kid); break; + case OP_SPLIT: + if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) { + if (!kPMOP->op_pmreplroot) + deprecate("implicit split to @_"); + } + /* FALL THROUGH */ case OP_MATCH: case OP_SUBST: case OP_NULL: @@ -468,7 +526,7 @@ OP *op; char* useless = 0; SV* sv; - if (!op) + if (!op || error_count) return op; if (op->op_flags & OPf_LIST) return op; @@ -492,6 +550,8 @@ OP *op; case OP_AV2ARYLEN: case OP_SV2LEN: case OP_REF: + case OP_REFGEN: + case OP_SREFGEN: case OP_DEFINED: case OP_HEX: case OP_OCT: @@ -551,7 +611,7 @@ OP *op; case OP_GGRNAM: case OP_GGRGID: case OP_GETLOGIN: - if (!(op->op_flags & OPf_INTRO)) + if (!(op->op_private & OPpLVAL_INTRO)) useless = op_name[op->op_type]; break; @@ -559,7 +619,7 @@ OP *op; case OP_RV2SV: case OP_RV2AV: case OP_RV2HV: - if (!(op->op_flags & OPf_INTRO) && + if (!(op->op_private & OPpLVAL_INTRO) && (!op->op_sibling || op->op_sibling->op_type != OP_READLINE)) useless = "a variable"; break; @@ -577,6 +637,7 @@ OP *op; useless = 0; else if (SvPOK(sv)) { if (strnEQ(SvPVX(sv), "di", 2) || + strnEQ(SvPVX(sv), "ds", 2) || strnEQ(SvPVX(sv), "ig", 2)) useless = 0; } @@ -606,20 +667,30 @@ OP *op; for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) scalarvoid(kid); break; + case OP_NULL: + if (op->op_flags & OPf_STACKED) + break; case OP_ENTERTRY: case OP_ENTER: case OP_SCALAR: - case OP_NULL: if (!(op->op_flags & OPf_KIDS)) break; case OP_SCOPE: case OP_LEAVE: case OP_LEAVETRY: + case OP_LEAVELOOP: + op->op_private |= OPpLEAVE_VOID; case OP_LINESEQ: case OP_LIST: for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) scalarvoid(kid); break; + case OP_SPLIT: + if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) { + if (!kPMOP->op_pmreplroot) + deprecate("implicit split to @_"); + } + break; } if (useless && dowarn) warn("Useless use of %s in void context", useless); @@ -644,7 +715,8 @@ OP *op; { OP *kid; - if (!op || (op->op_flags & OPf_KNOW)) /* assumes no premature commitment */ + /* assumes no premature commitment */ + if (!op || (op->op_flags & OPf_KNOW) || error_count) return op; op->op_flags |= (OPf_KNOW | OPf_LIST); @@ -717,7 +789,7 @@ OP *op; return op; } -OP * +static OP * modkids(op, type) OP *op; I32 type; @@ -739,14 +811,31 @@ I32 type; { OP *kid; SV *sv; + char mtype; - if (!op) + if (!op || error_count) return op; switch (op->op_type) { - case OP_ENTERSUBR: - if ((type == OP_UNDEF) && !(op->op_flags & OPf_STACKED)) { - op->op_type = OP_RV2CV; /* entersubr => rv2cv */ + case OP_CONST: + if (!(op->op_flags & (OPf_SPECIAL|OPf_MOD))) + goto nomod; + if (eval_start && eval_start->op_type == OP_CONST) { + compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv); + eval_start = 0; + } + else if (!type) { + SAVEI32(compiling.cop_arybase); + } + else if (type == OP_REFGEN) + goto nomod; + else + croak("That use of $[ is unsupported"); + break; + case OP_ENTERSUB: + if ((type == OP_UNDEF || type == OP_REFGEN) && + !(op->op_flags & OPf_STACKED)) { + op->op_type = OP_RV2CV; /* entersub => rv2cv */ op->op_ppaddr = ppaddr[OP_RV2CV]; assert(cUNOP->op_first->op_type == OP_NULL); null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */ @@ -754,12 +843,41 @@ I32 type; } /* FALL THROUGH */ default: + nomod: + /* grep, foreach, subcalls, refgen */ + if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) + break; sprintf(tokenbuf, "Can't modify %s in %s", op_name[op->op_type], type ? op_name[type] : "local"); yyerror(tokenbuf); return op; + 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 (!(op->op_flags & OPf_STACKED)) + goto nomod; + modcount++; + break; + case OP_COND_EXPR: for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling) mod(kid, type); @@ -768,25 +886,23 @@ I32 type; case OP_RV2AV: case OP_RV2HV: case OP_RV2GV: - op->op_private = (hints & HINT_STRICT_REFS); ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ + case OP_PADAV: + case OP_PADHV: case OP_AASSIGN: case OP_ASLICE: case OP_HSLICE: case OP_NEXTSTATE: case OP_DBSTATE: + case OP_REFGEN: + case OP_CHOMP: modcount = 10000; break; case OP_RV2SV: - op->op_private = (hints & HINT_STRICT_REFS); - if (type == OP_RV2AV || type == OP_RV2HV) - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); ref(cUNOP->op_first, op->op_type); /* FALL THROUGH */ case OP_PADSV: - case OP_PADAV: - case OP_PADHV: case OP_UNDEF: case OP_GV: case OP_AV2ARYLEN: @@ -795,54 +911,65 @@ I32 type; modcount++; break; - case OP_REFGEN: - modcount++; - break; - case OP_PUSHMARK: break; - case OP_SUBSTR: + + case OP_POS: + mtype = '.'; + goto makelv; case OP_VEC: + mtype = 'v'; + goto makelv; + case OP_SUBSTR: + mtype = 'x'; + makelv: pad_free(op->op_targ); op->op_targ = pad_alloc(op->op_type, SVs_PADMY); sv = PAD_SV(op->op_targ); sv_upgrade(sv, SVt_PVLV); - sv_magic(sv, 0, op->op_type == OP_VEC ? 'v' : 'x', 0, 0); + sv_magic(sv, Nullsv, mtype, Nullch, 0); curpad[op->op_targ] = sv; - /* FALL THROUGH */ - case OP_NULL: if (op->op_flags & OPf_KIDS) mod(cBINOP->op_first, type); break; + case OP_AELEM: case OP_HELEM: ref(cBINOP->op_first, op->op_type); - op->op_private = (hints & HINT_STRICT_REFS); - if (type == OP_RV2AV || type == OP_RV2HV) - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + modcount++; break; case OP_SCOPE: case OP_LEAVE: case OP_ENTER: + if (op->op_flags & OPf_KIDS) + mod(cLISTOP->op_last, type); + break; + + case OP_NULL: if (!(op->op_flags & OPf_KIDS)) break; - mod(cLISTOP->op_last, type); - break; - + if (op->op_targ != OP_LIST) { + mod(cBINOP->op_first, type); + break; + } + /* FALL THROUGH */ case OP_LIST: for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) mod(kid, type); break; } - op->op_flags |= OPf_LVAL; - if (!type) { + op->op_flags |= OPf_MOD; + + if (type == OP_AASSIGN || type == OP_SASSIGN) + op->op_flags |= OPf_SPECIAL|OPf_REF; + else if (!type) { + op->op_private |= OPpLVAL_INTRO; op->op_flags &= ~OPf_SPECIAL; - op->op_flags |= OPf_INTRO; } - else if (type == OP_AASSIGN || type == OP_SASSIGN) - op->op_flags |= OPf_SPECIAL; + else if (type != OP_GREPSTART && type != OP_ENTERSUB) + op->op_flags |= OPf_REF; return op; } @@ -865,16 +992,15 @@ OP *op; I32 type; { OP *kid; - SV *sv; - if (!op) + if (!op || error_count) return op; switch (op->op_type) { - case OP_ENTERSUBR: - if ((type == OP_REFGEN || type == OP_DEFINED) - && !(op->op_flags & (OPf_STACKED|OPf_PARENS))) { - op->op_type = OP_RV2CV; /* entersubr => rv2cv */ + case OP_ENTERSUB: + if ((type == OP_DEFINED) && + !(op->op_flags & OPf_STACKED)) { + op->op_type = OP_RV2CV; /* entersub => rv2cv */ op->op_ppaddr = ppaddr[OP_RV2CV]; assert(cUNOP->op_first->op_type == OP_NULL); null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */ @@ -886,24 +1012,24 @@ I32 type; ref(kid, type); break; case OP_RV2SV: - op->op_private = (hints & HINT_STRICT_REFS); - if (type == OP_RV2AV || type == OP_RV2HV) - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); ref(cUNOP->op_first, op->op_type); + if (type == OP_RV2AV || type == OP_RV2HV) { + op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + op->op_flags |= OPf_MOD; + } break; case OP_RV2AV: case OP_RV2HV: - op->op_flags |= OPf_LVAL; + op->op_flags |= OPf_REF; /* FALL THROUGH */ case OP_RV2GV: - op->op_private = (hints & HINT_STRICT_REFS); ref(cUNOP->op_first, op->op_type); break; case OP_PADAV: case OP_PADHV: - op->op_flags |= OPf_LVAL; + op->op_flags |= OPf_REF; break; case OP_SCALAR: @@ -915,11 +1041,9 @@ I32 type; case OP_AELEM: case OP_HELEM: ref(cBINOP->op_first, op->op_type); - op->op_private = (hints & HINT_STRICT_REFS); - if (type == OP_RV2AV || type == OP_RV2HV || type == OP_REFGEN) { - op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : - type == OP_RV2HV ? OPpDEREF_HV : 0); - op->op_flags |= OPf_LVAL; + if (type == OP_RV2AV || type == OP_RV2HV) { + op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV); + op->op_flags |= OPf_MOD; } break; @@ -931,6 +1055,8 @@ I32 type; break; ref(cLISTOP->op_last, type); break; + default: + break; } return scalar(op); @@ -941,10 +1067,9 @@ my(op) OP *op; { OP *kid; - SV *sv; I32 type; - if (!op) + if (!op || error_count) return op; type = op->op_type; @@ -961,7 +1086,8 @@ OP *op; yyerror(tokenbuf); return op; } - op->op_flags |= OPf_LVAL|OPf_INTRO; + op->op_flags |= OPf_MOD; + op->op_private |= OPpLVAL_INTRO; return op; } @@ -989,7 +1115,7 @@ OP *right; if (right->op_type != OP_MATCH) left = mod(left, right->op_type); if (right->op_type == OP_TRANS) - op = newBINOP(OP_NULL, 0, scalar(left), right); + op = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right); else op = prepend_elem(right->op_type, scalar(left), right); if (type == OP_NOT) @@ -1016,7 +1142,7 @@ scope(o) OP *o; { if (o) { - if (o->op_flags & OPf_PARENS) { + if (o->op_flags & OPf_PARENS || perldb) { o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o); o->op_type = OP_LEAVE; o->op_ppaddr = ppaddr[OP_LEAVE]; @@ -1037,21 +1163,62 @@ OP *o; return o; } -OP * -block_head(o, startp) -OP *o; -OP **startp; +int +block_start() { - if (!o) { - *startp = 0; - return o; + int retval = savestack_ix; + comppad_name_fill = AvFILL(comppad_name); + SAVEINT(min_intro_pending); + SAVEINT(max_intro_pending); + min_intro_pending = 0; + SAVEINT(comppad_name_fill); + SAVEINT(padix_floor); + padix_floor = padix; + pad_reset_pending = FALSE; + SAVEINT(hints); + hints &= ~HINT_BLOCK_SCOPE; + return retval; +} + +OP* +block_end(line, floor, seq) +int line; +int floor; +OP* seq; +{ + int needblockscope = hints & HINT_BLOCK_SCOPE; + OP* retval = scalarseq(seq); + if (copline > (line_t)line) + copline = line; + LEAVE_SCOPE(floor); + pad_reset_pending = FALSE; + if (needblockscope) + hints |= HINT_BLOCK_SCOPE; /* propagate out */ + pad_leavemy(comppad_name_fill); + return retval; +} + +void +newPROG(op) +OP *op; +{ + if (in_eval) { + eval_root = newUNOP(OP_LEAVEEVAL, 0, op); + eval_start = linklist(eval_root); + eval_root->op_next = 0; + peep(eval_start); + } + else { + if (!op) { + main_start = 0; + return; + } + main_root = scope(sawparens(scalarvoid(op))); + curcop = &compiling; + main_start = LINKLIST(main_root); + main_root->op_next = 0; + peep(main_start); } - o = scope(sawparens(scalarvoid(o))); - curcop = &compiling; - *startp = LINKLIST(o); - o->op_next = 0; - peep(*startp); - return o; } OP * @@ -1066,7 +1233,7 @@ I32 lex; if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') { char *s; for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ; - if (*s == ';' || *s == '=' && (s[1] == '@' || s[2] == '@')) + if (*s == ';' || *s == '=') warn("Parens missing around \"%s\" list", lex ? "my" : "local"); } } @@ -1096,7 +1263,6 @@ register OP *o; { register OP *curop; I32 type = o->op_type; - SV *sv; if (opargs[type] & OA_RETSCALAR) scalar(o); @@ -1104,15 +1270,19 @@ register OP *o; o->op_targ = pad_alloc(type, SVs_PADTMP); if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER)) - o->op_ppaddr = ppaddr[++(o->op_type)]; + o->op_ppaddr = ppaddr[type = ++(o->op_type)]; if (!(opargs[type] & OA_FOLDCONST)) goto nope; + if (error_count) + goto nope; /* Don't try to run w/ errors */ + for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) { if (curop->op_type != OP_CONST && curop->op_type != OP_LIST && curop->op_type != OP_SCALAR && + curop->op_type != OP_NULL && curop->op_type != OP_PUSHMARK) { goto nope; } @@ -1125,7 +1295,7 @@ register OP *o; if (o->op_targ && *stack_sp == PAD_SV(o->op_targ)) /* grab pad temp? */ pad_swipe(o->op_targ); else if (SvTEMP(*stack_sp)) { /* grab mortal temp? */ - SvREFCNT_inc(*stack_sp); + (void)SvREFCNT_inc(*stack_sp); SvTEMP_off(*stack_sp); } op_free(o); @@ -1139,7 +1309,7 @@ register OP *o; return o; if (!(hints & HINT_INTEGER)) { - if (!(o->op_flags & OPf_KIDS)) + if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS)) return o; for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) { @@ -1152,9 +1322,9 @@ register OP *o; continue; return o; } + o->op_ppaddr = ppaddr[++(o->op_type)]; } - o->op_ppaddr = ppaddr[++(o->op_type)]; return o; } @@ -1163,34 +1333,25 @@ gen_constant_list(o) register OP *o; { register OP *curop; - OP *anonop; - I32 tmpmark; - I32 tmpsp; I32 oldtmps_floor = tmps_floor; - AV *av; - GV *gv; - tmpmark = stack_sp - stack_base; - anonop = newANONLIST(o); - curop = LINKLIST(anonop); - anonop->op_next = 0; - op = curop; + list(o); + if (error_count) + return o; /* Don't attempt to run with errors */ + + op = curop = LINKLIST(o); + o->op_next = 0; + pp_pushmark(); run(); - tmpsp = stack_sp - stack_base; + op = curop; + pp_anonlist(); tmps_floor = oldtmps_floor; - stack_sp = stack_base + tmpmark; o->op_type = OP_RV2AV; o->op_ppaddr = ppaddr[OP_RV2AV]; - o->op_sibling = 0; curop = ((UNOP*)o)->op_first; - ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, newSVsv(stack_sp[1])); + ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--)); op_free(curop); - curop = ((UNOP*)anonop)->op_first; - curop = ((UNOP*)curop)->op_first; - curop->op_sibling = 0; - op_free(anonop); - o->op_next = 0; linklist(o); return list(o); } @@ -1202,7 +1363,7 @@ I32 flags; OP* op; { OP *kid; - OP *last; + OP *last = 0; if (!op || op->op_type != OP_LIST) op = newLISTOP(OP_LIST, 0, op, Nullop); @@ -1242,19 +1403,18 @@ OP* last; if (!last) return first; - if (first->op_type == type) { - if (first->op_flags & OPf_KIDS) - ((LISTOP*)first)->op_last->op_sibling = last; - else { - first->op_flags |= OPf_KIDS; - ((LISTOP*)first)->op_first = last; - } - ((LISTOP*)first)->op_last = last; - ((LISTOP*)first)->op_children++; - return first; - } + if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS) + return newLISTOP(type, 0, first, last); - return newLISTOP(type, 0, first, last); + if (first->op_flags & OPf_KIDS) + ((LISTOP*)first)->op_last->op_sibling = last; + else { + first->op_flags |= OPf_KIDS; + ((LISTOP*)first)->op_first = last; + } + ((LISTOP*)first)->op_last = last; + ((LISTOP*)first)->op_children++; + return first; } OP * @@ -1406,8 +1566,6 @@ OP* first; first = newOP(OP_STUB, 0); if (opargs[type] & OA_MARK) first = force_list(first); - else if (first->op_type == OP_LIST) - unlist(first); Newz(1101, unop, 1, UNOP); unop->op_type = type; @@ -1420,7 +1578,7 @@ OP* first; if (unop->op_next) return (OP*)unop; - return fold_constants(unop); + return fold_constants((OP *) unop); } OP * @@ -1455,7 +1613,7 @@ OP* last; binop->op_last = last = binop->op_first->op_sibling; - return fold_constants(binop); + return fold_constants((OP *)binop); } OP * @@ -1464,7 +1622,6 @@ OP *op; OP *expr; OP *repl; { - PMOP *pm = (PMOP*)op; SV *tstr = ((SVOP*)expr)->op_sv; SV *rstr = ((SVOP*)repl)->op_sv; STRLEN tlen; @@ -1541,7 +1698,7 @@ I32 flags; pmop->op_private = 0; /* link into pm list */ - if (type != OP_TRANS) { + if (type != OP_TRANS && curstash) { pmop->op_pmnext = HvPMROOT(curstash); HvPMROOT(curstash) = pmop; } @@ -1572,10 +1729,12 @@ OP *repl; p = SvPV(pat, plen); pm->op_pmflags |= PMf_SKIPWHITE; } +#ifdef NOTDEF scan_prefix(pm, p, plen); if (pm->op_pmshort && (pm->op_pmflags & PMf_SCANFIRST)) fbm_compile(pm->op_pmshort, pm->op_pmflags & PMf_FOLD); - pm->op_pmregexp = regcomp(p, p + plen, pm->op_pmflags & PMf_FOLD); +#endif + pm->op_pmregexp = regcomp(p, p + plen, pm); if (strEQ("\\s+", pm->op_pmregexp->precomp)) pm->op_pmflags |= PMf_WHITE; hoistmust(pm); @@ -1757,8 +1916,8 @@ OP *op; STRLEN len; char *name; sv = cSVOP->op_sv; - curstash = fetch_stash(sv,TRUE); name = SvPV(sv, len); + curstash = gv_stashpv(name,TRUE); sv_setpvn(curstname, name, len); op_free(op); } @@ -1771,82 +1930,48 @@ OP *op; } void -hint(aver, id, arg) +utilize(aver, id, arg) int aver; OP *id; OP *arg; { - SV *sv; - U32 bits = 0; - SV **sp = 0; - SV **mark = 0; - - if (arg) { - OP* curop = LINKLIST(arg); - arg->op_next = 0; - op = curop; - run(); - sp = stack_sp; - mark = stack_base + POPMARK; - stack_sp = mark; /* Might as well reset sp now. */ - } - if (id) { - STRLEN len; - char *name; - sv = ((SVOP*)id)->op_sv; - name = SvPV(sv, len); + OP *pack; + OP *meth; + OP *rqop; + OP *imop; - if (strEQ(name, "integer")) - bits = HINT_INTEGER; - else if (strEQ(name, "strict")) { - if (arg) { - while (++mark <= sp) { - if (strEQ(SvPV(*mark,na), "refs")) - bits |= HINT_STRICT_REFS; - else if (strEQ(SvPV(*mark,na), "subs")) - bits |= HINT_STRICT_SUBS; - else if (strEQ(SvPV(*mark,na), "vars")) - bits |= HINT_STRICT_VARS; - } - } - else - bits = HINT_STRICT_REFS|HINT_STRICT_SUBS|HINT_STRICT_VARS; - } + if (id->op_type != OP_CONST) + croak("Module name must be constant"); - if (aver) - hints |= bits; - else - hints &= ~bits; + meth = newSVOP(OP_CONST, 0, + aver + ? newSVpv("import", 6) + : newSVpv("unimport", 8) + ); + + /* Make copy of id so we don't free it twice */ + pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv)); + + /* Fake up a require */ + rqop = newUNOP(OP_REQUIRE, 0, id); + + /* Fake up an import/unimport */ + imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL, + append_elem(OP_LIST, + prepend_elem(OP_LIST, pack, list(arg)), + newUNOP(OP_METHOD, 0, meth))); + + /* Fake up the BEGIN {}, which does its thing immediately. */ + newSUB(start_subparse(), + newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)), + append_elem(OP_LINESEQ, + newSTATEOP(0, Nullch, rqop), + newSTATEOP(0, Nullch, imop) )); - op_free(id); - } - if (arg) - op_free(arg); copline = NOLINE; expect = XSTATE; } -HV* -fetch_stash(sv,create) -SV *sv; -I32 create; -{ - char tmpbuf[256]; - HV *stash; - GV *tmpgv; - char *name = SvPV(sv, na); - sprintf(tmpbuf,"%s::",name); - tmpgv = gv_fetchpv(tmpbuf,create, SVt_PVHV); - if (!tmpgv) - return 0; - if (!GvHV(tmpgv)) - GvHV(tmpgv) = newHV(); - stash = GvHV(tmpgv); - if (!HvNAME(stash)) - HvNAME(stash) = savestr(name); - return stash; -} - OP * newSLICEOP(flags, subscript, listval) I32 flags; @@ -1894,20 +2019,41 @@ register OP *op; } OP * -newASSIGNOP(flags, left, right) +newASSIGNOP(flags, left, optype, right) I32 flags; OP *left; +I32 optype; OP *right; { OP *op; + if (optype) { + if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) { + return newLOGOP(optype, 0, + mod(scalar(left), optype), + newUNOP(OP_SASSIGN, 0, scalar(right))); + } + else { + return newBINOP(optype, OPf_STACKED, + mod(scalar(left), optype), scalar(right)); + } + } + if (list_assignment(left)) { modcount = 0; + eval_start = right; /* Grandfathering $[ assignment here. Bletch. */ left = mod(left, OP_AASSIGN); + if (!eval_start) { + op_free(left); + op_free(right); + return Nullop; + } if (right && right->op_type == OP_SPLIT) { if ((op = ((LISTOP*)right)->op_first) && op->op_type == OP_PUSHRE) { PMOP *pm = (PMOP*)op; - if (left->op_type == OP_RV2AV) { + if (left->op_type == OP_RV2AV && + !(left->op_private & OPpLVAL_INTRO) ) + { op = ((UNOP*)left)->op_first; if (op->op_type == OP_GV && !pm->op_pmreplroot) { pm->op_pmreplroot = (OP*)((GVOP*)op)->op_gv; @@ -1929,7 +2075,7 @@ OP *right; list(force_list(right)), list(force_list(left)) ); op->op_private = 0; - if (!(left->op_flags & OPf_INTRO)) { + if (!(left->op_private & OPpLVAL_INTRO)) { static int generation = 0; OP *curop; OP *lastop = op; @@ -1967,9 +2113,15 @@ OP *right; right->op_flags |= OPf_STACKED; return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right)); } - else + else { + eval_start = right; /* Grandfathering $[ assignment here. Bletch. */ op = newBINOP(OP_SASSIGN, flags, scalar(right), mod(scalar(left), OP_SASSIGN) ); + if (!eval_start) { + op_free(op); + return Nullop; + } + } return op; } @@ -1987,7 +2139,7 @@ OP *op; I32 i; SV *sv; for (i = min_intro_pending; i <= max_intro_pending; i++) { - if (sv = svp[i]) + if ((sv = svp[i]) && sv != &sv_undef) SvIVX(sv) = 999999999; /* Don't know scope end yet. */ } min_intro_pending = 0; @@ -2012,6 +2164,7 @@ OP *op; hints |= HINT_BLOCK_SCOPE; } cop->cop_seq = cop_seqmax++; + cop->cop_arybase = curcop->cop_arybase; if (copline == NOLINE) cop->cop_line = curcop->cop_line; @@ -2026,7 +2179,7 @@ OP *op; SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE); if (svp && *svp != &sv_undef && !SvIOK(*svp)) { SvIVX(*svp) = 1; - SvIOK_on(*svp); + (void)SvIOK_on(*svp); SvSTASH(*svp) = (HV*)cop; } } @@ -2044,6 +2197,9 @@ OP* other; LOGOP *logop; OP *op; + if (type == OP_XOR) /* Not short circuit, but here by precedence. */ + return newBINOP(type, flags, scalar(first), scalar(other)); + scalarboolean(first); /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */ if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) { @@ -2082,6 +2238,9 @@ OP* other; if (!other) return first; + if (type == OP_ANDASSIGN || type == OP_ORASSIGN) + other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */ + Newz(1101, logop, 1, LOGOP); logop->op_type = type; @@ -2215,13 +2374,13 @@ OP *block; OP* listop; OP* op; int once = block && block->op_flags & OPf_SPECIAL && - (block->op_type == OP_ENTERSUBR || block->op_type == OP_NULL); + (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL); if (expr) { if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv)) return block; /* do {} while 0 does once */ else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB) - expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), expr); + expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr); } listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0)); @@ -2233,7 +2392,9 @@ OP *block; op->op_next = ((LOGOP*)cUNOP->op_first)->op_other; op->op_flags |= flags; - return scope(op); + op = scope(op); + op->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration */ + return op; } OP * @@ -2252,7 +2413,7 @@ OP *cont; OP *condop; if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) - expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), expr); + expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr); if (!block) block = newOP(OP_NULL, 0); @@ -2303,7 +2464,7 @@ OP *cont; } OP * -#ifndef STANDARD_C +#ifndef CAN_PROTOTYPE newFOROP(flags,label,forline,sv,expr,block,cont) I32 flags; char *label; @@ -2314,7 +2475,7 @@ OP*block; OP*cont; #else newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont) -#endif /* STANDARD_C */ +#endif /* CAN_PROTOTYPE */ { LOOP *loop; int padoff = 0; @@ -2340,7 +2501,8 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont sv = newGVOP(OP_GV, 0, defgv); } loop = (LOOP*)list(convert(OP_ENTERITER, 0, - append_elem(OP_LIST, force_list(expr), scalar(sv)))); + append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART), + scalar(sv)))); assert(!loop->op_next); Renew(loop, 1, LOOP); loop->op_targ = padoff; @@ -2355,12 +2517,15 @@ OP* label; { OP *op; if (type != OP_GOTO || label->op_type == OP_CONST) { - op = newPVOP(type, 0, savestr(SvPVx(((SVOP*)label)->op_sv, na))); + op = newPVOP(type, 0, savepv( + label->op_type == OP_CONST + ? SvPVx(((SVOP*)label)->op_sv, na) + : "" )); op_free(label); } else { - if (label->op_type == OP_ENTERSUBR) - label = newUNOP(OP_REFGEN, 0, ref(label, OP_REFGEN)); + if (label->op_type == OP_ENTERSUB) + label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN)); op = newUNOP(type, OPf_STACKED, label); } hints |= HINT_BLOCK_SCOPE; @@ -2371,53 +2536,50 @@ void cv_undef(cv) CV *cv; { - if (!CvUSERSUB(cv) && CvROOT(cv)) { + if (!CvXSUB(cv) && CvROOT(cv)) { + if (CvDEPTH(cv)) + croak("Can't undef active subroutine"); ENTER; - if (CvPADLIST(cv)) { - SV** svp = av_fetch(CvPADLIST(cv), 0, FALSE); - if (svp) { - SAVESPTR(comppad); - SAVESPTR(curpad); - comppad = (AV*)*svp; /* Need same context we had compiling */ - curpad = AvARRAY(comppad); - } - } + + SAVESPTR(curpad); + curpad = 0; + op_free(CvROOT(cv)); CvROOT(cv) = Nullop; - if (CvDEPTH(cv)) - warn("Deleting active subroutine"); /* XXX */ if (CvPADLIST(cv)) { I32 i = AvFILL(CvPADLIST(cv)); - while (i > 0) { + while (i >= 0) { SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE); if (svp) - sv_free(*svp); + SvREFCNT_dec(*svp); } - sv_free(CvPADLIST(cv)); + SvREFCNT_dec((SV*)CvPADLIST(cv)); } SvREFCNT_dec(CvGV(cv)); LEAVE; } } -void +CV * newSUB(floor,op,block) I32 floor; OP *op; OP *block; { register CV *cv; - char *name = SvPVx(cSVOP->op_sv, na); - GV *gv = gv_fetchpv(name,2, SVt_PVCV); + char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__"; + GV *gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV); AV* av; char *s; + I32 ix; - sub_generation++; - if ((cv = GvCV(gv)) && !GvCVGEN(gv)) { - if (CvDEPTH(cv)) - CvDELETED(cv) = TRUE; /* probably an autoloader */ - else { - if (dowarn && CvROOT(cv)) { + if (op) + sub_generation++; + if (cv = GvCV(gv)) { + if (GvCVGEN(gv)) + cv = 0; /* just a cached method */ + else if (CvROOT(cv)) { /* already defined? */ + if (dowarn) { line_t oldline = curcop->cop_line; curcop->cop_line = copline; @@ -2425,45 +2587,54 @@ OP *block; curcop->cop_line = oldline; } SvREFCNT_dec(cv); + cv = 0; } } - Newz(101,cv,1,CV); - sv_upgrade(cv, SVt_PVCV); - SvREFCNT(cv) = 1; + if (cv) { /* must reuse cv if autoloaded */ + assert(SvREFCNT(CvGV(cv)) > 1); + SvREFCNT_dec(CvGV(cv)); + } + else { + cv = (CV*)NEWSV(1104,0); + sv_upgrade((SV *)cv, SVt_PVCV); + } GvCV(gv) = cv; GvCVGEN(gv) = 0; CvFILEGV(cv) = curcop->cop_filegv; CvGV(cv) = SvREFCNT_inc(gv); CvSTASH(cv) = curstash; - av = newAV(); - av_store(av, 0, Nullsv); + if (!block) { + CvROOT(cv) = 0; + op_free(op); + copline = NOLINE; + LEAVE_SCOPE(floor); + return cv; + } + + av = newAV(); /* Will be @_ */ + av_extend(av, 0); av_store(comppad, 0, (SV*)av); - SvOK_on(av); - AvREAL_off(av); + AvFLAGS(av) = AVf_REIFY; + + for (ix = AvFILL(comppad); ix > 0; ix--) { + if (!SvPADMY(curpad[ix])) + SvPADTMP_on(curpad[ix]); + } av = newAV(); AvREAL_off(av); if (AvFILL(comppad_name) < AvFILL(comppad)) av_store(comppad_name, AvFILL(comppad), Nullsv); - av_store(av, 0, (SV*)comppad_name); - av_store(av, 1, (SV*)comppad); + av_store(av, 0, SvREFCNT_inc((SV*)comppad_name)); + av_store(av, 1, SvREFCNT_inc((SV*)comppad)); AvFILL(av) = 1; CvPADLIST(cv) = av; - comppad_name = newAV(); - if (!block) { - CvROOT(cv) = 0; - op_free(op); - copline = NOLINE; - LEAVE_SCOPE(floor); - return; - } - CvROOT(cv) = newUNOP(OP_LEAVESUBR, 0, scalarseq(block)); + CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block)); CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; peep(CvSTART(cv)); - CvDELETED(cv) = FALSE; if (s = strrchr(name,':')) s++; else @@ -2502,7 +2673,7 @@ OP *block; SV *sv; SV *tmpstr = sv_newmortal(); - sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), subline); + sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline); sv = newSVpv(buf,0); sv_catpv(sv,"-"); sprintf(buf,"%ld",(long)curcop->cop_line); @@ -2513,40 +2684,69 @@ OP *block; op_free(op); copline = NOLINE; LEAVE_SCOPE(floor); + if (!op) + GvCV(gv) = 0; /* Will remember in SVOP instead. */ + return cv; } -void +#ifdef DEPRECATED +CV * newXSUB(name, ix, subaddr, filename) char *name; I32 ix; I32 (*subaddr)(); char *filename; { + CV* cv = newXS(name, (void(*)())subaddr, filename); + CvOLDSTYLE(cv) = TRUE; + CvXSUBANY(cv).any_i32 = ix; + return cv; +} +#endif + +CV * +newXS(name, subaddr, filename) +char *name; +void (*subaddr) _((CV*)); +char *filename; +{ register CV *cv; - GV *gv = gv_fetchpv(name,2, SVt_PVCV); + GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV); char *s; - sub_generation++; - if ((cv = GvCV(gv)) && !GvCVGEN(gv)) { - if (dowarn) - warn("Subroutine %s redefined",name); - if (!CvUSERSUB(cv) && CvROOT(cv)) { - op_free(CvROOT(cv)); - CvROOT(cv) = Nullop; + if (name) + sub_generation++; + if (cv = GvCV(gv)) { + if (GvCVGEN(gv)) + cv = 0; /* just a cached method */ + else if (CvROOT(cv)) { /* already defined? */ + if (dowarn) { + line_t oldline = curcop->cop_line; + + curcop->cop_line = copline; + warn("Subroutine %s redefined",name); + curcop->cop_line = oldline; + } + SvREFCNT_dec(cv); + cv = 0; } - Safefree(cv); } - Newz(101,cv,1,CV); - sv_upgrade(cv, SVt_PVCV); - SvREFCNT(cv) = 1; + if (cv) { /* must reuse cv if autoloaded */ + assert(SvREFCNT(CvGV(cv)) > 1); + SvREFCNT_dec(CvGV(cv)); + } + else { + cv = (CV*)NEWSV(1105,0); + sv_upgrade((SV *)cv, SVt_PVCV); + } GvCV(gv) = cv; CvGV(cv) = SvREFCNT_inc(gv); GvCVGEN(gv) = 0; CvFILEGV(cv) = gv_fetchfile(filename); - CvUSERSUB(cv) = subaddr; - CvUSERINDEX(cv) = ix; - CvDELETED(cv) = FALSE; - if (s = strrchr(name,':')) + CvXSUB(cv) = subaddr; + if (!name) + s = "__ANON__"; + else if (s = strrchr(name,':')) s++; else s = name; @@ -2561,6 +2761,9 @@ char *filename; av_unshift(endav, 1); av_store(endav, 0, SvREFCNT_inc(gv)); } + if (!name) + GvCV(gv) = 0; /* Will remember elsewhere instead. */ + return cv; } void @@ -2573,12 +2776,14 @@ OP *block; char *name; GV *gv; AV* av; + I32 ix; if (op) name = SvPVx(cSVOP->op_sv, na); else name = "STDOUT"; gv = gv_fetchpv(name,TRUE, SVt_PVFM); + SvMULTI_on(gv); if (cv = GvFORM(gv)) { if (dowarn) { line_t oldline = curcop->cop_line; @@ -2589,23 +2794,26 @@ OP *block; } SvREFCNT_dec(cv); } - Newz(101,cv,1,CV); - sv_upgrade(cv, SVt_PVFM); - SvREFCNT(cv) = 1; + cv = (CV*)NEWSV(1106,0); + sv_upgrade((SV *)cv, SVt_PVFM); GvFORM(gv) = cv; CvGV(cv) = SvREFCNT_inc(gv); CvFILEGV(cv) = curcop->cop_filegv; + for (ix = AvFILL(comppad); ix > 0; ix--) { + if (!SvPADMY(curpad[ix])) + SvPADTMP_on(curpad[ix]); + } + CvPADLIST(cv) = av = newAV(); AvREAL_off(av); - av_store(av, 1, (SV*)comppad); + av_store(av, 1, SvREFCNT_inc((SV*)comppad)); AvFILL(av) = 1; CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block)); CvSTART(cv) = LINKLIST(CvROOT(cv)); CvROOT(cv)->op_next = 0; peep(CvSTART(cv)); - CvDELETED(cv) = FALSE; FmLINES(cv) = 0; op_free(op); copline = NOLINE; @@ -2636,7 +2844,7 @@ newANONLIST(op) OP* op; { return newUNOP(OP_REFGEN, 0, - ref(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN)); + mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN)); } OP * @@ -2644,7 +2852,16 @@ newANONHASH(op) OP* op; { return newUNOP(OP_REFGEN, 0, - ref(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN)); + mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN)); +} + +OP * +newANONSUB(floor, block) +I32 floor; +OP *block; +{ + return newUNOP(OP_REFGEN, 0, + newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, block))); } OP * @@ -2708,10 +2925,13 @@ OP *o; } OP * -newGVREF(o) +newGVREF(type,o) +I32 type; OP *o; { - return newUNOP(OP_RV2GV, 0, scalar(o)); + if (type == OP_MAPSTART) + return newUNOP(OP_NULL, 0, o); + return newUNOP(OP_RV2GV, 0, o); } OP * @@ -2766,22 +2986,41 @@ OP *op; } OP * -ck_chop(op) +ck_spair(op) OP *op; { if (op->op_flags & OPf_KIDS) { OP* newop; + OP* kid; op = modkids(ck_fun(op), op->op_type); - if (op->op_private != 1) + kid = cUNOP->op_first; + newop = kUNOP->op_first->op_sibling; + if (newop && + (newop->op_sibling || + !(opargs[newop->op_type] & OA_RETSCALAR) || + newop->op_type == OP_PADAV || newop->op_type == OP_PADHV || + newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) { + return op; - newop = cUNOP->op_first->op_sibling; - if (!newop || newop->op_type != OP_RV2SV) - return op; - op_free(cUNOP->op_first); - cUNOP->op_first = newop; + } + op_free(kUNOP->op_first); + kUNOP->op_first = newop; + } + op->op_ppaddr = ppaddr[++op->op_type]; + return ck_fun(op); +} + +OP * +ck_delete(op) +OP *op; +{ + op = ck_fun(op); + if (op->op_flags & OPf_KIDS) { + OP *kid = cUNOP->op_first; + if (kid->op_type != OP_HELEM) + croak("%s argument is not a HASH element", op_name[op->op_type]); + null(kid); } - op->op_type = OP_SCHOP; - op->op_ppaddr = ppaddr[OP_SCHOP]; return op; } @@ -2840,6 +3079,7 @@ OP *op; op_free(op); op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); } + op->op_targ = (PADOFFSET)hints; return op; } @@ -2874,12 +3114,26 @@ ck_rvconst(op) register OP *op; { SVOP *kid = (SVOP*)cUNOP->op_first; - int iscv = (op->op_type==OP_RV2CV); + int iscv = (op->op_type==OP_RV2CV)*2; + op->op_private = (hints & HINT_STRICT_REFS); if (kid->op_type == OP_CONST) { + GV *gv = 0; kid->op_type = OP_GV; - kid->op_sv = SvREFCNT_inc(gv_fetchpv(SvPVx(kid->op_sv, na), - 1+iscv, iscv ? SVt_PVCV : SVt_PVGV)); + for (gv = 0; !gv; iscv++) { + gv = gv_fetchpv(SvPVx(kid->op_sv, na), + iscv, + iscv + ? SVt_PVCV + : op->op_type == OP_RV2SV + ? SVt_PV + : op->op_type == OP_RV2AV + ? SVt_PVAV + : op->op_type == OP_RV2HV + ? SVt_PVHV + : SVt_PVGV); + } + kid->op_sv = SvREFCNT_inc(gv); } return op; } @@ -2897,14 +3151,14 @@ OP *op; { I32 type = op->op_type; - if (op->op_flags & OPf_SPECIAL) + if (op->op_flags & OPf_REF) return op; if (op->op_flags & OPf_KIDS) { SVOP *kid = (SVOP*)cUNOP->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - OP *newop = newGVOP(type, OPf_SPECIAL, + OP *newop = newGVOP(type, OPf_REF, gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO)); op_free(op); return newop; @@ -2913,7 +3167,7 @@ OP *op; else { op_free(op); if (type == OP_FTTTY) - return newGVOP(type, OPf_SPECIAL, gv_fetchpv("main'STDIN", TRUE, + return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE, SVt_PVIO)); else return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); @@ -2929,7 +3183,8 @@ OP *op; OP **tokid; OP *sibl; I32 numargs = 0; - register I32 oa = opargs[op->op_type] >> 8; + int type = op->op_type; + register I32 oa = opargs[type] >> OASHIFT; if (op->op_flags & OPf_STACKED) { if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL)) @@ -2947,6 +3202,8 @@ OP *op; tokid = &kid->op_sibling; kid = kid->op_sibling; } + if (!kid && opargs[type] & OA_DEFGV) + *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv)); while (oa && kid) { numargs++; @@ -2971,7 +3228,7 @@ OP *op; gv_fetchpv(name, TRUE, SVt_PVAV) )); if (dowarn) warn("Array @%s missing the @ in argument %d of %s()", - name, numargs, op_name[op->op_type]); + name, numargs, op_name[type]); op_free(kid); kid = newop; kid->op_sibling = sibl; @@ -2979,7 +3236,7 @@ OP *op; } else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV) bad_type(numargs, "array", op, kid); - mod(kid, op->op_type); + mod(kid, type); break; case OA_HVREF: if (kid->op_type == OP_CONST && @@ -2989,7 +3246,7 @@ OP *op; gv_fetchpv(name, TRUE, SVt_PVHV) )); if (dowarn) warn("Hash %%%s missing the %% in argument %d of %s()", - name, numargs, op_name[op->op_type]); + name, numargs, op_name[type]); op_free(kid); kid = newop; kid->op_sibling = sibl; @@ -2997,11 +3254,11 @@ OP *op; } else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV) bad_type(numargs, "hash", op, kid); - mod(kid, op->op_type); + mod(kid, type); break; case OA_CVREF: { - OP *newop = newUNOP(OP_NULL, 0, scalar(kid)); + OP *newop = newUNOP(OP_NULL, 0, kid); kid->op_sibling = 0; linklist(kid); newop->op_next = newop; @@ -3030,7 +3287,7 @@ OP *op; scalar(kid); break; case OA_SCALARREF: - mod(scalar(kid), op->op_type); + mod(scalar(kid), type); break; } oa >>= 4; @@ -3042,6 +3299,11 @@ OP *op; return too_many_arguments(op); listkids(op); } + else if (opargs[type] & OA_DEFGV) { + op_free(op); + return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv))); + } + if (oa) { while (oa & OA_OPTIONAL) oa >>= 4; @@ -3055,11 +3317,11 @@ OP * ck_glob(op) OP *op; { - GV *gv = newGVgen(); - GvIOn(gv); + GV *gv = newGVgen("main"); + gv_IOadd(gv); append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv)); scalarkids(op); - return op; + return ck_fun(op); } OP * @@ -3068,29 +3330,48 @@ OP *op; { LOGOP *gwop; OP *kid; + OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE; + op->op_ppaddr = ppaddr[OP_GREPSTART]; + Newz(1101, gwop, 1, LOGOP); + if (op->op_flags & OPf_STACKED) { + OP* k; op = ck_sort(op); + for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) { + kid = k; + } + kid->op_next = (OP*)gwop; op->op_flags &= ~OPf_STACKED; } + kid = cLISTOP->op_first->op_sibling; + if (type == OP_MAPWHILE) + list(kid); + else + scalar(kid); op = ck_fun(op); if (error_count) return op; - kid = cLISTOP->op_first->op_sibling; + kid = cLISTOP->op_first->op_sibling; if (kid->op_type != OP_NULL) croak("panic: ck_grep"); kid = kUNOP->op_first; - Newz(1101, gwop, 1, LOGOP); - gwop->op_type = OP_GREPWHILE; - gwop->op_ppaddr = ppaddr[OP_GREPWHILE]; - gwop->op_first = list(op); + gwop->op_type = type; + gwop->op_ppaddr = ppaddr[type]; + gwop->op_first = listkids(op); gwop->op_flags |= OPf_KIDS; gwop->op_private = 1; gwop->op_other = LINKLIST(kid); - gwop->op_targ = pad_alloc(OP_GREPWHILE, SVs_PADTMP); + gwop->op_targ = pad_alloc(type, SVs_PADTMP); kid->op_next = (OP*)gwop; + kid = cLISTOP->op_first->op_sibling; + if (!kid || !kid->op_sibling) + return too_few_arguments(op); + for (kid = kid->op_sibling; kid; kid = kid->op_sibling) + mod(kid, OP_GREPSTART); + return (OP*)gwop; } @@ -3111,7 +3392,7 @@ ck_lengthconst(op) OP *op; { /* XXX length optimization goes here */ - return op; + return ck_fun(op); } OP * @@ -3191,24 +3472,19 @@ OP * ck_require(op) OP *op; { - if (op->op_flags & OPf_KIDS) { /* Shall we fake a BEGIN {}? */ + if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */ SVOP *kid = (SVOP*)cUNOP->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { - char *name = SvPVX(subname); char *s; - sv_catpvn(kid->op_sv, ".pm", 3); - if (s = strrchr(name,':')) - s++; - else - s = name; - if (strNE(s, "BEGIN")) { - op = newSTATEOP(0, Nullch, op); - newSUB(start_subparse(), - newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)), - op); - return newOP(OP_STUB,0); + for (s = SvPVX(kid->op_sv); *s; s++) { + if (*s == ':' && s[1] == ':') { + *s = '/'; + strcpy(s+1,s+2); /* known to be okay here */ + --SvCUR(kid->op_sv); + } } + sv_catpvn(kid->op_sv, ".pm", 3); } } return ck_fun(op); @@ -3269,7 +3545,6 @@ OP *op; if (kid->op_type == OP_SCOPE) { k = kid->op_next; kid->op_next = 0; - peep(k); } else if (kid->op_type == OP_LEAVE) { null(kid); /* wipe out leave */ @@ -3279,11 +3554,16 @@ OP *op; if (k->op_next == kid) k->op_next = 0; } - peep(kLISTOP->op_first); + k = kLISTOP->op_first; } + peep(k); + kid = cLISTOP->op_first->op_sibling; /* get past pushmark */ null(kid); /* wipe out rv2gv */ - kid->op_next = kid; + if (op->op_type == OP_SORT) + kid->op_next = kid; + else + kid->op_next = k; op->op_flags |= OPf_SPECIAL; } } @@ -3360,6 +3640,8 @@ OP *op; op->op_private = (hints & HINT_STRICT_REFS); if (perldb && curstash != debstash) op->op_private |= OPpDEREF_DB; + while (o = o->op_sibling) + mod(o, OP_ENTERSUB); return op; } @@ -3378,7 +3660,10 @@ OP *op; if (op->op_flags & OPf_KIDS) { SVOP *kid = (SVOP*)cUNOP->op_first; - if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) + if (kid->op_type == OP_NULL) + kid = (SVOP*)kid->op_sibling; + if (kid && + kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) op->op_flags |= OPf_SPECIAL; } return ck_fun(op); @@ -3387,19 +3672,40 @@ OP *op; /* A peephole optimizer. We visit the ops in the order they're to execute. */ void -peep(op) -register OP* op; +peep(o) +register OP* o; { register OP* oldop = 0; - if (!op || op->op_seq) + if (!o || o->op_seq) return; - for (; op; op = op->op_next) { - if (op->op_seq) - return; - switch (op->op_type) { + ENTER; + SAVESPTR(op); + SAVESPTR(curcop); + for (; o; o = o->op_next) { + if (o->op_seq) + break; + op = o; + switch (o->op_type) { + case OP_NEXTSTATE: + case OP_DBSTATE: + curcop = ((COP*)o); /* for warnings */ + break; + + case OP_CONCAT: + case OP_CONST: + case OP_JOIN: + case OP_UC: + case OP_UCFIRST: + case OP_LC: + case OP_LCFIRST: + case OP_QUOTEMETA: + if (o->op_next->op_type == OP_STRINGIFY) + null(o->op_next); + o->op_seq = ++op_seqmax; + break; case OP_STUB: - if ((op->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) { - op->op_seq = ++op_seqmax; + if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) { + o->op_seq = ++op_seqmax; break; /* Scalar stub must produce undef. List stub is noop */ } /* FALL THROUGH */ @@ -3407,63 +3713,65 @@ register OP* op; case OP_SCALAR: case OP_LINESEQ: case OP_SCOPE: - if (oldop) { - oldop->op_next = op->op_next; + if (oldop && o->op_next) { + oldop->op_next = o->op_next; continue; } - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; break; case OP_GV: - if (op->op_next->op_type == OP_RV2SV) { - if (!(op->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) { - null(op->op_next); - op->op_flags |= op->op_next->op_flags & OPf_INTRO; - op->op_next = op->op_next->op_next; - op->op_type = OP_GVSV; - op->op_ppaddr = ppaddr[OP_GVSV]; + if (o->op_next->op_type == OP_RV2SV) { + if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) { + null(o->op_next); + o->op_private |= o->op_next->op_private & OPpLVAL_INTRO; + o->op_next = o->op_next->op_next; + o->op_type = OP_GVSV; + o->op_ppaddr = ppaddr[OP_GVSV]; } } - else if (op->op_next->op_type == OP_RV2AV) { - OP* pop = op->op_next->op_next; - I32 i; + else if (o->op_next->op_type == OP_RV2AV) { + OP* pop = o->op_next->op_next; + IV i; if (pop->op_type == OP_CONST && + (op = pop->op_next) && pop->op_next->op_type == OP_AELEM && - !(pop->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV)) && - !(pop->op_next->op_flags & OPf_INTRO) && - (i = SvIV(((SVOP*)pop)->op_sv)) <= 255 && + !(pop->op_next->op_private & + (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) && + (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase) + <= 255 && i >= 0) { - null(op->op_next); + null(o->op_next); null(pop->op_next); null(pop); - op->op_flags &= ~OPf_LVAL; - op->op_flags |= pop->op_next->op_flags & OPf_LVAL; - op->op_next = pop->op_next->op_next; - op->op_type = OP_AELEMFAST; - op->op_ppaddr = ppaddr[OP_AELEMFAST]; - op->op_private = i; - GvAVn((GV*)cSVOP->op_sv); + o->op_flags |= pop->op_next->op_flags & OPf_MOD; + o->op_next = pop->op_next->op_next; + o->op_type = OP_AELEMFAST; + o->op_ppaddr = ppaddr[OP_AELEMFAST]; + o->op_private = (U8)i; + GvAVn((GV*)(((SVOP*)o)->op_sv)); } } - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; break; + case OP_MAPWHILE: case OP_GREPWHILE: case OP_AND: case OP_OR: - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; peep(cLOGOP->op_other); break; case OP_COND_EXPR: - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; peep(cCONDOP->op_true); peep(cCONDOP->op_false); break; case OP_ENTERLOOP: - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; peep(cLOOP->op_redoop); peep(cLOOP->op_nextop); peep(cLOOP->op_lastop); @@ -3471,14 +3779,29 @@ register OP* op; case OP_MATCH: case OP_SUBST: - op->op_seq = ++op_seqmax; - peep(cPMOP->op_pmreplroot); + o->op_seq = ++op_seqmax; + peep(cPMOP->op_pmreplstart); break; + case OP_EXEC: + 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_DIE) { + line_t oldline = curcop->cop_line; + + curcop->cop_line = ((COP*)o->op_next)->cop_line; + warn("Statement unlikely to be reached"); + warn("(Maybe you meant system() when you said exec()?)\n"); + curcop->cop_line = oldline; + } + } + break; default: - op->op_seq = ++op_seqmax; + o->op_seq = ++op_seqmax; break; } - oldop = op; + oldop = o; } + LEAVE; } |