In debugger, don't reference %{$f{$g}} if $f{$g} doesn't exist
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index d008533..3b05012 100644 (file)
--- a/op.c
+++ b/op.c
@@ -1,6 +1,6 @@
 /*    op.c
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, 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.
  * think the expression is of the right type: croak actually does a Siglongjmp.
  */
 #define CHECKOP(type,op) \
-    ((op_mask && op_mask[type]) \
-     ? (croak("%s trapped by operation mask", op_desc[type]), (OP*)op) \
+    ((op_mask && op_mask[type])                                        \
+     ? ( op_free((OP*)op),                                     \
+        croak("%s trapped by operation mask", op_desc[type]),  \
+        Nullop )                                               \
      : (*check[type])((OP*)op))
 #else
 #define CHECKOP(type,op) (*check[type])(op)
@@ -41,7 +43,7 @@ static OP *scalarboolean _((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,
+static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
        CV* startcv, I32 cx_ix));
 
 static char*
@@ -49,7 +51,7 @@ CvNAME(cv)
 CV* cv;
 {
     SV* tmpsv = sv_newmortal();
-    gv_efullname(tmpsv, CvGV(cv));
+    gv_efullname3(tmpsv, CvGV(cv), Nullch);
     return SvPV(tmpsv,na);
 }
 
@@ -104,9 +106,9 @@ OP *op;
     if (type != OP_AELEM && type != OP_HELEM) {
        sprintf(tokenbuf, "Can't use subscript on %s", op_desc[type]);
        yyerror(tokenbuf);
-       if (type == OP_RV2HV || type == OP_ENTERSUB)
+       if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV)
            warn("(Did you mean $ or @ instead of %c?)\n",
-               type == OP_RV2HV ? '%' : '&');
+                type == OP_ENTERSUB ? '&' : '%');
     }
 }
 
@@ -120,8 +122,8 @@ char *name;
     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 */
+       if (!isPRINT(name[1]))
+           sprintf(name+1, "^%c", toCTRL(name[1])); /* XXX tokenbuf, really */
        croak("Can't use global %s in \"my\"",name);
     }
     if (AvFILL(comppad_name) >= 0) {
@@ -160,11 +162,11 @@ static PADOFFSET
 pad_findlex(name, newoff, seq, startcv, cx_ix)
 char *name;
 PADOFFSET newoff;
-I32 seq;
+U32 seq;
 CV* startcv;
 I32 cx_ix;
 #else
-pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
+pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
 #endif
 {
     CV *cv;
@@ -175,9 +177,10 @@ pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
     int saweval;
 
     for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
-       AV* curlist = CvPADLIST(cv);
-       SV** svp = av_fetch(curlist, 0, FALSE);
+       AV *curlist = CvPADLIST(cv);
+       SV **svp = av_fetch(curlist, 0, FALSE);
        AV *curname;
+
        if (!svp || *svp == &sv_undef)
            continue;
        curname = (AV*)*svp;
@@ -186,24 +189,59 @@ pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
            if ((sv = svp[off]) &&
                sv != &sv_undef &&
                seq <= SvIVX(sv) &&
-               seq > (I32)SvNVX(sv) &&
+               seq > I_32(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);
+               I32 depth;
+               AV *oldpad;
+               SV *oldsv;
+
+               depth = CvDEPTH(cv);
+               if (!depth) {
+                   if (newoff) {
+                       if (SvFAKE(sv))
+                           continue;
+                       return 0; /* don't clone from inactive stack frame */
+                   }
+                   depth = 1;
+               }
+               oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
+               oldsv = *av_fetch(oldpad, off, TRUE);
                if (!newoff) {          /* Not a mere clone operation. */
-                   SV *sv = NEWSV(1103,0);
+                   SV *namesv = 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;
+                   sv_upgrade(namesv, SVt_PVNV);
+                   sv_setpv(namesv, name);
+                   av_store(comppad_name, newoff, namesv);
+                   SvNVX(namesv) = (double)curcop->cop_seq;
+                   SvIVX(namesv) = 999999999;  /* A ref, intro immediately */
+                   SvFAKE_on(namesv);          /* A ref, not a real var */
+                   if (CvANON(compcv) || SvTYPE(compcv) == SVt_PVFM) {
+                       /* "It's closures all the way down." */
+                       CvCLONE_on(compcv);
+                       if (cv != startcv) {
+                           CV *bcv;
+                           for (bcv = startcv;
+                                bcv && bcv != cv && !CvCLONE(bcv);
+                                bcv = CvOUTSIDE(bcv)) {
+                               if (CvANON(bcv))
+                                   CvCLONE_on(bcv);
+                               else {
+                                   if (dowarn && !CvUNIQUE(cv))
+                                       warn(
+                                         "Variable \"%s\" may be unavailable",
+                                            name);
+                                   break;
+                               }
+                           }
+                       }
+                   }
+                   else if (!CvUNIQUE(compcv)) {
+                       if (dowarn && !SvFAKE(sv) && !CvUNIQUE(cv))
+                           warn("Variable \"%s\" will not stay shared", name);
+                   }
                }
                av_store(comppad, newoff, SvREFCNT_inc(oldsv));
-               CvCLONE_on(compcv);
                return newoff;
            }
        }
@@ -225,10 +263,14 @@ pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
            }
            break;
        case CXt_EVAL:
-           if (cx->blk_eval.old_op_type != OP_ENTEREVAL &&
-               cx->blk_eval.old_op_type != OP_ENTERTRY)
-               return 0;       /* require must have its own scope */
-           saweval = i;
+           switch (cx->blk_eval.old_op_type) {
+           case OP_ENTEREVAL:
+               saweval = i;
+               break;
+           case OP_REQUIRE:
+               /* require must have its own scope */
+               return 0;
+           }
            break;
        case CXt_SUB:
            if (!saweval)
