perl 5.002beta2 patch: doop.c
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index eb8cf7b..9ae1bdc 100644 (file)
--- a/op.c
+++ b/op.c
 #include "EXTERN.h"
 #include "perl.h"
 
+#ifdef USE_OP_MASK
+/*
+ * In the following definition, the ", (OP *) op" is just to make the compiler
+ * think the expression is of the right type: croak actually does a longjmp.
+ */
+#define CHECKOP(type,op) ((op_mask && op_mask[type]) ? \
+    (croak("%s trapped by operation mask", op_name[type]), (OP *) op) \
+    : (*check[type])((OP *) op))
+#else
+#define CHECKOP(type,op) (*check[type])(op)
+#endif /* USE_OP_MASK */
+
 static I32 list_assignment _((OP *op));
-static OP *bad_type _((I32 n, char *t, OP *op, OP *kid));
+static OP *bad_type _((I32 n, char *t, char *name, 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 OP *too_few_arguments _((OP *op, char* name));
+static OP *too_many_arguments _((OP *op, char* name));
 static void null _((OP* op));
+static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, I32 seq,
+       CV* startcv, I32 cx_ix));
+
+static char*
+CvNAME(cv)
+CV* cv;
+{
+    SV* tmpsv = sv_newmortal();
+    gv_efullname(tmpsv, CvGV(cv));
+    return SvPV(tmpsv,na);
+}
 
 static OP *
 no_fh_allowed(op)
@@ -38,32 +61,34 @@ OP *op;
 }
 
 static OP *
-too_few_arguments(op)
-OP *op;
+too_few_arguments(op, name)
+OP* op;
+char* name;
 {
-    sprintf(tokenbuf,"Not enough arguments for %s", op_name[op->op_type]);
+    sprintf(tokenbuf,"Not enough arguments for %s", name);
     yyerror(tokenbuf);
     return op;
 }
 
 static OP *
-too_many_arguments(op)
+too_many_arguments(op, name)
 OP *op;
+char* name;
 {
-    sprintf(tokenbuf,"Too many arguments for %s", op_name[op->op_type]);
+    sprintf(tokenbuf,"Too many arguments for %s", name);
     yyerror(tokenbuf);
     return op;
 }
 
 static OP *
-bad_type(n, t, op, kid)
+bad_type(n, t, name, kid)
 I32 n;
 char *t;
-OP *op;
+char *name;
 OP *kid;
 {
     sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)",
-       (int) n, op_name[op->op_type], t, op_name[kid->op_type]);
+       (int) n, name, t, op_name[kid->op_type]);
     yyerror(tokenbuf);
     return op;
 }
@@ -74,11 +99,11 @@ 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 ->",
+       sprintf(tokenbuf, "Can't use subscript on %s",
            op_name[type]);
        yyerror(tokenbuf);
        if (type == OP_RV2HV || type == OP_ENTERSUB)
-           warn("(Did you mean $ instead of %c?)\n",
+           warn("(Did you mean $ or @ instead of %c?)\n",
                type == OP_RV2HV ? '%' : '&');
     }
 }
@@ -102,7 +127,7 @@ char *name;
     sv_upgrade(sv, SVt_PVNV);
     sv_setpv(sv, name);
     av_store(comppad_name, off, sv);
-    SvNVX(sv) = (double)cop_seqmax;
+    SvNVX(sv) = (double)999999999;
     SvIVX(sv) = 0;                     /* Not yet introduced--see newSTATEOP */
     if (!min_intro_pending)
        min_intro_pending = off;
@@ -115,30 +140,57 @@ char *name;
     return off;
 }
 
-PADOFFSET
-pad_findmy(name)
+static PADOFFSET
+#ifndef CAN_PROTOTYPE
+pad_findlex(name, newoff, seq, startcv, cx_ix)
 char *name;
+PADOFFSET newoff;
+I32 seq;
+CV* startcv;
+I32 cx_ix;
+#else
+pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
+#endif
 {
+    CV *cv;
     I32 off;
     SV *sv;
-    SV **svp = AvARRAY(comppad_name);
     register I32 i;
     register CONTEXT *cx;
     int saweval;
-    AV *curlist;
-    AV *curname;
-    CV *cv;
-    I32 seq = cop_seqmax;
 
-    /* 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))
-       {
-           return (PADOFFSET)off;
+    for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
+       AV* curlist = CvPADLIST(cv);
+       SV** svp = av_fetch(curlist, 0, FALSE);
+       AV *curname;
+       if (!svp || *svp == &sv_undef)
+           continue;
+       curname = (AV*)*svp;
+       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))
+           {
+               I32 depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1;
+               AV *oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
+               SV *oldsv = *av_fetch(oldpad, off, TRUE);
+               if (!newoff) {          /* Not a mere clone operation. */
+                   SV *sv = NEWSV(1103,0);
+                   newoff = pad_alloc(OP_PADSV, SVs_PADMY);
+                   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 */
+                   SvFLAGS(sv) |= SVf_FAKE;
+               }
+               av_store(comppad, newoff, SvREFCNT_inc(oldsv));
+               SvFLAGS(compcv) |= SVpcv_CLONE;
+               return newoff;
+           }
        }
     }
 
@@ -148,73 +200,62 @@ char *name;
      */
 
     saweval = 0;
-    for (i = cxstack_ix; i >= 0; i--) {
+    for (i = cx_ix; i >= 0; i--) {
        cx = &cxstack[i];
        switch (cx->cx_type) {
        default:
+           if (i == 0 && saweval) {
+               seq = cxstack[saweval].blk_oldcop->cop_seq;
+               return pad_findlex(name, newoff, seq, main_cv, 0);
+           }
            break;
        case CXt_EVAL:
+           if (cx->blk_eval.old_op_type != OP_ENTEREVAL)
+               return 0;       /* require must have its own scope */
            saweval = i;
            break;
        case CXt_SUB:
            if (!saweval)
                return 0;
            cv = cx->blk_sub.cv;
-           if (debstash && CvSTASH(cv) == debstash)    /* ignore DB'* scope */
+           if (debstash && CvSTASH(cv) == debstash) {  /* ignore DB'* scope */
+               saweval = i;    /* so we know where we were called from */
                continue;
-           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))
-               {
-                   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(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;
+           seq = cxstack[saweval].blk_oldcop->cop_seq;
+           return pad_findlex(name, newoff, seq, cv, i-1);
        }
     }
 
-    if (!saweval)
-       return 0;
+    return 0;
+}
+
+PADOFFSET
+pad_findmy(name)
+char *name;
+{
+    I32 off;
+    SV *sv;
+    SV **svp = AvARRAY(comppad_name);
+    I32 seq = cop_seqmax;
 
-    /* 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--) {
+    /* The one we're looking for is probably just before comppad_name_fill. */
+    for (off = AvFILL(comppad_name); 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 (PADOFFSET)off;
        }
     }
+
+    /* See if it's in a nested scope */
+    off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix);
+    if (off)
+       return off;
+
     return 0;
 }
 
@@ -233,7 +274,7 @@ I32 fill;
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
     for (off = AvFILL(comppad_name); off > fill; off--) {
-       if ((sv = svp[off]) && sv != &sv_undef)
+       if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999)
            SvIVX(sv) = cop_seqmax;
     }
 }
@@ -331,11 +372,13 @@ pad_reset()
     if (AvARRAY(comppad) != curpad)
        croak("panic: pad_reset curpad");
     DEBUG_X(fprintf(stderr, "Pad reset\n"));
-    for (po = AvMAX(comppad); po > padix_floor; po--) {
-       if (curpad[po] && curpad[po] != &sv_undef)
-           SvPADTMP_off(curpad[po]);
+    if (!tainting) {   /* Can't mix tainted and non-tainted temporaries. */
+       for (po = AvMAX(comppad); po > padix_floor; po--) {
+           if (curpad[po] && curpad[po] != &sv_undef)
+               SvPADTMP_off(curpad[po]);
+       }
+       padix = padix_floor;
     }
-    padix = padix_floor;
     pad_reset_pending = FALSE;
 }
 
@@ -357,7 +400,6 @@ OP *op;
        }
     }
 
-
     switch (op->op_type) {
     case OP_NULL:
        op->op_targ = 0;        /* Was holding old type, if any. */
@@ -376,14 +418,23 @@ OP *op;
     case OP_CONST:
        SvREFCNT_dec(cSVOP->op_sv);
        break;
+    case OP_GOTO:
+    case OP_NEXT:
+    case OP_LAST:
+    case OP_REDO:
+       if (op->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
+           break;
+       /* FALL THROUGH */
     case OP_TRANS:
        Safefree(cPVOP->op_pv);
        break;
     case OP_SUBST:
        op_free(cPMOP->op_pmreplroot);
        /* FALL THROUGH */
+    case OP_PUSHRE:
     case OP_MATCH:
-       regfree(cPMOP->op_pmregexp);
+       pregfree(cPMOP->op_pmregexp);
+       SvREFCNT_dec(cPMOP->op_pmshort);
        break;
     default:
        break;
@@ -478,6 +529,8 @@ OP *op;
 
     switch (op->op_type) {
     case OP_REPEAT:
+       if (op->op_private & OPpREPEAT_DOLIST)
+           null(((LISTOP*)cBINOP->op_first)->op_first);
        scalar(cBINOP->op_first);
        break;
     case OP_OR:
@@ -501,9 +554,11 @@ OP *op;
                scalar(kid);
        }
        break;
-    case OP_SCOPE:
     case OP_LEAVE:
     case OP_LEAVETRY:
+       scalar(cLISTOP->op_first);
+       /* FALL THROUGH */
+    case OP_SCOPE:
     case OP_LINESEQ:
     case OP_LIST:
        for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
@@ -626,7 +681,7 @@ OP *op;
 
     case OP_NEXTSTATE:
     case OP_DBSTATE:
-       curcop = ((COP*)op);            /* for warning above */
+       curcop = ((COP*)op);            /* for warning below */
        break;
 
     case OP_CONST:
@@ -668,6 +723,8 @@ OP *op;
            scalarvoid(kid);
        break;
     case OP_NULL:
+       if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE)
+           curcop = ((COP*)op);                /* for warning below */
        if (op->op_flags & OPf_STACKED)
            break;
     case OP_ENTERTRY:
@@ -691,6 +748,9 @@ OP *op;
                deprecate("implicit split to @_");
        }
        break;
+    case OP_DELETE:
+       op->op_private |= OPpLEAVE_VOID;
+       break;
     }
     if (useless && dowarn)
        warn("Useless use of %s in void context", useless);
@@ -745,9 +805,11 @@ OP *op;
     case OP_LIST:
        listkids(op);
        break;
-    case OP_SCOPE:
     case OP_LEAVE:
     case OP_LEAVETRY:
+       list(cLISTOP->op_first);
+       /* FALL THROUGH */
+    case OP_SCOPE:
     case OP_LINESEQ:
        for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
            if (kid->op_sibling)
@@ -818,7 +880,7 @@ I32 type;
 
     switch (op->op_type) {
     case OP_CONST:
-       if (!(op->op_flags & (OPf_SPECIAL|OPf_MOD)))
+       if (!(op->op_private & (OPpCONST_ARYBASE)))
            goto nomod;
        if (eval_start && eval_start->op_type == OP_CONST) {
            compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv);
@@ -826,6 +888,7 @@ I32 type;
        }
        else if (!type) {
            SAVEI32(compiling.cop_arybase);
+           compiling.cop_arybase = 0;
        }
        else if (type == OP_REFGEN)
            goto nomod;
@@ -885,11 +948,14 @@ I32 type;
 
     case OP_RV2AV:
     case OP_RV2HV:
+       if (type == OP_REFGEN && op->op_flags & OPf_PARENS) {
+           modcount = 10000;
+           return op;          /* Treat \(@foo) like ordinary list. */
+       }
+       /* FALL THROUGH */
     case OP_RV2GV:
        ref(cUNOP->op_first, op->op_type);
        /* FALL THROUGH */