@@ -253,14 +295,14 @@ char *name;
     I32 off;
     SV *sv;
     SV **svp = AvARRAY(comppad_name);
-    I32 seq = cop_seqmax;
+    U32 seq = cop_seqmax;
 
     /* 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) &&
+           seq > I_32(SvNVX(sv)) &&
            strEQ(SvPVX(sv), name))
        {
            return (PADOFFSET)off;
@@ -314,9 +356,21 @@ U32 tmptype;
        retval = AvFILL(comppad);
     }
     else {
-       do {
-           sv = *av_fetch(comppad, ++padix, TRUE);
-       } while (SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY));
+       SV **names = AvARRAY(comppad_name);
+       SSize_t names_fill = AvFILL(comppad_name);
+       for (;;) {
+           /*
+            * "foreach" index vars temporarily become aliases to non-"my"
+            * values.  Thus we must skip, not just pad values that are
+            * marked as current pad values, but also those with names.
+            */
+           if (++padix <= names_fill &&
+                  (sv = names[padix]) && sv != &sv_undef)
+               continue;
+           sv = *av_fetch(comppad, padix, TRUE);
+           if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)))
+               break;
+       }
        retval = padix;
     }
     SvFLAGS(sv) |= tmptype;
@@ -354,7 +408,7 @@ pad_free(PADOFFSET po)
     if (!po)
        croak("panic: pad_free po");
     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad free %d\n", po));
-    if (curpad[po] && curpad[po] != &sv_undef)
+    if (curpad[po] && !SvIMMORTAL(curpad[po]))
        SvPADTMP_off(curpad[po]);
     if ((I32)po < padix)
        padix = po - 1;
@@ -390,7 +444,7 @@ pad_reset()
     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad reset\n"));
     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)
+           if (curpad[po] && !SvIMMORTAL(curpad[po]))
                SvPADTMP_off(curpad[po]);
        }
        padix = padix_floor;
@@ -423,15 +477,20 @@ OP *op;
     case OP_ENTEREVAL:
        op->op_targ = 0;        /* Was holding hints. */
        break;
+    default:
+       if (!(op->op_flags & OPf_REF) || (check[op->op_type] != ck_ftst))
+           break;
+       /* FALL THROUGH */
     case OP_GVSV:
     case OP_GV:
+    case OP_AELEMFAST:
        SvREFCNT_dec(cGVOP->op_gv);
        break;
     case OP_NEXTSTATE:
     case OP_DBSTATE:
+       Safefree(cCOP->cop_label);
        SvREFCNT_dec(cCOP->cop_filegv);
        break;
-    /* case OP_ANONCODE: XXX breaks eval of anon subs in closures (cf. Opcode) */
     case OP_CONST:
        SvREFCNT_dec(cSVOP->op_sv);
        break;
@@ -453,8 +512,6 @@ OP *op;
        pregfree(cPMOP->op_pmregexp);
        SvREFCNT_dec(cPMOP->op_pmshort);
        break;
-    default:
-       break;
     }
 
     if (op->op_targ > 0)
@@ -538,7 +595,8 @@ OP *op;
     OP *kid;
 
     /* assumes no premature commitment */
-    if (!op || (op->op_flags & OPf_KNOW) || error_count)
+    if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN
+        || error_count)
        return op;
 
     op->op_flags &= ~OPf_LIST;
@@ -609,6 +667,8 @@ OP *op;
     default:
        if (!(opargs[op->op_type] & OA_FOLDCONST))
            break;
+       /* FALL THROUGH */
+    case OP_REPEAT:
        if (op->op_flags & OPf_STACKED)
            break;
        /* FALL THROUGH */
@@ -635,8 +695,6 @@ OP *op;
     case OP_AELEM:
     case OP_AELEMFAST:
     case OP_ASLICE:
-    case OP_VALUES:
-    case OP_KEYS:
     case OP_HELEM:
     case OP_HSLICE:
     case OP_UNPACK:
@@ -727,11 +785,6 @@ OP *op;
        op->op_ppaddr = ppaddr[OP_PREDEC];
        break;
 
-    case OP_REPEAT:
-       scalarvoid(cBINOP->op_first);
-       useless = op_desc[op->op_type];
-       break;
-
     case OP_OR:
     case OP_AND:
     case OP_COND_EXPR:
@@ -764,6 +817,8 @@ OP *op;
                deprecate("implicit split to @_");
        }
        break;
+    case OP_KEYS:
+    case OP_VALUES:
     case OP_DELETE:
        op->op_private |= OPpLEAVE_VOID;
        break;
@@ -792,7 +847,8 @@ OP *op;
     OP *kid;
 
     /* assumes no premature commitment */
-    if (!op || (op->op_flags & OPf_KNOW) || error_count)
+    if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN
+        || error_count)
        return op;
 
     op->op_flags |= (OPf_KNOW | OPf_LIST);
@@ -889,7 +945,6 @@ I32 type;
 {
     OP *kid;
     SV *sv;
-    char mtype;
 
     if (!op || error_count)
        return op;
@@ -911,6 +966,10 @@ I32 type;
        else
            croak("That use of $[ is unsupported");
        break;
+    case OP_STUB:
+       if (op->op_flags & OPf_PARENS)
+           break;
+       goto nomod;
     case OP_ENTERSUB:
        if ((type == OP_UNDEF || type == OP_REFGEN) &&
            !(op->op_flags & OPf_STACKED)) {
@@ -997,6 +1056,8 @@ I32 type;
     case OP_PADAV:
     case OP_PADHV:
        modcount = 10000;
+       if (type == OP_REFGEN && op->op_flags & OPf_PARENS)
+           return op;          /* Treat \(@foo) like ordinary list. */
        /* FALL THROUGH */
     case OP_PADSV:
        modcount++;
@@ -1008,21 +1069,16 @@ I32 type;
     case OP_PUSHMARK:
        break;
        
+    case OP_KEYS:
+       if (type != OP_SASSIGN)
+           goto nomod;
+       /* FALL THROUGH */
     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, Nullsv, mtype, Nullch, 0);
-       curpad[op->op_targ] = sv;
+       assert(SvTYPE(PAD_SV(op->op_targ)) == SVt_NULL);
        if (op->op_flags & OPf_KIDS)
            mod(cBINOP->op_first->op_sibling, type);
        break;
@@ -1109,8 +1165,10 @@ I32 type;
        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);
+       if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
+           op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
+                              : type == OP_RV2HV ? OPpDEREF_HV
+                              : OPpDEREF_SV);
            op->op_flags |= OPf_MOD;
        }
        break;
@@ -1137,8 +1195,10 @@ I32 type;
     case OP_AELEM:
     case OP_HELEM:
        ref(cBINOP->op_first, op->op_type);
-       if (type == OP_RV2AV || type == OP_RV2HV) {
-           op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
+       if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
+           op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
+                              : type == OP_RV2HV ? OPpDEREF_HV
+                              : OPpDEREF_SV);
            op->op_flags |= OPf_MOD;
        }
        break;
@@ -1204,6 +1264,20 @@ OP *right;
 {
     OP *op;
 
+    if (dowarn &&
+       (left->op_type == OP_RV2AV ||
+        left->op_type == OP_RV2HV ||
+        left->op_type == OP_PADAV ||
+        left->op_type == OP_PADHV)) {
+       char *desc = op_desc[(right->op_type == OP_SUBST ||
+                             right->op_type == OP_TRANS)
+                            ? right->op_type : OP_MATCH];
+       char *sample = ((left->op_type == OP_RV2AV ||
+                        left->op_type == OP_PADAV)
+                       ? "@array" : "%hash");
+       warn("Applying %s to %s will act on scalar(%s)", desc, sample, sample);
+    }
+
     if (right->op_type == OP_MATCH ||
        right->op_type == OP_SUBST ||
        right->op_type == OP_TRANS) {
@@ -1262,41 +1336,42 @@ OP *o;
 }
 
 int
-block_start()
+block_start(full)
+int full;
 {
     int retval = savestack_ix;
-    SAVEINT(comppad_name_floor);
-    if ((comppad_name_fill = AvFILL(comppad_name)) > 0)
-       comppad_name_floor = comppad_name_fill;
-    else
-       comppad_name_floor = 0;
-    SAVEINT(min_intro_pending);
-    SAVEINT(max_intro_pending);
+    SAVEI32(comppad_name_floor);
+    if (full) {
+       if ((comppad_name_fill = AvFILL(comppad_name)) > 0)
+           comppad_name_floor = comppad_name_fill;
+       else
+           comppad_name_floor = 0;
+    }
+    SAVEI32(min_intro_pending);
+    SAVEI32(max_intro_pending);
     min_intro_pending = 0;
-    SAVEINT(comppad_name_fill);
-    SAVEINT(padix_floor);
+    SAVEI32(comppad_name_fill);
+    SAVEI32(padix_floor);
     padix_floor = padix;
     pad_reset_pending = FALSE;
-    SAVEINT(hints);
+    SAVEI32(hints);
     hints &= ~HINT_BLOCK_SCOPE;
     return retval;
 }
 
 OP*
-block_end(line, floor, seq)
-int line;
-int floor;
+block_end(floor, seq)
+I32 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);
+    cop_seqmax++;
     return retval;
 }
 
@@ -1311,17 +1386,26 @@ OP *op;
        peep(eval_start);
     }
     else {
-       if (!op) {
-           main_start = 0;
+       if (!op)
            return;
-       }
        main_root = scope(sawparens(scalarvoid(op)));
        curcop = &compiling;
        main_start = LINKLIST(main_root);
        main_root->op_next = 0;
        peep(main_start);
-       main_cv = compcv;
        compcv = 0;
+
+       /* Register with debugger */
+       if (perldb) {
+           CV *cv = perl_get_cv("DB::postponed", FALSE);
+           if (cv) {
+               dSP;
+               PUSHMARK(sp);
+               XPUSHs((SV*)compiling.cop_filegv);
+               PUTBACK;
+               perl_call_sv((SV*)cv, G_DISCARD);
+           }
+       }
     }
 }
 
@@ -1814,6 +1898,9 @@ I32 flags;
     pmop->op_flags = flags;
     pmop->op_private = 0 | (flags >> 8);
 