-    case OP_PADAV:
-    case OP_PADHV:
     case OP_AASSIGN:
     case OP_ASLICE:
     case OP_HSLICE:
@@ -900,9 +966,10 @@ I32 type;
        modcount = 10000;
        break;
     case OP_RV2SV:
+       if (!type && cUNOP->op_first->op_type != OP_GV)
+           croak("Can't localize a reference");
        ref(cUNOP->op_first, op->op_type); 
        /* FALL THROUGH */
-    case OP_PADSV:
     case OP_UNDEF:
     case OP_GV:
     case OP_AV2ARYLEN:
@@ -911,9 +978,19 @@ I32 type;
        modcount++;
        break;
 
-    case OP_PUSHMARK:
+    case OP_PADAV:
+    case OP_PADHV:
+       modcount = 10000;
+       /* FALL THROUGH */
+    case OP_PADSV:
+       modcount++;
+       if (!type)
+           croak("Can't localize lexical variable %s",
+               SvPV(*av_fetch(comppad_name, op->op_targ, 4), na));
        break;
 
+    case OP_PUSHMARK:
+       break;
        
     case OP_POS:
        mtype = '.';
@@ -931,7 +1008,7 @@ I32 type;
        sv_magic(sv, Nullsv, mtype, Nullch, 0);
        curpad[op->op_targ] = sv;
        if (op->op_flags & OPf_KIDS)
-           mod(cBINOP->op_first, type);
+           mod(cBINOP->op_first->op_sibling, type);
        break;
 
     case OP_AELEM:
@@ -1004,6 +1081,7 @@ I32 type;
            op->op_ppaddr = ppaddr[OP_RV2CV];
            assert(cUNOP->op_first->op_type == OP_NULL);
            null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */
+           op->op_flags |= OPf_SPECIAL;
        }
        break;
       
@@ -1013,6 +1091,8 @@ I32 type;
        break;
     case OP_RV2SV:
        ref(cUNOP->op_first, op->op_type);
+       /* FALL THROUGH */
+    case OP_PADSV:
        if (type == OP_RV2AV || type == OP_RV2HV) {
            op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
            op->op_flags |= OPf_MOD;
@@ -1142,7 +1222,7 @@ scope(o)
 OP *o;
 {
     if (o) {
-       if (o->op_flags & OPf_PARENS || perldb) {
+       if (o->op_flags & OPf_PARENS || perldb || tainting) {
            o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
            o->op_type = OP_LEAVE;
            o->op_ppaddr = ppaddr[OP_LEAVE];
@@ -1153,11 +1233,13 @@ OP *o;
                o->op_type = OP_SCOPE;
                o->op_ppaddr = ppaddr[OP_SCOPE];
                kid = ((LISTOP*)o)->op_first;
-               if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
+               if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
+                   SvREFCNT_dec(((COP*)kid)->cop_filegv);
                    null(kid);
+               }
            }
            else
-               o = newUNOP(OP_SCOPE, 0, o);
+               o = newLISTOP(OP_SCOPE, 0, o, Nullop);
        }
     }
     return o;
@@ -1218,6 +1300,8 @@ OP *op;
        main_start = LINKLIST(main_root);
        main_root->op_next = 0;
        peep(main_start);
+       main_cv = compcv;
+       compcv = 0;
     }
 }
 
@@ -1263,6 +1347,7 @@ register OP *o;
 {
     register OP *curop;
     I32 type = o->op_type;
+    SV *sv;
 
     if (opargs[type] & OA_RETSCALAR)
        scalar(o);
@@ -1292,17 +1377,26 @@ register OP *o;
     o->op_next = 0;
     op = curop;
     run();
-    if (o->op_targ && *stack_sp == PAD_SV(o->op_targ)) /* grab pad temp? */
+    sv = *(stack_sp--);
+    if (o->op_targ && sv == PAD_SV(o->op_targ))        /* grab pad temp? */
        pad_swipe(o->op_targ);
-    else if (SvTEMP(*stack_sp)) {                      /* grab mortal temp? */
-       (void)SvREFCNT_inc(*stack_sp);
-       SvTEMP_off(*stack_sp);
+    else if (SvTEMP(sv)) {                     /* grab mortal temp? */
+       (void)SvREFCNT_inc(sv);
+       SvTEMP_off(sv);
     }
     op_free(o);
     if (type == OP_RV2GV)
-       return newGVOP(OP_GV, 0, *(stack_sp--));
-    else
-       return newSVOP(OP_CONST, 0, *(stack_sp--));
+       return newGVOP(OP_GV, 0, sv);
+    else {
+       if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
+           IV iv = SvIV(sv);
+           if ((double)iv == SvNV(sv)) {       /* can we smush double to int */
+               SvREFCNT_dec(sv);
+               sv = newSViv(iv);
+           }
+       }
+       return newSVOP(OP_CONST, 0, sv);
+    }
     
   nope:
     if (!(opargs[type] & OA_OTHERINT))
@@ -1367,6 +1461,8 @@ OP* op;
 
     if (!op || op->op_type != OP_LIST)
        op = newLISTOP(OP_LIST, 0, op, Nullop);
+    else
+       op->op_flags &= ~(OPf_KNOW|OPf_LIST);
 
     if (!(opargs[type] & OA_MARK))
        null(cLISTOP->op_first);
@@ -1375,7 +1471,7 @@ OP* op;
     op->op_ppaddr = ppaddr[type];
     op->op_flags |= flags;
 
-    op = (*check[type])(op);
+    op = CHECKOP(type, op);
     if (op->op_type != type)
        return op;
 
@@ -1551,7 +1647,7 @@ I32 flags;
        scalar(op);
     if (opargs[type] & OA_TARGET)
        op->op_targ = pad_alloc(type, SVs_PADTMP);
-    return (*check[type])(op);
+    return CHECKOP(type, op);
 }
 
 OP *
@@ -1574,7 +1670,7 @@ OP* first;
     unop->op_flags = flags | OPf_KIDS;
     unop->op_private = 1;
 