+    if (hints & HINT_LOCALE)
+       pmop->op_pmpermflags = (pmop->op_pmflags |= PMf_LOCALE);
+
     /* link into pm list */
     if (type != OP_TRANS && curstash) {
        pmop->op_pmnext = HvPMROOT(curstash);
@@ -2292,23 +2379,9 @@ I32 flags;
 char *label;
 OP *op;
 {
+    U32 seq = intro_my();
     register COP *cop;
 
-    /* Introduce my variables. */
-    if (min_intro_pending) {
-       SV **svp = AvARRAY(comppad_name);
-       I32 i;
-       SV *sv;
-       for (i = min_intro_pending; i <= max_intro_pending; i++) {
-           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 */
-    }
-
     Newz(1101, cop, 1, COP);
     if (perldb && curcop->cop_line && curstash != debstash) {
        cop->op_type = OP_DBSTATE;
@@ -2320,13 +2393,16 @@ OP *op;
     }
     cop->op_flags = flags;
     cop->op_private = 0 | (flags >> 8);
+#ifdef NATIVE_HINTS
+    cop->op_private |= NATIVE_HINTS;
+#endif
     cop->op_next = (OP*)cop;
 
     if (label) {
        cop->cop_label = label;
        hints |= HINT_BLOCK_SCOPE;
     }
-    cop->cop_seq = cop_seqmax++;
+    cop->cop_seq = seq;
     cop->cop_arybase = curcop->cop_arybase;
 
     if (copline == NOLINE)
@@ -2335,7 +2411,7 @@ OP *op;
         cop->cop_line = copline;
         copline = NOLINE;
     }
-    cop->cop_filegv = GvREFCNT_inc(curcop->cop_filegv);
+    cop->cop_filegv = (GV*)SvREFCNT_inc(curcop->cop_filegv);
     cop->cop_stash = curstash;
 
     if (perldb && curstash != debstash) {
@@ -2350,6 +2426,29 @@ OP *op;
     return prepend_elem(OP_LINESEQ, (OP*)cop, op);
 }
 
+/* "Introduce" my variables to visible status. */
+U32
+intro_my()
+{
+    SV **svp;
+    SV *sv;
+    I32 i;
+
+    if (! min_intro_pending)
+       return cop_seqmax;
+
+    svp = AvARRAY(comppad_name);
+    for (i = min_intro_pending; i <= max_intro_pending; i++) {
+       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 */
+    return cop_seqmax++;
+}
+
 OP *
 newLOGOP(type, flags, first, other)
 I32 type;
@@ -2397,6 +2496,32 @@ OP* other;
        else
            scalar(other);
     }
+    else if (dowarn && (first->op_flags & OPf_KIDS)) {
+       OP *k1 = ((UNOP*)first)->op_first;
+       OP *k2 = k1->op_sibling;
+       OPCODE warnop = 0;
+       switch (first->op_type)
+       {
+       case OP_NULL:
+           if (k2 && k2->op_type == OP_READLINE
+                 && (k2->op_flags & OPf_STACKED)
+                 && (k1->op_type == OP_RV2SV || k1->op_type == OP_PADSV))
+               warnop = k2->op_type;
+           break;
+
+       case OP_SASSIGN:
+           if (k1->op_type == OP_READDIR || k1->op_type == OP_GLOB)
+               warnop = k1->op_type;
+           break;
+       }
+       if (warnop) {
+           line_t oldline = curcop->cop_line;
+           curcop->cop_line = copline;
+           warn("Value of %s construct can be \"0\"; test with defined()",
+                op_desc[warnop]);
+               curcop->cop_line = oldline;
+       }
+    }
 
     if (!other)
        return first;
@@ -2542,8 +2667,10 @@ OP *block;
     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)), 0, expr);
+       if (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) );
+       }
     }
 
     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
@@ -2667,7 +2794,7 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
     else {
        sv = newGVOP(OP_GV, 0, defgv);
     }
-    if (expr->op_type == OP_RV2AV) {
+    if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
        expr = scalar(ref(expr, OP_ITER));
        iterflags |= OPf_STACKED;
     }
@@ -2720,51 +2847,109 @@ CV *cv;
        CvROOT(cv) = Nullop;
        LEAVE;
     }
+    CvFLAGS(cv) = 0;
     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);
+       /* may be during global destruction */
+       if (SvREFCNT(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));
        }
-       SvREFCNT_dec((SV*)CvPADLIST(cv));
        CvPADLIST(cv) = Nullav;
     }
 }
 
-CV *
-cv_clone(proto)
+#ifdef DEBUG_CLOSURES
+static void
+cv_dump(cv)
+CV* cv;
+{
+    CV *outside = CvOUTSIDE(cv);
+    AV* padlist = CvPADLIST(cv);
+    AV* pad_name;
+    AV* pad;
+    SV** pname;
+    SV** ppad;
+    I32 ix;
+
+    PerlIO_printf(Perl_debug_log, "\tCV=0x%p (%s), OUTSIDE=0x%p (%s)\n",
+                 cv,
+                 (CvANON(cv) ? "ANON"
+                  : (cv == main_cv) ? "MAIN"
+                  : CvUNIQUE(outside) ? "UNIQUE"
+                  : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
+                 outside,
+                 (!outside ? "null"
+                  : CvANON(outside) ? "ANON"
+                  : (outside == main_cv) ? "MAIN"
+                  : CvUNIQUE(outside) ? "UNIQUE"
+                  : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
+
+    if (!padlist)
+       return;
+
+    pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
+    pad = (AV*)*av_fetch(padlist, 1, FALSE);
+    pname = AvARRAY(pad_name);
+    ppad = AvARRAY(pad);
+
+    for (ix = 1; ix <= AvFILL(pad_name); ix++) {
+       if (SvPOK(pname[ix]))
+           PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (%s\"%s\" %ld-%ld)\n",
+                         ix, ppad[ix],
+                         SvFAKE(pname[ix]) ? "FAKE " : "",
+                         SvPVX(pname[ix]),
+                         (long)I_32(SvNVX(pname[ix])),
+                         (long)SvIVX(pname[ix]));
+    }
+}
+#endif /* DEBUG_CLOSURES */
+
+static CV *
+cv_clone2(proto, outside)
 CV* proto;
+CV* outside;
 {
     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);
+    SV** pname = AvARRAY(protopad_name);
+    SV** ppad = AvARRAY(protopad);
+    I32 fname = AvFILL(protopad_name);
+    I32 fpad = AvFILL(protopad);
     AV* comppadlist;
     CV* cv;
 
+    assert(!CvUNIQUE(proto));
+
     ENTER;
     SAVESPTR(curpad);
     SAVESPTR(comppad);
     SAVESPTR(compcv);
 
     cv = compcv = (CV*)NEWSV(1104,0);
-    sv_upgrade((SV *)cv, SVt_PVCV);
+    sv_upgrade((SV *)cv, SvTYPE(proto));
     CvCLONED_on(cv);
+    if (CvANON(proto))
+       CvANON_on(cv);
 
     CvFILEGV(cv)       = CvFILEGV(proto);
-    CvGV(cv)           = GvREFCNT_inc(CvGV(proto));
+    CvGV(cv)           = (GV*)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));
+    if (outside)
+       CvOUTSIDE(cv)   = (CV*)SvREFCNT_inc(outside);
 
     comppad = newAV();
 
@@ -2773,7 +2958,7 @@ CV* proto;
     av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
     av_store(comppadlist, 1, (SV*)comppad);
     CvPADLIST(cv) = comppadlist;
-    av_extend(comppad, AvFILL(protopad));
+    av_fill(comppad, AvFILL(protopad));
     curpad = AvARRAY(comppad);
 
     av = newAV();           /* will be @_ */
@@ -2781,37 +2966,80 @@ CV* proto;
     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)