-    unop = (UNOP*)(*check[type])((OP*)unop);
+    unop = (UNOP*) CHECKOP(type, unop);
     if (unop->op_next)
        return (OP*)unop;
 
@@ -1607,7 +1703,7 @@ OP* last;
        first->op_sibling = last;
     }
 
-    binop = (BINOP*)(*check[type])((OP*)binop);
+    binop = (BINOP*)CHECKOP(type, binop);
     if (binop->op_next)
        return (OP*)binop;
 
@@ -1630,7 +1726,6 @@ OP *repl;
     register char *r = SvPV(rstr, rlen);
     register I32 i;
     register I32 j;
-    I32 squash;
     I32 delete;
     I32 complement;
     register short *tbl;
@@ -1638,7 +1733,7 @@ OP *repl;
     tbl = (short*)cPVOP->op_pv;
     complement = op->op_private & OPpTRANS_COMPLEMENT;
     delete     = op->op_private & OPpTRANS_DELETE;
-    squash     = op->op_private & OPpTRANS_SQUASH;
+    /* squash  = op->op_private & OPpTRANS_SQUASH; */
 
     if (complement) {
        Zero(tbl, 256, short);
@@ -1729,12 +1824,7 @@ 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);
-#endif
-       pm->op_pmregexp = regcomp(p, p + plen, pm);
+       pm->op_pmregexp = pregcomp(p, p + plen, pm);
        if (strEQ("\\s+", pm->op_pmregexp->precomp)) 
            pm->op_pmflags |= PMf_WHITE;
        hoistmust(pm);
@@ -1767,12 +1857,12 @@ OP *repl;
     }
 
     if (repl) {
-       if (repl->op_type == OP_CONST) {
-           pm->op_pmflags |= PMf_CONST;
-           prepend_elem(op->op_type, scalar(repl), op);
-       }
+       OP *curop;
+       if (pm->op_pmflags & PMf_EVAL)
+           curop = 0;
+       else if (repl->op_type == OP_CONST)
+           curop = repl;
        else {
-           OP *curop;
            OP *lastop = 0;
            for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
                if (opargs[curop->op_type] & OA_DANGEROUS) {
@@ -1790,32 +1880,39 @@ OP *repl;
                        if (lastop && lastop->op_type != OP_GV) /*funny deref?*/
                            break;
                    }
+                   else if (curop->op_type == OP_PADSV ||
+                            curop->op_type == OP_PADAV ||
+                            curop->op_type == OP_PADHV ||
+                            curop->op_type == OP_PADANY) {
+                            /* is okay */
+                   }
                    else
                        break;
                }
                lastop = curop;
            }
-           if (curop == repl) {
-               pm->op_pmflags |= PMf_CONST;    /* const for long enough */
-               prepend_elem(op->op_type, scalar(repl), op);
-           }
-           else {
-               Newz(1101, rcop, 1, LOGOP);
-               rcop->op_type = OP_SUBSTCONT;
-               rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
-               rcop->op_first = scalar(repl);
-               rcop->op_flags |= OPf_KIDS;
-               rcop->op_private = 1;
-               rcop->op_other = op;
-
-               /* establish postfix order */
-               rcop->op_next = LINKLIST(repl);
-               repl->op_next = (OP*)rcop;
-
-               pm->op_pmreplroot = scalar((OP*)rcop);
-               pm->op_pmreplstart = LINKLIST(rcop);
-               rcop->op_next = 0;
-           }
+       }
+       if (curop == repl) {
+           pm->op_pmflags |= PMf_CONST;        /* const for long enough */
+           pm->op_pmpermflags |= PMf_CONST;    /* const for long enough */
+           prepend_elem(op->op_type, scalar(repl), op);
+       }
+       else {
+           Newz(1101, rcop, 1, LOGOP);
+           rcop->op_type = OP_SUBSTCONT;
+           rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
+           rcop->op_first = scalar(repl);
+           rcop->op_flags |= OPf_KIDS;
+           rcop->op_private = 1;
+           rcop->op_other = op;
+
+           /* establish postfix order */
+           rcop->op_next = LINKLIST(repl);
+           repl->op_next = (OP*)rcop;
+
+           pm->op_pmreplroot = scalar((OP*)rcop);
+           pm->op_pmreplstart = LINKLIST(rcop);
+           rcop->op_next = 0;
        }
     }
 
@@ -1839,7 +1936,7 @@ SV *sv;
        scalar((OP*)svop);
     if (opargs[type] & OA_TARGET)
        svop->op_targ = pad_alloc(type, SVs_PADTMP);
-    return (*check[type])((OP*)svop);
+    return CHECKOP(type, svop);
 }
 
 OP *
@@ -1859,7 +1956,7 @@ GV *gv;
        scalar((OP*)gvop);
     if (opargs[type] & OA_TARGET)
        gvop->op_targ = pad_alloc(type, SVs_PADTMP);
-    return (*check[type])((OP*)gvop);
+    return CHECKOP(type, gvop);
 }
 
 OP *
@@ -1879,7 +1976,7 @@ char *pv;
        scalar((OP*)pvop);
     if (opargs[type] & OA_TARGET)
        pvop->op_targ = pad_alloc(type, SVs_PADTMP);
-    return (*check[type])((OP*)pvop);
+    return CHECKOP(type, pvop);
 }
 
 OP *
@@ -1901,7 +1998,7 @@ OP *cont;
        scalar((OP*)cvop);
     if (opargs[type] & OA_TARGET)
        cvop->op_targ = pad_alloc(type, SVs_PADTMP);
-    return (*check[type])((OP*)cvop);
+    return CHECKOP(type, cvop);
 }
 
 void
@@ -1943,27 +2040,31 @@ OP *arg;
     if (id->op_type != OP_CONST)
        croak("Module name must be constant");
 
-    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,
+    if (arg && arg->op_type == OP_STUB)
+       imop = arg;             /* no import on explicit () */
+    else {
+       /* Make copy of id so we don't free it twice */
+       pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
+
+       meth = newSVOP(OP_CONST, 0,
+           aver
+               ? newSVpv("import", 6)
+               : newSVpv("unimport", 8)
+           );
+       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 a require */
+    rqop = newUNOP(OP_REQUIRE, 0, id);
 
     /* Fake up the BEGIN {}, which does its thing immediately. */
     newSUB(start_subparse(),
        newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
+       Nullop,
        append_elem(OP_LINESEQ,
            newSTATEOP(0, Nullch, rqop),
            newSTATEOP(0, Nullch, imop) ));
@@ -2041,9 +2142,11 @@ OP *right;
 
     if (list_assignment(left)) {
        modcount = 0;
-       eval_start = right;     /* Grandfathering $[ assignment here.  Bletch. */
+       eval_start = right;     /* Grandfathering $[ assignment here.  Bletch.*/
        left = mod(left, OP_AASSIGN);
-       if (!eval_start) {
+       if (eval_start)
+           eval_start = 0;
+       else {
            op_free(left);
            op_free(right);
            return Nullop;
@@ -2076,7 +2179,7 @@ OP *right;
                list(force_list(left)) );
        op->op_private = 0;
        if (!(left->op_private & OPpLVAL_INTRO)) {
-           static int generation = 0;
+           static int generation = 100;
            OP *curop;
            OP *lastop = op;
            generation++;
@@ -2088,6 +2191,16 @@ OP *right;
                            break;
                        SvCUR(gv) = generation;
                    }
+                   else if (curop->op_type == OP_PADSV ||
+                            curop->op_type == OP_PADAV ||
+                            curop->op_type == OP_PADHV ||
+                            curop->op_type == OP_PADANY) {
+                       SV **svp = AvARRAY(comppad_name);
+                       SV *sv = svp[curop->op_targ];
+                       if (SvCUR(sv) == generation)
+                           break;
+                       SvCUR(sv) = generation; /* (SvCUR not used any more) */
+                   }
                    else if (curop->op_type == OP_RV2CV)
                        break;
                    else if (curop->op_type == OP_RV2SV ||
@@ -2114,10 +2227,12 @@ OP *right;
        return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
     }
     else {
-       eval_start = right;     /* Grandfathering $[ assignment here.  Bletch. */
+       eval_start = right;     /* Grandfathering $[ assignment here.  Bletch.*/
        op = newBINOP(OP_SASSIGN, flags,
            scalar(right), mod(scalar(left), OP_SASSIGN) );
-       if (!eval_start) {
+       if (eval_start)
+           eval_start = 0;
+       else {
            op_free(op);
            return Nullop;
        }
@@ -2139,8 +2254,10 @@ OP *op;
        I32 i;
        SV *sv;
        for (i = min_intro_pending; i <= max_intro_pending; i++) {
-           if ((sv = svp[i]) && sv != &sv_undef)
+           if ((sv = svp[i]) && sv != &sv_undef && !SvIVX(sv)) {
                SvIVX(sv) = 999999999;  /* Don't know scope end yet. */
+               SvNVX(sv) = (double)cop_seqmax;
+           }
        }
        min_intro_pending = 0;
        comppad_name_fill = max_intro_pending;  /* Needn't search higher */
@@ -2391,9 +2508,12 @@ OP *block;
     if (once && op != listop)
        op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
 
+    if (op == listop)
+       op = newUNOP(OP_NULL, 0, op);   /* or do {} while 1 loses outer block */
+
     op->op_flags |= flags;
     op = scope(op);
-    op->op_flags |= OPf_SPECIAL;       /* suppress POPBLOCK curpm restoration */
+    op->op_flags |= OPf_SPECIAL;       /* suppress POPBLOCK curpm restoration*/
     return op;
 }
 
@@ -2412,8 +2532,10 @@ OP *cont;
     OP *op;
     OP *condop;
 
-    if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB))
-       expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
+    if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
+       expr = newUNOP(OP_DEFINED, 0,
+           newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
+    }
 
     if (!block)
        block = newOP(OP_NULL, 0);
@@ -2479,15 +2601,13 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
 {
     LOOP *loop;
     int padoff = 0;
+    I32 iterflags = 0;
 
     copline = forline;
     if (sv) {
        if (sv->op_type == OP_RV2SV) {  /* symbol table variable */
-           OP *op = sv;
-           sv = cUNOP->op_first;
-           sv->op_next = sv;
-           cUNOP->op_first = Nullop;
-           op_free(op);
+           sv->op_type = OP_RV2GV;
+           sv->op_ppaddr = ppaddr[OP_RV2GV];
        }
        else if (sv->op_type == OP_PADSV) { /* private variable */
            padoff = sv->op_targ;
@@ -2500,7 +2620,11 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
     else {
        sv = newGVOP(OP_GV, 0, defgv);
     }
-    loop = (LOOP*)list(convert(OP_ENTERITER, 0,
+    if (expr->op_type == OP_RV2AV) {
+       expr = scalar(ref(expr, OP_ITER));
+       iterflags |= OPf_STACKED;
+    }
+    loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
        append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
                    scalar(sv))));
     assert(!loop->op_next);
@@ -2544,26 +2668,108 @@ CV *cv;
        SAVESPTR(curpad);
        curpad = 0;
 
-       op_free(CvROOT(cv));
+       if (!(SvFLAGS(cv) & SVpcv_CLONED))
+           op_free(CvROOT(cv));
        CvROOT(cv) = Nullop;
-       if (CvPADLIST(cv)) {
-           I32 i = AvFILL(CvPADLIST(cv));
-           while (i >= 0) {
-               SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
-               if (svp)
-                   SvREFCNT_dec(*svp);
+       LEAVE;
+    }
+    SvREFCNT_dec(CvGV(cv));
+    CvGV(cv) = Nullgv;
+    SvREFCNT_dec(CvOUTSIDE(cv));
+    CvOUTSIDE(cv) = Nullcv;
+    if (CvPADLIST(cv)) {
+       I32 i = AvFILL(CvPADLIST(cv));
+       while (i >= 0) {
+           SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
+           if (svp)
+               SvREFCNT_dec(*svp);
+       }
+       SvREFCNT_dec((SV*)CvPADLIST(cv));
+       CvPADLIST(cv) = Nullav;
+    }
+}
+
+CV *
+cv_clone(proto)
+CV* proto;
+{
+    AV* av;
+    I32 ix;
+    AV* protopadlist = CvPADLIST(proto);
+    AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
+    AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
+    SV** svp = AvARRAY(protopad);
+    AV* comppadlist;
+    CV* cv;
+
+    ENTER;
+    SAVESPTR(curpad);
+    SAVESPTR(comppad);
+    SAVESPTR(compcv);
+
+    cv = compcv = (CV*)NEWSV(1104,0);
+    sv_upgrade((SV *)cv, SVt_PVCV);
+    SvFLAGS(cv) |= SVpcv_CLONED;
+
+    CvFILEGV(cv)       = CvFILEGV(proto);
+    CvGV(cv)           = SvREFCNT_inc(CvGV(proto));
+    CvSTASH(cv)                = CvSTASH(proto);
+    CvROOT(cv)         = CvROOT(proto);
+    CvSTART(cv)                = CvSTART(proto);
+    if (CvOUTSIDE(proto))
+       CvOUTSIDE(cv)   = (CV*)SvREFCNT_inc((SV*)CvOUTSIDE(proto));
+
+    comppad = newAV();
+
+    comppadlist = newAV();
+    AvREAL_off(comppadlist);
+    av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
+    av_store(comppadlist, 1, (SV*)comppad);
+    CvPADLIST(cv) = comppadlist;
+    av_extend(comppad, AvFILL(protopad));
+    curpad = AvARRAY(comppad);
+
+    av = newAV();           /* will be @_ */
+    av_extend(av, 0);
+    av_store(comppad, 0, (SV*)av);
+    AvFLAGS(av) = AVf_REIFY;
+
+    svp = AvARRAY(protopad_name);
+    for ( ix = AvFILL(protopad); ix > 0; ix--) {
+       SV *sv;
+       if (svp[ix] != &sv_undef) {
+           char *name = SvPVX(svp[ix]);    /* XXX */
+           if (SvFLAGS(svp[ix]) & SVf_FAKE) {  /* lexical from outside? */
+               I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto),
+                                       cxstack_ix);
+               if (off != ix)
+                   croak("panic: cv_clone: %s", name);
+           }
+           else {                              /* our own lexical */
+               if (*name == '@')
+                   av_store(comppad, ix, sv = (SV*)newAV());
+               else if (*name == '%')
+                   av_store(comppad, ix, sv = (SV*)newHV());
+               else
+                   av_store(comppad, ix, sv = NEWSV(0,0));
+               SvPADMY_on(sv);
            }
-           SvREFCNT_dec((SV*)CvPADLIST(cv));
        }
-       SvREFCNT_dec(CvGV(cv));
-       LEAVE;
+       else {
+           av_store(comppad, ix, sv = NEWSV(0,0));
+           SvPADTMP_on(sv);
+       }
     }
+
+    LEAVE;
+    return cv;
 }
 
 CV *
-newSUB(floor,op,block)
+newSUB(floor,op,proto,block)
 I32 floor;
 OP *op;
+OP *proto;
 OP *block;
 {
     register CV *cv;
@@ -2578,8 +2784,8 @@ OP *block;
     if (cv = GvCV(gv)) {
        if (GvCVGEN(gv))
            cv = 0;                     /* just a cached method */
-       else if (CvROOT(cv)) {          /* already defined? */
-           if (dowarn) {
+       else if (CvROOT(cv) || CvXSUB(cv) || GvFLAGS(gv) & GVf_IMPORTED) {
+           if (dowarn) {               /* already defined (or promised)? */
                line_t oldline = curcop->cop_line;
 
                curcop->cop_line = copline;
@@ -2591,12 +2797,17 @@ OP *block;
        }
     }
     if (cv) {                          /* must reuse cv if autoloaded */
-       assert(SvREFCNT(CvGV(cv)) > 1);
-       SvREFCNT_dec(CvGV(cv));
+       cv_undef(cv);
+       CvOUTSIDE(cv) = CvOUTSIDE(compcv);
+       CvOUTSIDE(compcv) = 0;
+       CvPADLIST(cv) = CvPADLIST(compcv);
+       CvPADLIST(compcv) = 0;
+       if (SvREFCNT(compcv) > 1) /* XXX Make closures transit through stub. */
+           CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)cv);
+       SvREFCNT_dec(compcv);
     }
     else {
-       cv = (CV*)NEWSV(1104,0);
-       sv_upgrade((SV *)cv, SVt_PVCV);
+       cv = compcv;
     }
     GvCV(gv) = cv;
     GvCVGEN(gv) = 0;
@@ -2604,6 +2815,13 @@ OP *block;
     CvGV(cv) = SvREFCNT_inc(gv);
     CvSTASH(cv) = curstash;
 
+    if (proto) {
+       char *p = SvPVx(((SVOP*)proto)->op_sv, na);
+       if (SvPOK(cv) && strNE(SvPV((SV*)cv,na), p))
+           warn("Prototype mismatch: (%s) vs (%s)", SvPV((SV*)cv, na), p);
+       sv_setpv((SV*)cv, p);
+    }
+
     if (!block) {
        CvROOT(cv) = 0;
        op_free(op);
@@ -2622,14 +2840,8 @@ OP *block;
            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, SvREFCNT_inc((SV*)comppad_name));
-    av_store(av, 1, SvREFCNT_inc((SV*)comppad));
-    AvFILL(av) = 1;
-    CvPADLIST(cv) = av;
 
     CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
     CvSTART(cv) = LINKLIST(CvROOT(cv));
@@ -2639,7 +2851,7 @@ OP *block;
        s++;
     else
        s = name;
-    if (strEQ(s, "BEGIN")) {
+    if (strEQ(s, "BEGIN") && !error_count) {
        line_t oldline = compiling.cop_line;
 
        ENTER;
@@ -2663,7 +2875,7 @@ OP *block;
        curcop->cop_line = oldline;     /* might have recursed to yylex */
        LEAVE;
     }
-    else if (strEQ(s, "END")) {
+    else if (strEQ(s, "END") && !error_count) {
        if (!endav)
            endav = newAV();
        av_unshift(endav, 1);
@@ -2684,8 +2896,10 @@ OP *block;
     op_free(op);
     copline = NOLINE;
     LEAVE_SCOPE(floor);
-    if (!op)
+    if (!op) {
        GvCV(gv) = 0;   /* Will remember in SVOP instead. */
+       SvFLAGS(cv) |= SVpcv_ANON;
+    }
     return cv;
 }
 
@@ -2719,7 +2933,7 @@ char *filename;
     if (cv = GvCV(gv)) {
        if (GvCVGEN(gv))
            cv = 0;                     /* just a cached method */
-       else if (CvROOT(cv)) {          /* already defined? */
+       else if (CvROOT(cv) || CvXSUB(cv)) {    /* already defined? */
            if (dowarn) {
                line_t oldline = curcop->cop_line;
 
@@ -2761,8 +2975,10 @@ char *filename;
        av_unshift(endav, 1);
        av_store(endav, 0, SvREFCNT_inc(gv));
     }
-    if (!name)
+    if (!name) {
        GvCV(gv) = 0;   /* Will remember elsewhere instead. */
+       SvFLAGS(cv) |= SVpcv_ANON;
+    }
     return cv;
 }
 
@@ -2775,7 +2991,6 @@ OP *block;
     register CV *cv;
     char *name;
     GV *gv;
-    AV* av;
     I32 ix;
 
     if (op)
@@ -2794,8 +3009,7 @@ OP *block;
        }
        SvREFCNT_dec(cv);
     }
-    cv = (CV*)NEWSV(1106,0);
-    sv_upgrade((SV *)cv, SVt_PVFM);
+    cv = compcv;
     GvFORM(gv) = cv;
     CvGV(cv) = SvREFCNT_inc(gv);
     CvFILEGV(cv) = curcop->cop_filegv;
@@ -2805,11 +3019,6 @@ OP *block;
            SvPADTMP_on(curpad[ix]);
     }
 
-    CvPADLIST(cv) = av = newAV();
-    AvREAL_off(av);
-    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;
@@ -2856,12 +3065,13 @@ OP* op;
 }
 
 OP *
-newANONSUB(floor, block)
+newANONSUB(floor, proto, block)
 I32 floor;
+OP *proto;
 OP *block;
 {
     return newUNOP(OP_REFGEN, 0,
-       newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, block)));
+       newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
 }
 
 OP *
@@ -2931,7 +3141,7 @@ OP *o;
 {
     if (type == OP_MAPSTART)
        return newUNOP(OP_NULL, 0, o);
-    return newUNOP(OP_RV2GV, 0, o);
+    return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
 }
 
 OP *
@@ -3114,15 +3324,23 @@ ck_rvconst(op)
 register OP *op;
 {
     SVOP *kid = (SVOP*)cUNOP->op_first;
-    int iscv = (op->op_type==OP_RV2CV)*2;
 
     op->op_private = (hints & HINT_STRICT_REFS);
     if (kid->op_type == OP_CONST) {
+       int iscv = (op->op_type==OP_RV2CV)*2;
        GV *gv = 0;
        kid->op_type = OP_GV;
        for (gv = 0; !gv; iscv++) {
+           /*
+            * 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.
+            */
            gv = gv_fetchpv(SvPVx(kid->op_sv, na),
-               iscv,
+               iscv | !(kid->op_private & OPpCONST_ENTERED),
                iscv
                    ? SVt_PVCV
                    : op->op_type == OP_RV2SV
@@ -3236,7 +3454,7 @@ OP *op;
                    *tokid = kid;
                }
                else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
-                   bad_type(numargs, "array", op, kid);
+                   bad_type(numargs, "array", op_name[op->op_type], kid);
                mod(kid, type);
                break;
            case OA_HVREF:
@@ -3254,7 +3472,7 @@ OP *op;
                    *tokid = kid;
                }
                else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
-                   bad_type(numargs, "hash", op, kid);
+                   bad_type(numargs, "hash", op_name[op->op_type], kid);
                mod(kid, type);
                break;
            case OA_CVREF:
@@ -3297,7 +3515,7 @@ OP *op;
        }
        op->op_private = numargs;
        if (kid)
-           return too_many_arguments(op);
+           return too_many_arguments(op,op_name[op->op_type]);
        listkids(op);
     }
     else if (opargs[type] & OA_DEFGV) {
@@ -3309,7 +3527,7 @@ OP *op;
        while (oa & OA_OPTIONAL)
            oa >>= 4;
        if (oa && oa != OA_LIST)
-           return too_few_arguments(op);
+           return too_few_arguments(op,op_name[op->op_type]);
     }
     return op;
 }
@@ -3339,6 +3557,7 @@ OP *op;
     if (op->op_flags & OPf_STACKED) {
        OP* k;
        op = ck_sort(op);
+        kid = cLISTOP->op_first->op_sibling;
        for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
            kid = k;
        }
@@ -3369,7 +3588,7 @@ OP *op;
 
     kid = cLISTOP->op_first->op_sibling;
     if (!kid || !kid->op_sibling)
-       return too_few_arguments(op);
+       return too_few_arguments(op,op_name[op->op_type]);
     for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
        mod(kid, OP_GREPSTART);
 
@@ -3428,7 +3647,7 @@ OP *op;
     else if (kid && !kid->op_sibling) {                /* print HANDLE; */
        if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
            op->op_flags |= OPf_STACKED;        /* make it a filehandle */
-           kid = newUNOP(OP_RV2GV, 0, scalar(kid));
+           kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
            cLISTOP->op_first->op_sibling = kid;
            cLISTOP->op_last = kid;
            kid = kid->op_sibling;
@@ -3446,6 +3665,7 @@ ck_match(op)
 OP *op;
 {
     cPMOP->op_pmflags |= PMf_RUNTIME;
+    cPMOP->op_pmpermflags |= PMf_RUNTIME;
     return op;
 }
 
@@ -3548,13 +3768,17 @@ OP *op;
                kid->op_next = 0;
            }
            else if (kid->op_type == OP_LEAVE) {
-               null(kid);                      /* wipe out leave */
-               kid->op_next = kid;
+               if (op->op_type == OP_SORT) {
+                   null(kid);                  /* wipe out leave */
+                   kid->op_next = kid;
 
-               for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
-                   if (k->op_next == kid)
-                       k->op_next = 0;
+                   for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
+                       if (k->op_next == kid)
+                           k->op_next = 0;
+                   }
                }
+               else
+                   kid->op_next = 0;           /* just disconnect the leave */
                k = kLISTOP->op_first;
            }
            peep(k);