+    for (ix = fpad; ix > 0; ix--) {
+       SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
+       if (namesv && namesv != &sv_undef) {
+           char *name = SvPVX(namesv);    /* XXX */
+           if (SvFLAGS(namesv) & SVf_FAKE) {   /* lexical from outside? */
+               I32 off = pad_findlex(name, ix, SvIVX(namesv),
+                                     CvOUTSIDE(cv), cxstack_ix);
+               if (!off)
+                   curpad[ix] = SvREFCNT_inc(ppad[ix]);
+               else if (off != ix)
                    croak("panic: cv_clone: %s", name);
            }
            else {                              /* our own lexical */
-               if (*name == '@')
-                   av_store(comppad, ix, sv = (SV*)newAV());
+               SV* sv;
+               if (*name == '&') {
+                   /* anon code -- we'll come back for it */
+                   sv = SvREFCNT_inc(ppad[ix]);
+               }
+               else if (*name == '@')
+                   sv = (SV*)newAV();
                else if (*name == '%')
-                   av_store(comppad, ix, sv = (SV*)newHV());
+                   sv = (SV*)newHV();
                else
-                   av_store(comppad, ix, sv = NEWSV(0,0));
-               SvPADMY_on(sv);
+                   sv = NEWSV(0,0);
+               if (!SvPADBUSY(sv))
+                   SvPADMY_on(sv);
+               curpad[ix] = sv;
            }
        }
        else {
-           av_store(comppad, ix, sv = NEWSV(0,0));
+           SV* sv = NEWSV(0,0);
            SvPADTMP_on(sv);
+           curpad[ix] = sv;
+       }
+    }
+
+    /* Now that vars are all in place, clone nested closures. */
+
+    for (ix = fpad; ix > 0; ix--) {
+       SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
+       if (namesv
+           && namesv != &sv_undef
+           && !(SvFLAGS(namesv) & SVf_FAKE)
+           && *SvPVX(namesv) == '&'
+           && CvCLONE(ppad[ix]))
+       {
+           CV *kid = cv_clone2((CV*)ppad[ix], cv);
+           SvREFCNT_dec(ppad[ix]);
+           CvCLONE_on(kid);
+           SvPADMY_on(kid);
+           curpad[ix] = (SV*)kid;
        }
     }
 
+#ifdef DEBUG_CLOSURES
+    PerlIO_printf(Perl_debug_log, "Cloned inside:\n");
+    cv_dump(outside);
+    PerlIO_printf(Perl_debug_log, "  from:\n");
+    cv_dump(proto);
+    PerlIO_printf(Perl_debug_log, "   to:\n");
+    cv_dump(cv);
+#endif
+
     LEAVE;
     return cv;
 }
 
+CV *
+cv_clone(proto)
+CV* proto;
+{
+    return cv_clone2(proto, CvOUTSIDE(proto));
+}
+
 SV *
 cv_const_sv(cv)
 CV *cv;