@@ -3624,7 +3848,7 @@ OP *op;
     scalar(kid);
 
     if (kid->op_sibling)
-       return too_many_arguments(op);
+       return too_many_arguments(op,op_name[op->op_type]);
 
     return op;
 }
@@ -3633,16 +3857,116 @@ OP *
 ck_subr(op)
 OP *op;
 {
-    OP *o = ((cUNOP->op_first->op_sibling)
-            ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first->op_sibling;
-
-    if (o->op_type == OP_RV2CV)
-       null(o);                /* disable rv2cv */
+    OP *prev = ((cUNOP->op_first->op_sibling)
+            ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first;
+    OP *o = prev->op_sibling;
+    OP *cvop;
+    char *proto = 0;
+    CV *cv = 0;
+    int optional = 0;
+    I32 arg = 0;
+
+    for (cvop = o; cvop->op_sibling; cvop = cvop->op_sibling) ;
+    if (cvop->op_type == OP_RV2CV) {
+       SVOP* tmpop;
+       null(cvop);             /* disable rv2cv */
+       tmpop = (SVOP*)((UNOP*)cvop)->op_first;
+       if (tmpop->op_type == OP_GV) {
+           cv = GvCV(tmpop->op_sv);
+           if (cv && SvPOK(cv) && (op->op_flags & OPf_STACKED))
+               proto = SvPV((SV*)cv,na);
+       }
+    }
     op->op_private = (hints & HINT_STRICT_REFS);
     if (perldb && curstash != debstash)
        op->op_private |= OPpDEREF_DB;
-    while (o = o->op_sibling)
+    while (o != cvop) {
+       if (proto) {
+           switch (*proto) {
+           case '\0':
+               return too_many_arguments(op, CvNAME(cv));
+           case ';':
+               optional = 1;
+               proto++;
+               continue;
+           case '$':
+               proto++;
+               arg++;
+               scalar(o);
+               break;
+           case '%':
+           case '@':
+               list(o);
+               arg++;
+               break;
+           case '&':
+               proto++;
+               arg++;
+               if (o->op_type != OP_REFGEN && o->op_type != OP_UNDEF)
+                   bad_type(arg, "block", CvNAME(cv), o);
+               break;
+           case '*':
+               proto++;
+               arg++;
+               if (o->op_type == OP_RV2GV)
+                   goto wrapref;
+               {
+                   OP* kid = o;
+                   o = newUNOP(OP_RV2GV, 0, kid);
+                   o->op_sibling = kid->op_sibling;
+                   kid->op_sibling = 0;
+                   prev->op_sibling = o;
+               }
+               goto wrapref;
+           case '\\':
+               proto++;
+               arg++;
+               switch (*proto++) {
+               case '*':
+                   if (o->op_type != OP_RV2GV)
+                       bad_type(arg, "symbol", CvNAME(cv), o);
+                   goto wrapref;
+               case '&':
+                   if (o->op_type != OP_RV2CV)
+                       bad_type(arg, "sub", CvNAME(cv), o);
+                   goto wrapref;
+               case '$':
+                   if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV)
+                       bad_type(arg, "scalar", CvNAME(cv), o);
+                   goto wrapref;
+               case '@':
+                   if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV)
+                       bad_type(arg, "array", CvNAME(cv), o);
+                   goto wrapref;
+               case '%':
+                   if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV)
+                       bad_type(arg, "hash", CvNAME(cv), o);
+                 wrapref:
+                   {
+                       OP* kid = o;
+                       o = newUNOP(OP_REFGEN, 0, kid);
+                       o->op_sibling = kid->op_sibling;
+                       kid->op_sibling = 0;
+                       prev->op_sibling = o;
+                   }
+                   break;
+               default: goto oops;
+               }
+               break;
+           default:
+             oops:
+               croak("Malformed prototype for %s: %s",
+                       CvNAME(cv),SvPV((SV*)cv,na));
+           }
+       }
+       else
+           list(o);
        mod(o, OP_ENTERSUB);
+       prev = o;
+       o = o->op_sibling;
+    }
+    if (proto && !optional && *proto == '$')
+       return too_few_arguments(op, CvNAME(cv));
     return op;
 }
 
@@ -3690,6 +4014,7 @@ register OP* o;
        case OP_NEXTSTATE:
        case OP_DBSTATE:
            curcop = ((COP*)o);         /* for warnings */
+           o->op_seq = ++op_seqmax;
            break;
 
        case OP_CONCAT:
@@ -3709,11 +4034,15 @@ register OP* o;
                o->op_seq = ++op_seqmax;
                break;  /* Scalar stub must produce undef.  List stub is noop */
            }
-           /* FALL THROUGH */
+           goto nothin;
        case OP_NULL:
+           if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
+               curcop = ((COP*)op);
+           goto nothin;
        case OP_SCALAR:
        case OP_LINESEQ:
        case OP_SCOPE:
+         nothin:
            if (oldop && o->op_next) {
                oldop->op_next = o->op_next;
                continue;
@@ -3743,6 +4072,7 @@ register OP* o;
                                <= 255 &&
                    i >= 0)
                {
+                   SvREFCNT_dec(((SVOP*)pop)->op_sv);
                    null(o->op_next);
                    null(pop->op_next);
                    null(pop);