@@ -2843,21 +3071,24 @@ OP *op;
 OP *proto;
 OP *block;
 {
+    char *name = op ? SvPVx(cSVOP->op_sv, na) : Nullch;
+    GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
     register CV *cv;
-    char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__";
-    GV* gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
-    AV* av;
-    char *s;
+    AV *av;
     I32 ix;
 
     if (op)
-       sub_generation++;
-    if (cv = GvCV(gv)) {
-       if (GvCVGEN(gv))
-           cv = 0;                     /* just a cached method */
+       SAVEFREEOP(op);
+    if (cv = (name ? GvCV(gv) : Nullcv)) {
+       if (GvCVGEN(gv)) {
+           /* just a cached method */
+           SvREFCNT_dec(cv);
+           cv = 0;
+       }
        else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
-           SV* const_sv = cv_const_sv(cv);
+           /* already defined (or promised) */
 
+           SV* const_sv = cv_const_sv(cv);
            char *p = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch;
 
            if((!proto != !SvPOK(cv)) || (p && strNE(SvPV((SV*)cv,na), p))) {
@@ -2865,10 +3096,13 @@ OP *block;
                        SvPOK(cv) ? SvPV((SV*)cv,na) : "none",
                        p ? p : "none");
            }
-
-           if ((const_sv || dowarn) && strNE(name, "BEGIN")) {/* already defined (or promised)? */
+           if (!block) {
+               /* just a "sub foo;" when &foo is already defined */
+               SAVEFREESV(compcv);
+               goto done;
+           }
+           if (const_sv || dowarn) {
                line_t oldline = curcop->cop_line;
-
                curcop->cop_line = copline;
                warn(const_sv ? "Constant subroutine %s redefined"
                              : "Subroutine %s redefined",name);
@@ -2880,6 +3114,7 @@ OP *block;
     }
     if (cv) {                          /* must reuse cv if autoloaded */
        cv_undef(cv);
+       CvFLAGS(cv) = CvFLAGS(compcv);
        CvOUTSIDE(cv) = CvOUTSIDE(compcv);
        CvOUTSIDE(compcv) = 0;
        CvPADLIST(cv) = CvPADLIST(compcv);
@@ -2890,11 +3125,14 @@ OP *block;
     }
     else {
        cv = compcv;
+       if (name) {
+           GvCV(gv) = cv;
+           GvCVGEN(gv) = 0;
+           sub_generation++;
+       }
     }
-    GvCV(gv) = cv;
-    GvCVGEN(gv) = 0;
+    CvGV(cv) = (GV*)SvREFCNT_inc(gv);
     CvFILEGV(cv) = curcop->cop_filegv;
-    CvGV(cv) = GvREFCNT_inc(gv);
     CvSTASH(cv) = curstash;
 
     if (proto) {
@@ -2908,8 +3146,6 @@ OP *block;
        block = Nullop;
     }
     if (!block) {
-       CvROOT(cv) = 0;
-       op_free(op);
        copline = NOLINE;
        LEAVE_SCOPE(floor);
        return cv;
@@ -2921,7 +3157,7 @@ OP *block;
     AvFLAGS(av) = AVf_REIFY;
 
     for (ix = AvFILL(comppad); ix > 0; ix--) {
-       if (!SvPADMY(curpad[ix]))
+       if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
            SvPADTMP_on(curpad[ix]);
     }
 
@@ -2932,59 +3168,74 @@ OP *block;
     CvSTART(cv) = LINKLIST(CvROOT(cv));
     CvROOT(cv)->op_next = 0;
     peep(CvSTART(cv));
-    if (s = strrchr(name,':'))
-       s++;
-    else
-       s = name;
-    if (strEQ(s, "BEGIN") && !error_count) {
-       line_t oldline = compiling.cop_line;
-       SV *oldrs = rs;
 
-       ENTER;
-       SAVESPTR(compiling.cop_filegv);
-       SAVEI32(perldb);
-       if (!beginav)
-           beginav = newAV();
-       av_push(beginav, (SV *)cv);
-       DEBUG_x( dump_sub(gv) );
-       rs = SvREFCNT_inc(nrs);
-       SvREFCNT_inc(cv);
-       calllist(beginav);
-       if (GvCV(gv) == cv) {           /* Detach it. */
-           SvREFCNT_dec(cv);
-           GvCV(gv) = 0;               /* Was above calllist, why? IZ */
+    if (name) {
+       char *s;
+
+       if (perldb && curstash != debstash) {
+           SV *sv;
+           SV *tmpstr = sv_newmortal();
+           static GV *db_postponed;
+           CV *cv;
+           HV *hv;
+
+           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);
+           sv_catpv(sv,buf);
+           gv_efullname3(tmpstr, gv, Nullch);
+           hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
+           if (!db_postponed) {
+               db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
+           }
+           hv = GvHVn(db_postponed);
+           if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
+                 && (cv = GvCV(db_postponed))) {
+               dSP;
+               PUSHMARK(sp);
+               XPUSHs(tmpstr);
+               PUTBACK;
+               perl_call_sv((SV*)cv, G_DISCARD);
+           }
        }
-       SvREFCNT_dec(rs);
-       rs = oldrs;
-       curcop = &compiling;
-       curcop->cop_line = oldline;     /* might have recursed to yylex */
-       LEAVE;
-    }
-    else if (strEQ(s, "END") && !error_count) {
-       if (!endav)
-           endav = newAV();
-       av_unshift(endav, 1);
-       av_store(endav, 0, SvREFCNT_inc(cv));
-    }
-    if (perldb && curstash != debstash) {
-       SV *sv;
-       SV *tmpstr = sv_newmortal();
 
-       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);
-       sv_catpv(sv,buf);
-       gv_efullname(tmpstr,gv);
-       hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
+       if ((s = strrchr(name,':')))
+           s++;
+       else
+           s = name;
+       if (strEQ(s, "BEGIN") && !error_count) {
+           I32 oldscope = scopestack_ix;
+           ENTER;
+           SAVESPTR(compiling.cop_filegv);
+           SAVEI16(compiling.cop_line);
+           SAVEI32(perldb);
+           save_svref(&rs);
+           sv_setsv(rs, nrs);
+
+           if (!beginav)
+               beginav = newAV();
+           DEBUG_x( dump_sub(gv) );
+           av_push(beginav, (SV *)cv);
+           GvCV(gv) = 0;
+           calllist(oldscope, beginav);
+
+           curcop = &compiling;
+           LEAVE;
+       }
+       else if (strEQ(s, "END") && !error_count) {
+           if (!endav)
+               endav = newAV();
+           av_unshift(endav, 1);
+           av_store(endav, 0, (SV *)cv);
+           GvCV(gv) = 0;
+       }
     }
-    op_free(op);
+
+  done:
     copline = NOLINE;
     LEAVE_SCOPE(floor);
-    if (!op) {
-       GvCV(gv) = 0;   /* Will remember in SVOP instead. */
-       CvANON_on(cv);
-    }
     return cv;
 }
 
@@ -3009,19 +3260,19 @@ char *name;
 void (*subaddr) _((CV*));
 char *filename;
 {
+    GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
     register CV *cv;
-    GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
-    char *s;
-
-    if (name)
-       sub_generation++;
-    if (cv = GvCV(gv)) {
-       if (GvCVGEN(gv))
-           cv = 0;                     /* just a cached method */
-       else if (CvROOT(cv) || CvXSUB(cv)) {    /* already defined? */
+
+    if (cv = (name ? GvCV(gv) : Nullcv)) {
+       if (GvCVGEN(gv)) {
+           /* just a cached method */
+           SvREFCNT_dec(cv);
+           cv = 0;
+       }
+       else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
+           /* already defined (or promised) */
            if (dowarn) {
                line_t oldline = curcop->cop_line;
-
                curcop->cop_line = copline;
                warn("Subroutine %s redefined",name);
                curcop->cop_line = oldline;
@@ -3030,40 +3281,45 @@ char *filename;
            cv = 0;
        }
     }
-    if (cv) {                          /* must reuse cv if autoloaded */
-       assert(SvREFCNT(CvGV(cv)) > 1);
-       SvREFCNT_dec(CvGV(cv));
-    }
+
+    if (cv)                            /* must reuse cv if autoloaded */
+       cv_undef(cv);
     else {
        cv = (CV*)NEWSV(1105,0);
        sv_upgrade((SV *)cv, SVt_PVCV);
+       if (name) {
+           GvCV(gv) = cv;
+           GvCVGEN(gv) = 0;
+           sub_generation++;
+       }
     }
-    GvCV(gv) = cv;
-    CvGV(cv) = GvREFCNT_inc(gv);
-    GvCVGEN(gv) = 0;
+    CvGV(cv) = (GV*)SvREFCNT_inc(gv);
     CvFILEGV(cv) = gv_fetchfile(filename);
     CvXSUB(cv) = subaddr;
-    if (!name)
-       s = "__ANON__";
-    else if (s = strrchr(name,':'))
-       s++;
+
+    if (name) {
+       char *s = strrchr(name,':');
+       if (s)
+           s++;
+       else
+           s = name;
+       if (strEQ(s, "BEGIN")) {
+           if (!beginav)
+               beginav = newAV();
+           av_push(beginav, (SV *)cv);
+           GvCV(gv) = 0;
+       }
+       else if (strEQ(s, "END")) {
+           if (!endav)
+               endav = newAV();
+           av_unshift(endav, 1);
+           av_store(endav, 0, (SV *)cv);
+           GvCV(gv) = 0;
+       }
+    }
     else
-       s = name;
-    if (strEQ(s, "BEGIN")) {
-       if (!beginav)
-           beginav = newAV();
-       av_push(beginav, SvREFCNT_inc(gv));
-    }
-    else if (strEQ(s, "END")) {
-       if (!endav)
-           endav = newAV();
-       av_unshift(endav, 1);
-       av_store(endav, 0, SvREFCNT_inc(gv));
-    }
-    if (!name) {
-       GvCV(gv) = 0;   /* Will remember elsewhere instead. */
        CvANON_on(cv);
-    }
+
     return cv;
 }
 
@@ -3096,11 +3352,11 @@ OP *block;
     }
     cv = compcv;
     GvFORM(gv) = cv;
-    CvGV(cv) = GvREFCNT_inc(gv);
+    CvGV(cv) = (GV*)SvREFCNT_inc(gv);
     CvFILEGV(cv) = curcop->cop_filegv;
 
     for (ix = AvFILL(comppad); ix > 0; ix--) {
-       if (!SvPADMY(curpad[ix]))
+       if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
            SvPADTMP_on(curpad[ix]);
     }
 
@@ -3108,7 +3364,6 @@ OP *block;
     CvSTART(cv) = LINKLIST(CvROOT(cv));
     CvROOT(cv)->op_next = 0;
     peep(CvSTART(cv));
-    FmLINES(cv) = 0;
     op_free(op);
     copline = NOLINE;
     LEAVE_SCOPE(floor);
@@ -3254,6 +3509,35 @@ OP *o;
 /* Check routines. */
 
 OP *
+ck_anoncode(op)
+OP *op;
+{
+    PADOFFSET ix;
+    SV* name;
+
+    name = NEWSV(1106,0);
+    sv_upgrade(name, SVt_PVNV);
+    sv_setpvn(name, "&", 1);
+    SvIVX(name) = -1;
+    SvNVX(name) = 1;
+    ix = pad_alloc(op->op_type, SVs_PADMY);
+    av_store(comppad_name, ix, name);
+    av_store(comppad, ix, cSVOP->op_sv);
+    SvPADMY_on(cSVOP->op_sv);
+    cSVOP->op_sv = Nullsv;
+    cSVOP->op_targ = ix;
+    return op;
+}
+
+OP *
+ck_bitop(op)
+OP *op;
+{
+    op->op_private = hints;
+    return op;
+}
+
+OP *
 ck_concat(op)
 OP *op;
 {
@@ -3269,7 +3553,8 @@ OP *op;
     if (op->op_flags & OPf_KIDS) {
        OP* newop;
        OP* kid;
-       op = modkids(ck_fun(op), op->op_type);
+       OPCODE type = op->op_type;
+       op = modkids(ck_fun(op), type);
        kid = cUNOP->op_first;
        newop = kUNOP->op_first->op_sibling;
        if (newop &&
@@ -3292,10 +3577,14 @@ ck_delete(op)
 OP *op;
 {
     op = ck_fun(op);
+    op->op_private = 0;
     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_desc[op->op_type]);
+       if (kid->op_type == OP_HSLICE)
+           op->op_private |= OPpSLICE;
+       else if (kid->op_type != OP_HELEM)
+           croak("%s argument is not a HASH element or slice",
+                 op_desc[op->op_type]);
        null(kid);
     }
     return op;
@@ -3377,6 +3666,20 @@ OP *op;
 }
 
 OP *
+ck_exists(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_desc[op->op_type]);
+       null(kid);
+    }
+    return op;
+}
+
+OP *
 ck_gvconst(o)
 register OP *o;
 {
@@ -3394,9 +3697,31 @@ register OP *op;
 
     op->op_private |= (hints & HINT_STRICT_REFS);
     if (kid->op_type == OP_CONST) {
-       int iscv = (op->op_type==OP_RV2CV)*2;
-       GV *gv = 0;
+       char *name;
+       int iscv;
+       GV *gv;
+
+       name = SvPV(kid->op_sv, na);
+       if ((hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
+           char *badthing = Nullch;
+           switch (op->op_type) {
+           case OP_RV2SV:
+               badthing = "a SCALAR";
+               break;
+           case OP_RV2AV:
+               badthing = "an ARRAY";
+               break;
+           case OP_RV2HV:
+               badthing = "a HASH";
+               break;
+           }
+           if (badthing)
+               croak(
+         "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
+                     name, badthing);
+       }
        kid->op_type = OP_GV;
+       iscv = (op->op_type == OP_RV2CV) * 2;
        for (gv = 0; !gv; iscv++) {
            /*
             * This is a little tricky.  We only want to add the symbol if we
@@ -3406,7 +3731,7 @@ register OP *op;
             * 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),
+           gv = gv_fetchpv(name,
                iscv | !(kid->op_private & OPpCONST_ENTERED),
                iscv
                    ? SVt_PVCV
@@ -3425,13 +3750,6 @@ register OP *op;
 }
 
 OP *
-ck_formline(op)
-OP *op;
-{
-    return ck_fun(op);
-}
-
-OP *
 ck_ftst(op)
 OP *op;
 {
@@ -3513,8 +3831,8 @@ OP *op;
                    OP *newop = newAVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVAV) ));
                    if (dowarn)
-                       warn("Array @%s missing the @ in argument %d of %s()",
-                           name, numargs, op_desc[type]);
+                       warn("Array @%s missing the @ in argument %ld of %s()",
+                           name, (long)numargs, op_desc[type]);
                    op_free(kid);
                    kid = newop;
                    kid->op_sibling = sibl;
@@ -3531,8 +3849,8 @@ OP *op;
                    OP *newop = newHVREF(newGVOP(OP_GV, 0,
                        gv_fetchpv(name, TRUE, SVt_PVHV) ));
                    if (dowarn)
-                       warn("Hash %%%s missing the %% in argument %d of %s()",
-                           name, numargs, op_desc[type]);
+                       warn("Hash %%%s missing the %% in argument %ld of %s()",
+                           name, (long)numargs, op_desc[type]);
                    op_free(kid);
                    kid = newop;
                    kid->op_sibling = sibl;
@@ -3614,6 +3932,8 @@ OP *op;
                                                newGVOP(OP_GV, 0, gv)))));
        return ck_subr(op);
     }
+    if ((op->op_flags & OPf_KIDS) && !cLISTOP->op_first->op_sibling)
+       append_elem(OP_GLOB, op, newSVREF(newGVOP(OP_GV, 0, defgv)));
     gv = newGVgen("main");
     gv_IOadd(gv);
     append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
@@ -3680,7 +4000,7 @@ OP *op;
     if (op->op_flags & OPf_KIDS) {
        OP *kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
        if (kid && kid->op_type == OP_CONST)
-           fbm_compile(((SVOP*)kid)->op_sv, 0);
+           fbm_compile(((SVOP*)kid)->op_sv);
     }
     return ck_fun(op);
 }
@@ -3697,14 +4017,16 @@ OP *
 ck_lfun(op)
 OP *op;
 {
-    return modkids(ck_fun(op), op->op_type);
+    OPCODE type = op->op_type;
+    return modkids(ck_fun(op), type);
 }
 
 OP *
 ck_rfun(op)
 OP *op;
 {
-    return refkids(ck_fun(op), op->op_type);
+    OPCODE type = op->op_type;
+    return refkids(ck_fun(op), type);
 }
 
 OP *
@@ -3735,7 +4057,43 @@ OP *op;
     if (!kid)
        append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
 
-    return listkids(op);
+    op = listkids(op);
+
+    op->op_private = 0;
+#ifdef USE_LOCALE
+    if (hints & HINT_LOCALE)
+       op->op_private |= OPpLOCALE;
+#endif
+
+    return op;
+}
+
+OP *
+ck_fun_locale(op)
+OP *op;
+{
+    op = ck_fun(op);
+
+    op->op_private = 0;
+#ifdef USE_LOCALE
+    if (hints & HINT_LOCALE)
+       op->op_private |= OPpLOCALE;
+#endif
+
+    return op;
+}
+
+OP *
+ck_scmp(op)
+OP *op;
+{
+    op->op_private = 0;
+#ifdef USE_LOCALE
+    if (hints & HINT_LOCALE)
+       op->op_private |= OPpLOCALE;
+#endif
+
+    return op;
 }
 
 OP *
@@ -3840,6 +4198,12 @@ OP *
 ck_sort(op)
 OP *op;
 {
+    op->op_private = 0;
+#ifdef USE_LOCALE
+    if (hints & HINT_LOCALE)
+       op->op_private |= OPpLOCALE;
+#endif
+
     if (op->op_flags & OPf_STACKED) {
        OP *kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
        OP *k;
@@ -3876,6 +4240,7 @@ OP *op;
            op->op_flags |= OPf_SPECIAL;
        }
     }
+
     return op;
 }
 
@@ -3957,7 +4322,7 @@ OP *op;
        null(cvop);             /* disable rv2cv */
        tmpop = (SVOP*)((UNOP*)cvop)->op_first;
        if (tmpop->op_type == OP_GV) {
-           cv = GvCV(tmpop->op_sv);
+           cv = GvCVu(tmpop->op_sv);
            if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER))
                proto = SvPV((SV*)cv,na);
        }
@@ -4049,7 +4414,6 @@ OP *op;
        }
        else
            list(o);
-       mod(o, OP_ENTERSUB);
        prev = o;
        o = o->op_sibling;
     }
@@ -4142,7 +4506,7 @@ register OP* o;
 
        case OP_GV:
            if (o->op_next->op_type == OP_RV2SV) {
-               if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
+               if (!(o->op_next->op_private & OPpDEREF)) {
                    null(o->op_next);
                    o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
                    o->op_next = o->op_next->op_next;
@@ -4156,8 +4520,7 @@ register OP* o;
                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|OPpLVAL_INTRO)) &&
+                   !(pop->op_next->op_private & (OPpDEREF|OPpLVAL_INTRO)) &&
                    (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
                                <= 255 &&
                    i >= 0)
@@ -4171,7 +4534,7 @@ register OP* o;
                    o->op_type = OP_AELEMFAST;
                    o->op_ppaddr = ppaddr[OP_AELEMFAST];
                    o->op_private = (U8)i;
-                   GvAVn((GV*)(((SVOP*)o)->op_sv));
+                   GvAVn(((GVOP*)o)->op_gv);
                }
            }
            o->op_seq = op_seqmax++;