X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_ctl.c;h=12f3f04bc60c14aa443cb27d6ec2a90e14941e96;hb=fabdb6c0879db76333e970b6c67260c877fc17b3;hp=fbd533eac203bc0e216d3a9a7a5ef30e06ce02b7;hpb=9d4ba2ae61ff15b15f3e889810ff89dfb2ed1738;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_ctl.c b/pp_ctl.c
index fbd533e..12f3f04 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -38,8 +38,6 @@
 
 #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
 
-static I32 run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen);
-
 PP(pp_wantarray)
 {
     dSP;
@@ -60,11 +58,6 @@ PP(pp_wantarray)
     }
 }
 
-PP(pp_regcmaybe)
-{
-    return NORMAL;
-}
-
 PP(pp_regcreset)
 {
     /* XXXX Should store the old value to allow for tie/overload - and
@@ -122,7 +115,7 @@ PP(pp_regcomp)
 	    mg = mg_find(sv, PERL_MAGIC_qr);
     }
     if (mg) {
-	regexp *re = (regexp *)mg->mg_obj;
+	regexp * const re = (regexp *)mg->mg_obj;
 	ReREFCNT_dec(PM_GETRE(pm));
 	PM_SETRE(pm, ReREFCNT_inc(re));
     }
@@ -195,7 +188,7 @@ PP(pp_substcont)
     register char *m = cx->sb_m;
     char *orig = cx->sb_orig;
     register REGEXP * const rx = cx->sb_rx;
-    SV *nsv = Nullsv;
+    SV *nsv = NULL;
     REGEXP *old = PM_GETRE(pm);
     if(old != rx) {
 	if(old)
@@ -204,7 +197,7 @@ PP(pp_substcont)
     }
 
     rxres_restore(&cx->sb_rxres, rx);
-    RX_MATCH_UTF8_set(rx, SvUTF8(cx->sb_targ));
+    RX_MATCH_UTF8_set(rx, DO_UTF8(cx->sb_targ));
 
     if (cx->sb_iters++) {
 	const I32 saviters = cx->sb_iters;
@@ -214,6 +207,7 @@ PP(pp_substcont)
 	if (!(cx->sb_rxtainted & 2) && SvTAINTED(TOPs))
 	    cx->sb_rxtainted |= 2;
 	sv_catsv(dstr, POPs);
+	FREETMPS; /* Prevent excess tmp stack */
 
 	/* Are we done */
 	if (cx->sb_once || !CALLREGEXEC(aTHX_ rx, s, cx->sb_strend, orig,
@@ -222,7 +216,7 @@ PP(pp_substcont)
 				      ? (REXEC_IGNOREPOS|REXEC_NOT_FIRST)
 				      : (REXEC_COPY_STR|REXEC_IGNOREPOS|REXEC_NOT_FIRST))))
 	{
-	    SV *targ = cx->sb_targ;
+	    SV * const targ = cx->sb_targ;
 
 	    assert(cx->sb_strend >= s);
 	    if(cx->sb_strend > s) {
@@ -280,13 +274,13 @@ PP(pp_substcont)
     }
     cx->sb_s = rx->endp[0] + orig;
     { /* Update the pos() information. */
-	SV *sv = cx->sb_targ;
+	SV * const sv = cx->sb_targ;
 	MAGIC *mg;
 	I32 i;
 	if (SvTYPE(sv) < SVt_PVMG)
 	    SvUPGRADE(sv, SVt_PVMG);
 	if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
-	    sv_magic(sv, Nullsv, PERL_MAGIC_regex_global, Nullch, 0);
+	    sv_magic(sv, NULL, PERL_MAGIC_regex_global, NULL, 0);
 	    mg = mg_find(sv, PERL_MAGIC_regex_global);
 	}
 	i = m - orig;
@@ -314,18 +308,18 @@ Perl_rxres_save(pTHX_ void **rsp, REGEXP *rx)
 	i = 6 + rx->nparens * 2;
 #endif
 	if (!p)
-	    New(501, p, i, UV);
+	    Newx(p, i, UV);
 	else
 	    Renew(p, i, UV);
 	*rsp = (void*)p;
     }
 
-    *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : Nullch);
+    *p++ = PTR2UV(RX_MATCH_COPIED(rx) ? rx->subbeg : NULL);
     RX_MATCH_COPIED_off(rx);
 
 #ifdef PERL_OLD_COPY_ON_WRITE
     *p++ = PTR2UV(rx->saved_copy);
-    rx->saved_copy = Nullsv;
+    rx->saved_copy = NULL;
 #endif
 
     *p++ = rx->nparens;
@@ -368,7 +362,7 @@ Perl_rxres_restore(pTHX_ void **rsp, REGEXP *rx)
 void
 Perl_rxres_free(pTHX_ void **rsp)
 {
-    UV *p = (UV*)*rsp;
+    UV * const p = (UV*)*rsp;
 
     if (p) {
 #ifdef PERL_POISON
@@ -392,27 +386,27 @@ Perl_rxres_free(pTHX_ void **rsp)
 PP(pp_formline)
 {
     dSP; dMARK; dORIGMARK;
-    register SV *tmpForm = *++MARK;
+    register SV * const tmpForm = *++MARK;
     register U32 *fpc;
     register char *t;
     const char *f;
     register I32 arg;
-    register SV *sv = Nullsv;
-    const char *item = Nullch;
+    register SV *sv = NULL;
+    const char *item = NULL;
     I32 itemsize  = 0;
     I32 fieldsize = 0;
     I32 lines = 0;
-    bool chopspace = (strchr(PL_chopset, ' ') != Nullch);
-    const char *chophere = Nullch;
-    char *linemark = Nullch;
+    bool chopspace = (strchr(PL_chopset, ' ') != NULL);
+    const char *chophere = NULL;
+    char *linemark = NULL;
     NV value;
     bool gotsome = FALSE;
     STRLEN len;
-    STRLEN fudge = SvPOK(tmpForm)
+    const STRLEN fudge = SvPOK(tmpForm)
 			? (SvCUR(tmpForm) * (IN_BYTES ? 1 : 3) + 1) : 0;
     bool item_is_utf8 = FALSE;
     bool targ_is_utf8 = FALSE;
-    SV * nsv = Nullsv;
+    SV * nsv = NULL;
     OP * parseres = 0;
     const char *fmt;
     bool oneline;
@@ -731,7 +725,7 @@ PP(pp_formline)
 	    {
 		const char *s = chophere;
 		if (chopspace) {
-		    while (*s && isSPACE(*s))
+		    while (isSPACE(*s))
 			s++;
 		}
 		sv_chop(sv,s);
@@ -869,7 +863,7 @@ PP(pp_formline)
 		const char *s = chophere;
 		const char *send = item + len;
 		if (chopspace) {
-		    while (*s && isSPACE(*s) && s < send)
+		    while (isSPACE(*s) && (s < send))
 			s++;
 		}
 		if (s < send) {
@@ -940,11 +934,6 @@ PP(pp_grepstart)
     return ((LOGOP*)PL_op->op_next)->op_other;
 }
 
-PP(pp_mapstart)
-{
-    DIE(aTHX_ "panic: mapstart");	/* uses grepstart */
-}
-
 PP(pp_mapwhile)
 {
     dVAR; dSP;
@@ -1075,7 +1064,7 @@ PP(pp_flip)
     }
     else {
 	dTOPss;
-	SV *targ = PAD_SV(PL_op->op_targ);
+	SV * const targ = PAD_SV(PL_op->op_targ);
 	int flip = 0;
 
 	if (PL_op->op_private & OPpFLIP_LINENUM) {
@@ -1083,8 +1072,9 @@ PP(pp_flip)
 		flip = SvIV(sv) == (IV)IoLINES(GvIOp(PL_last_in_gv));
 	    }
 	    else {
-		GV *gv = gv_fetchpv(".", TRUE, SVt_PV);
-		if (gv && GvSV(gv)) flip = SvIV(sv) == SvIV(GvSV(gv));
+		GV * const gv = gv_fetchpv(".", TRUE, SVt_PV);
+		if (gv && GvSV(gv))
+		    flip = SvIV(sv) == SvIV(GvSV(gv));
 	    }
 	} else {
 	    flip = SvTRUE(sv);
@@ -1126,10 +1116,8 @@ PP(pp_flop)
     if (GIMME == G_ARRAY) {
 	dPOPPOPssrl;
 
-	if (SvGMAGICAL(left))
-	    mg_get(left);
-	if (SvGMAGICAL(right))
-	    mg_get(right);
+	SvGETMAGIC(left);
+	SvGETMAGIC(right);
 
 	if (RANGE_IS_NUMERIC(left,right)) {
 	    register IV i, j;
@@ -1152,9 +1140,9 @@ PP(pp_flop)
 	    }
 	}
 	else {
-	    SV *final = sv_mortalcopy(right);
+	    SV * const final = sv_mortalcopy(right);
 	    STRLEN len;
-	    const char *tmps = SvPV_const(final, len);
+	    const char * const tmps = SvPV_const(final, len);
 
 	    SV *sv = sv_mortalcopy(left);
 	    SvPV_force_nolen(sv);
@@ -1205,7 +1193,9 @@ static const char * const context_name[] = {
     "loop",
     "substitution",
     "block",
-    "format"
+    "format",
+    "given",
+    "when"
 };
 
 STATIC I32
@@ -1221,6 +1211,8 @@ S_dopoptolabel(pTHX_ const char *label)
 	case CXt_FORMAT:
 	case CXt_EVAL:
 	case CXt_NULL:
+	case CXt_GIVEN:
+	case CXt_WHEN:
 	    if (ckWARN(WARN_EXITING))
 		Perl_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
 			context_name[CxTYPE(cx)], OP_NAME(PL_op));
@@ -1240,6 +1232,8 @@ S_dopoptolabel(pTHX_ const char *label)
     return i;
 }
 
+
+
 I32
 Perl_dowantarray(pTHX)
 {
@@ -1348,6 +1342,45 @@ S_dopoptoloop(pTHX_ I32 startingblock)
     return i;
 }
 
+STATIC I32
+S_dopoptogiven(pTHX_ I32 startingblock)
+{
+    I32 i;
+    for (i = startingblock; i >= 0; i--) {
+	register const PERL_CONTEXT *cx = &cxstack[i];
+	switch (CxTYPE(cx)) {
+	default:
+	    continue;
+	case CXt_GIVEN:
+	    DEBUG_l( Perl_deb(aTHX_ "(Found given #%ld)\n", (long)i));
+	    return i;
+	case CXt_LOOP:
+	    if (CxFOREACHDEF(cx)) {
+		DEBUG_l( Perl_deb(aTHX_ "(Found foreach #%ld)\n", (long)i));
+		return i;
+	    }
+	}
+    }
+    return i;
+}
+
+STATIC I32
+S_dopoptowhen(pTHX_ I32 startingblock)
+{
+    I32 i;
+    for (i = startingblock; i >= 0; i--) {
+	register const PERL_CONTEXT *cx = &cxstack[i];
+	switch (CxTYPE(cx)) {
+	default:
+	    continue;
+	case CXt_WHEN:
+	    DEBUG_l( Perl_deb(aTHX_ "(Found when #%ld)\n", (long)i));
+	    return i;
+	}
+    }
+    return i;
+}
+
 void
 Perl_dounwind(pTHX_ I32 cxix)
 {
@@ -1408,8 +1441,8 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 	if (message) {
 	    if (PL_in_eval & EVAL_KEEPERR) {
                 static const char prefix[] = "\t(in cleanup) ";
-		SV *err = ERRSV;
-                const char *e = Nullch;
+		SV * const err = ERRSV;
+		const char *e = NULL;
 		if (!SvPOK(err))
 		    sv_setpvn(err,"",0);
 		else if (SvCUR(err) >= sizeof(prefix)+msglen-1) {
@@ -1417,7 +1450,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 		    e = SvPV_const(err, len);
 		    e += len - msglen;
 		    if (*e != *message || strNE(e,message))
-			e = Nullch;
+			e = NULL;
 		}
 		if (!e) {
 		    SvGROW(err, SvCUR(err)+sizeof(prefix)+msglen);
@@ -1472,7 +1505,7 @@ Perl_die_where(pTHX_ const char *message, STRLEN msglen)
 	    PL_curcop = cx->blk_oldcop;
 
 	    if (optype == OP_REQUIRE) {
-                const char* msg = SvPVx_nolen_const(ERRSV);
+                const char* const msg = SvPVx_nolen_const(ERRSV);
 		SV * const nsv = cx->blk_eval.old_namesv;
                 (void)hv_store(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv),
                                &PL_sv_undef, 0);
@@ -1501,57 +1534,6 @@ PP(pp_xor)
 	RETSETNO;
 }
 
-PP(pp_andassign)
-{
-    dSP;
-    if (!SvTRUE(TOPs))
-	RETURN;
-    else
-	RETURNOP(cLOGOP->op_other);
-}
-
-PP(pp_orassign)
-{
-    dSP;
-    if (SvTRUE(TOPs))
-	RETURN;
-    else
-	RETURNOP(cLOGOP->op_other);
-}
-
-PP(pp_dorassign)
-{
-    dSP;
-    register SV* sv;
-
-    sv = TOPs;
-    if (!sv || !SvANY(sv)) {
-	RETURNOP(cLOGOP->op_other);
-    }
-
-    switch (SvTYPE(sv)) {
-    case SVt_PVAV:
-	if (AvMAX(sv) >= 0 || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-	    RETURN;
-	break;
-    case SVt_PVHV:
-	if (HvARRAY(sv) || SvGMAGICAL(sv) || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
-	    RETURN;
-	break;
-    case SVt_PVCV:
-	if (CvROOT(sv) || CvXSUB(sv))
-	    RETURN;
-	break;
-    default:
-	if (SvGMAGICAL(sv))
-	    mg_get(sv);
-	if (SvOK(sv))
-	    RETURN;
-    }
-
-    RETURNOP(cLOGOP->op_other);
-}
-
 PP(pp_caller)
 {
     dSP;
@@ -1623,11 +1605,11 @@ PP(pp_caller)
     if (!MAXARG)
 	RETURN;
     if (CxTYPE(cx) == CXt_SUB || CxTYPE(cx) == CXt_FORMAT) {
-	GV *cvgv = CvGV(ccstack[cxix].blk_sub.cv);
+	GV * const cvgv = CvGV(ccstack[cxix].blk_sub.cv);
 	/* So is ccstack[dbcxix]. */
 	if (isGV(cvgv)) {
 	    SV * const sv = NEWSV(49, 0);
-	    gv_efullname3(sv, cvgv, Nullch);
+	    gv_efullname3(sv, cvgv, NULL);
 	    PUSHs(sv_2mortal(sv));
 	    PUSHs(sv_2mortal(newSViv((I32)cx->blk_sub.hasargs)));
 	}
@@ -1673,9 +1655,8 @@ PP(pp_caller)
 	const int off = AvARRAY(ary) - AvALLOC(ary);
 
 	if (!PL_dbargs) {
-	    GV* tmpgv;
-	    PL_dbargs = GvAV(gv_AVadd(tmpgv = gv_fetchpv("DB::args", TRUE,
-				SVt_PVAV)));
+	    GV* const tmpgv = gv_fetchpv("DB::args", TRUE, SVt_PVAV);
+	    PL_dbargs = GvAV(gv_AVadd(tmpgv));
 	    GvMULTI_on(tmpgv);
 	    AvREAL_off(PL_dbargs);	/* XXX should be REIFY (see av.h) */
 	}
@@ -1692,7 +1673,7 @@ PP(pp_caller)
 			     HINT_PRIVATE_MASK)));
     {
 	SV * mask ;
-	SV * old_warnings = cx->blk_oldcop->cop_warnings ;
+	SV * const old_warnings = cx->blk_oldcop->cop_warnings ;
 
 	if  (old_warnings == pWARN_NONE ||
 		(old_warnings == pWARN_STD && (PL_dowarn & G_WARN_ON) == 0))
@@ -1702,7 +1683,7 @@ PP(pp_caller)
 	    /* Get the bit mask for $warnings::Bits{all}, because
 	     * it could have been extended by warnings::register */
 	    SV **bits_all;
-	    HV *bits = get_hv("warnings::Bits", FALSE);
+	    HV * const bits = get_hv("warnings::Bits", FALSE);
 	    if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
 		mask = newSVsv(*bits_all);
 	    }
@@ -1720,22 +1701,12 @@ PP(pp_caller)
 PP(pp_reset)
 {
     dSP;
-    const char *tmps;
-
-    if (MAXARG < 1)
-	tmps = "";
-    else
-	tmps = POPpconstx;
+    const char * const tmps = (MAXARG < 1) ? "" : POPpconstx;
     sv_reset(tmps, CopSTASH(PL_curcop));
     PUSHs(&PL_sv_yes);
     RETURN;
 }
 
-PP(pp_lineseq)
-{
-    return NORMAL;
-}
-
 /* like pp_nextstate, but used instead when the debugger is active */
 
 PP(pp_dbstate)
@@ -1750,14 +1721,12 @@ PP(pp_dbstate)
 	    || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace))
     {
 	dSP;
-	register CV *cv;
 	register PERL_CONTEXT *cx;
 	const I32 gimme = G_ARRAY;
 	U8 hasargs;
-	GV *gv;
+	GV * const gv = PL_DBgv;
+	register CV * const cv = GvCV(gv);
 
-	gv = PL_DBgv;
-	cv = GvCV(gv);
 	if (!cv)
 	    DIE(aTHX_ "No DB::DB routine defined");
 
@@ -1774,29 +1743,36 @@ PP(pp_dbstate)
 	hasargs = 0;
 	SPAGAIN;
 
-	PUSHBLOCK(cx, CXt_SUB, SP);
-	PUSHSUB_DB(cx);
-	cx->blk_sub.retop = PL_op->op_next;
-	CvDEPTH(cv)++;
-	PAD_SET_CUR(CvPADLIST(cv),1);
-	RETURNOP(CvSTART(cv));
+	if (CvXSUB(cv)) {
+	    CvDEPTH(cv)++;
+	    PUSHMARK(SP);
+	    (void)(*CvXSUB(cv))(aTHX_ cv);
+	    CvDEPTH(cv)--;
+	    FREETMPS;
+	    LEAVE;
+	    return NORMAL;
+	}
+	else {
+	    PUSHBLOCK(cx, CXt_SUB, SP);
+	    PUSHSUB_DB(cx);
+	    cx->blk_sub.retop = PL_op->op_next;
+	    CvDEPTH(cv)++;
+	    SAVECOMPPAD();
+	    PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
+	    RETURNOP(CvSTART(cv));
+	}
     }
     else
 	return NORMAL;
 }
 
-PP(pp_scope)
-{
-    return NORMAL;
-}
-
 PP(pp_enteriter)
 {
     dVAR; dSP; dMARK;
     register PERL_CONTEXT *cx;
     const I32 gimme = GIMME_V;
     SV **svp;
-    U32 cxtype = CXt_LOOP;
+    U32 cxtype = CXt_LOOP | CXp_FOREACH;
 #ifdef USE_ITHREADS
     void *iterdata;
 #endif
@@ -1820,7 +1796,7 @@ PP(pp_enteriter)
 #endif
     }
     else {
-	GV *gv = (GV*)POPs;
+	GV * const gv = (GV*)POPs;
 	svp = &GvSV(gv);			/* symbol table variable */
 	SAVEGENERICSV(*svp);
 	*svp = NEWSV(0,0);
@@ -1829,6 +1805,9 @@ PP(pp_enteriter)
 #endif
     }
 
+    if (PL_op->op_private & OPpITER_DEF)
+	cxtype |= CXp_FOR_DEF;
+
     ENTER;
 
     PUSHBLOCK(cx, cxtype, SP);
@@ -1841,13 +1820,19 @@ PP(pp_enteriter)
 	cx->blk_loop.iterary = (AV*)SvREFCNT_inc(POPs);
 	if (SvTYPE(cx->blk_loop.iterary) != SVt_PVAV) {
 	    dPOPss;
-	    SV *right = (SV*)cx->blk_loop.iterary;
+	    SV * const right = (SV*)cx->blk_loop.iterary;
+	    SvGETMAGIC(sv);
+	    SvGETMAGIC(right);
 	    if (RANGE_IS_NUMERIC(sv,right)) {
 		if ((SvOK(sv) && SvNV(sv) < IV_MIN) ||
 		    (SvOK(right) && SvNV(right) >= IV_MAX))
 		    DIE(aTHX_ "Range iterator outside integer range");
 		cx->blk_loop.iterix = SvIV(sv);
 		cx->blk_loop.itermax = SvIV(right);
+#ifdef DEBUGGING
+		/* for correct -Dstv display */
+		cx->blk_oldsp = sp - PL_stack_base;
+#endif
 	    }
 	    else {
 		cx->blk_loop.iterlval = newSVsv(sv);
@@ -1856,8 +1841,8 @@ PP(pp_enteriter)
 	    }
 	}
 	else if (PL_op->op_private & OPpITER_REVERSED) {
-	    cx->blk_loop.itermax = -1;
-	    cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary);
+	    cx->blk_loop.itermax = 0;
+	    cx->blk_loop.iterix = AvFILL(cx->blk_loop.iterary) + 1;
 
 	}
     }
@@ -1865,8 +1850,8 @@ PP(pp_enteriter)
 	cx->blk_loop.iterary = PL_curstack;
 	AvFILLp(PL_curstack) = SP - PL_stack_base;
 	if (PL_op->op_private & OPpITER_REVERSED) {
-	    cx->blk_loop.itermax = MARK - PL_stack_base;
-	    cx->blk_loop.iterix = cx->blk_oldsp;
+	    cx->blk_loop.itermax = MARK - PL_stack_base + 1;
+	    cx->blk_loop.iterix = cx->blk_oldsp + 1;
 	}
 	else {
 	    cx->blk_loop.iterix = MARK - PL_stack_base;
@@ -1936,7 +1921,6 @@ PP(pp_leaveloop)
 PP(pp_return)
 {
     dVAR; dSP; dMARK;
-    I32 cxix;
     register PERL_CONTEXT *cx;
     bool popsub2 = FALSE;
     bool clear_errsv = FALSE;
@@ -1947,24 +1931,34 @@ PP(pp_return)
     SV *sv;
     OP *retop;
 
-    if (PL_curstackinfo->si_type == PERLSI_SORT) {
-	if (cxstack_ix == PL_sortcxix
-	    || dopoptosub(cxstack_ix) <= PL_sortcxix)
-	{
-	    if (cxstack_ix > PL_sortcxix)
-		dounwind(PL_sortcxix);
-	    AvARRAY(PL_curstack)[1] = *SP;
+    const I32 cxix = dopoptosub(cxstack_ix);
+
+    if (cxix < 0) {
+	if (CxMULTICALL(cxstack)) { /* In this case we must be in a
+				     * sort block, which is a CXt_NULL
+				     * not a CXt_SUB */
+	    dounwind(0);
+	    PL_stack_base[1] = *PL_stack_sp;
 	    PL_stack_sp = PL_stack_base + 1;
 	    return 0;
 	}
+	else
+	    DIE(aTHX_ "Can't return outside a subroutine");
     }
-
-    cxix = dopoptosub(cxstack_ix);
-    if (cxix < 0)
-	DIE(aTHX_ "Can't return outside a subroutine");
     if (cxix < cxstack_ix)
 	dounwind(cxix);
 
+    if (CxMULTICALL(&cxstack[cxix])) {
+	gimme = cxstack[cxix].blk_gimme;
+	if (gimme == G_VOID)
+	    PL_stack_sp = PL_stack_base;
+	else if (gimme == G_SCALAR) {
+	    PL_stack_base[1] = *PL_stack_sp;
+	    PL_stack_sp = PL_stack_base + 1;
+	}
+	return 0;
+    }
+
     POPBLOCK(cx,newpm);
     switch (CxTYPE(cx)) {
     case CXt_SUB:
@@ -2039,7 +2033,7 @@ PP(pp_return)
 	POPSUB(cx,sv);	/* release CV and @_ ... */
     }
     else
-	sv = Nullsv;
+	sv = NULL;
     PL_curpm = newpm;	/* ... and pop $1 et al */
 
     LEAVESUB(sv);
@@ -2060,7 +2054,7 @@ PP(pp_last)
     SV **newsp;
     PMOP *newpm;
     SV **mark;
-    SV *sv = Nullsv;
+    SV *sv = NULL;
 
 
     if (PL_op->op_flags & OPf_SPECIAL) {
@@ -2209,7 +2203,6 @@ PP(pp_redo)
 STATIC OP *
 S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
 {
-    OP *kid = Nullop;
     OP **ops = opstack;
     static const char too_deep[] = "Target of goto is too deeply nested";
 
@@ -2227,6 +2220,7 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
     }
     *ops = 0;
     if (o->op_flags & OPf_KIDS) {
+	OP *kid;
 	/* First try all the kids at this level, since that's likeliest. */
 	for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
 	    if ((kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) &&
@@ -2253,12 +2247,6 @@ S_dofindlabel(pTHX_ OP *o, const char *label, OP **opstack, OP **oplimit)
     return 0;
 }
 
-PP(pp_dump)
-{
-    return pp_goto();
-    /*NOTREACHED*/
-}
-
 PP(pp_goto)
 {
     dVAR; dSP;
@@ -2298,7 +2286,7 @@ PP(pp_goto)
 		    if (autogv && (cv = GvCV(autogv)))
 			goto retry;
 		    tmpstr = sv_newmortal();
-		    gv_efullname3(tmpstr, gv, Nullch);
+		    gv_efullname3(tmpstr, gv, NULL);
 		    DIE(aTHX_ "Goto undefined subroutine &%"SVf"",tmpstr);
 		}
 		DIE(aTHX_ "Goto undefined subroutine");
@@ -2321,6 +2309,8 @@ PP(pp_goto)
 		else
 		    DIE(aTHX_ "Can't goto subroutine from an eval-block");
 	    }
+	    else if (CxMULTICALL(cx))
+		DIE(aTHX_ "Can't goto subroutine from a sort sub (or similar callback)");
 	    if (CxTYPE(cx) == CXt_SUB && cx->blk_sub.hasargs) {
 		/* put @_ back onto stack */
 		AV* av = cx->blk_sub.argarray;
@@ -2342,8 +2332,7 @@ PP(pp_goto)
 		}
 	    }
 	    else if (CvXSUB(cv)) {	/* put GvAV(defgv) back onto stack */
-		AV* av;
-		av = GvAV(PL_defgv);
+		AV* const av = GvAV(PL_defgv);
 		items = AvFILLp(av) + 1;
 		EXTEND(SP, items+1); /* @_ could have been extended. */
 		Copy(AvARRAY(av), SP + 1, items, SV*);
@@ -2417,7 +2406,8 @@ PP(pp_goto)
 			sub_crush_depth(cv);
 		    pad_push(padlist, CvDEPTH(cv));
 		}
-		PAD_SET_CUR(padlist, CvDEPTH(cv));
+		SAVECOMPPAD();
+		PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
 		if (cx->blk_sub.hasargs)
 		{
 		    AV* av = (AV*)PAD_SVl(0);
@@ -2461,18 +2451,18 @@ PP(pp_goto)
 		     * We do not care about using sv to call CV;
 		     * it's for informational purposes only.
 		     */
-		    SV *sv = GvSV(PL_DBsub);
+		    SV * const sv = GvSV(PL_DBsub);
 		    CV *gotocv;
 
 		    save_item(sv);
 		    if (PERLDB_SUB_NN) {
-			int type = SvTYPE(sv);
+			const int type = SvTYPE(sv);
 			if (type < SVt_PVIV && type != SVt_IV)
 			    sv_upgrade(sv, SVt_PVIV);
 			(void)SvIOK_on(sv);
 			SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
 		    } else {
-			gv_efullname3(sv, CvGV(cv), Nullch);
+			gv_efullname3(sv, CvGV(cv), NULL);
 		    }
 		    if (  PERLDB_GOTO
 			  && (gotocv = get_cv("DB::goto", FALSE)) ) {
@@ -2533,7 +2523,7 @@ PP(pp_goto)
 		    gotoprobe = PL_main_root;
 		break;
 	    case CXt_SUB:
-		if (CvDEPTH(cx->blk_sub.cv)) {
+		if (CvDEPTH(cx->blk_sub.cv) && !CxMULTICALL(cx)) {
 		    gotoprobe = CvROOT(cx->blk_sub.cv);
 		    break;
 		}
@@ -2585,7 +2575,7 @@ PP(pp_goto)
 	/* push wanted frames */
 
 	if (*enterops && enterops[1]) {
-	    OP *oldop = PL_op;
+	    OP * const oldop = PL_op;
 	    ix = enterops[1]->op_type == OP_ENTER && in_block ? 2 : 1;
 	    for (; enterops[ix]; ix++) {
 		PL_op = enterops[ix];
@@ -2682,12 +2672,12 @@ STATIC void
 S_save_lines(pTHX_ AV *array, SV *sv)
 {
     const char *s = SvPVX_const(sv);
-    const char *send = SvPVX_const(sv) + SvCUR(sv);
+    const char * const send = SvPVX_const(sv) + SvCUR(sv);
     I32 line = 1;
 
     while (s && s < send) {
 	const char *t;
-	SV *tmpstr = NEWSV(85,0);
+	SV * const tmpstr = NEWSV(85,0);
 
 	sv_upgrade(tmpstr, SVt_PVMG);
 	t = strchr(s, '\n');
@@ -2765,10 +2755,11 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
 /* startop op_free() this to undo. */
 /* code Short string id of the caller. */
 {
+    /* FIXME - how much of this code is common with pp_entereval?  */
     dVAR; dSP;				/* Make POPBLOCK work. */
     PERL_CONTEXT *cx;
     SV **newsp;
-    I32 gimme;
+    I32 gimme = G_VOID;
     I32 optype;
     OP dummy;
     OP *rop;
@@ -2777,6 +2768,7 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
     char *safestr;
     int runtime;
     CV* runcv = Nullcv;	/* initialise to avoid compiler warnings */
+    STRLEN len;
 
     ENTER;
     lex_start(sv);
@@ -2793,9 +2785,11 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
 		       code, (unsigned long)++PL_evalseq,
 		       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
 	tmpbuf = SvPVX(sv);
+	len = SvCUR(sv);
     }
     else
-	sprintf(tmpbuf, "_<(%.10s_eval %lu)", code, (unsigned long)++PL_evalseq);
+	len = my_sprintf(tmpbuf, "_<(%.10s_eval %lu)", code,
+			 (unsigned long)++PL_evalseq);
     SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
     SAVECOPLINE(&PL_compiling);
@@ -2805,8 +2799,8 @@ Perl_sv_compile_2op(pTHX_ SV *sv, OP** startop, const char *code, PAD** padp)
        (i.e. before run-time proper). To work around the coredump that
        ensues, we always turn GvMULTI_on for any globals that were
        introduced within evals. See force_ident(). GSAR 96-10-12 */
-    safestr = savepv(tmpbuf);
-    SAVEDELETE(PL_defstash, safestr, strlen(safestr));
+    safestr = savepvn(tmpbuf, len);
+    SAVEDELETE(PL_defstash, safestr, len);
     SAVEHINTS();
 #ifdef OP_IN_REGISTER
     PL_opsave = op;
@@ -2857,7 +2851,7 @@ Locate the CV corresponding to the currently executing sub or eval.
 If db_seqp is non_null, skip CVs that are in the DB package and populate
 *db_seqp with the cop sequence number at the point that the DB:: code was
 entered. (allows debuggers to eval in the scope of the breakpoint rather
-than in in the scope of the debugger itself).
+than in the scope of the debugger itself).
 
 =cut
 */
@@ -2901,7 +2895,7 @@ STATIC OP *
 S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 {
     dVAR; dSP;
-    OP *saveop = PL_op;
+    OP * const saveop = PL_op;
 
     PL_in_eval = ((saveop && saveop->op_type == OP_REQUIRE)
 		  ? (EVAL_INREQUIRE | (PL_in_eval & EVAL_INEVAL))
@@ -3013,7 +3007,7 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 
     /* Register with debugger: */
     if (PERLDB_INTER && saveop->op_type == OP_REQUIRE) {
-	CV *cv = get_cv("DB::postponed", FALSE);
+	CV * const cv = get_cv("DB::postponed", FALSE);
 	if (cv) {
 	    dSP;
 	    PUSHMARK(SP);
@@ -3034,6 +3028,22 @@ S_doeval(pTHX_ int gimme, OP** startop, CV* outside, U32 seq)
 }
 
 STATIC PerlIO *
+S_check_type_and_open(pTHX_ const char *name, const char *mode)
+{
+    Stat_t st;
+    const int st_rc = PerlLIO_stat(name, &st);
+    if (st_rc < 0) {
+       return Nullfp;
+    }
+
+    if(S_ISDIR(st.st_mode) || S_ISBLK(st.st_mode)) {
+       Perl_die(aTHX_ "%s %s not allowed in require",
+           S_ISDIR(st.st_mode) ? "Directory" : "Block device", name);
+    }
+    return PerlIO_open(name, mode);
+}
+
+STATIC PerlIO *
 S_doopen_pm(pTHX_ const char *name, const char *mode)
 {
 #ifndef PERL_DISABLE_PMC
@@ -3045,27 +3055,27 @@ S_doopen_pm(pTHX_ const char *name, const char *mode)
 	const char * const pmc = SvPV_nolen_const(pmcsv);
 	Stat_t pmcstat;
 	if (PerlLIO_stat(pmc, &pmcstat) < 0) {
-	    fp = PerlIO_open(name, mode);
+	    fp = check_type_and_open(name, mode);
 	}
 	else {
 	    Stat_t pmstat;
 	    if (PerlLIO_stat(name, &pmstat) < 0 ||
 	        pmstat.st_mtime < pmcstat.st_mtime)
 	    {
-		fp = PerlIO_open(pmc, mode);
+		fp = check_type_and_open(pmc, mode);
 	    }
 	    else {
-		fp = PerlIO_open(name, mode);
+		fp = check_type_and_open(name, mode);
 	    }
 	}
 	SvREFCNT_dec(pmcsv);
     }
     else {
-	fp = PerlIO_open(name, mode);
+	fp = check_type_and_open(name, mode);
     }
     return fp;
 #else
-    return PerlIO_open(name, mode);
+    return check_type_and_open(name, mode);
 #endif /* !PERL_DISABLE_PMC */
 }
 
@@ -3076,16 +3086,15 @@ PP(pp_require)
     SV *sv;
     const char *name;
     STRLEN len;
-    const char *tryname = Nullch;
-    SV *namesv = Nullsv;
-    SV** svp;
+    const char *tryname = NULL;
+    SV *namesv = NULL;
     const I32 gimme = GIMME_V;
-    PerlIO *tryrsfp = 0;
     int filter_has_file = 0;
-    GV *filter_child_proc = 0;
-    SV *filter_state = 0;
-    SV *filter_sub = 0;
-    SV *hook_sv = 0;
+    PerlIO *tryrsfp = NULL;
+    GV *filter_child_proc = NULL;
+    SV *filter_state = NULL;
+    SV *filter_sub = NULL;
+    SV *hook_sv = NULL;
     SV *encoding;
     OP *op;
 
@@ -3098,9 +3107,16 @@ PP(pp_require)
 	sv = new_version(sv);
 	if (!sv_derived_from(PL_patchlevel, "version"))
 	    (void *)upg_version(PL_patchlevel);
-	if ( vcmp(sv,PL_patchlevel) > 0 )
-	    DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped",
-		vnormal(sv), vnormal(PL_patchlevel));
+	if (cUNOP->op_first->op_type == OP_CONST && cUNOP->op_first->op_private & OPpCONST_NOVER) {
+	    if ( vcmp(sv,PL_patchlevel) < 0 )
+		DIE(aTHX_ "Perls since %"SVf" too modern--this is %"SVf", stopped",
+		    vnormal(sv), vnormal(PL_patchlevel));
+	}
+	else {
+	    if ( vcmp(sv,PL_patchlevel) > 0 )
+		DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped",
+		    vnormal(sv), vnormal(PL_patchlevel));
+	}
 
 	    RETPUSHYES;
     }
@@ -3108,12 +3124,14 @@ PP(pp_require)
     if (!(name && len > 0 && *name))
 	DIE(aTHX_ "Null filename used");
     TAINT_PROPER("require");
-    if (PL_op->op_type == OP_REQUIRE &&
-       (svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
-       if (*svp != &PL_sv_undef)
-           RETPUSHYES;
-       else
-           DIE(aTHX_ "Compilation failed in require");
+    if (PL_op->op_type == OP_REQUIRE) {
+	SV * const * const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+	if ( svp ) {
+	    if (*svp != &PL_sv_undef)
+		RETPUSHYES;
+	    else
+		DIE(aTHX_ "Compilation failed in require");
+	}
     }
 
     /* prepare to compile file */
@@ -3134,11 +3152,11 @@ PP(pp_require)
     }
 #endif
     if (!tryrsfp) {
-	AV *ar = GvAVn(PL_incgv);
+	AV * const ar = GvAVn(PL_incgv);
 	I32 i;
 #ifdef VMS
 	char *unixname;
-	if ((unixname = tounixspec(name, Nullch)) != Nullch)
+	if ((unixname = tounixspec(name, NULL)) != NULL)
 #endif
 	{
 	    namesv = NEWSV(806, 0);
@@ -3158,7 +3176,7 @@ PP(pp_require)
 		    Perl_sv_setpvf(aTHX_ namesv, "/loader/0x%"UVxf"/%s",
 				   PTR2UV(SvRV(dirsv)), name);
 		    tryname = SvPVX_const(namesv);
-		    tryrsfp = 0;
+		    tryrsfp = NULL;
 
 		    ENTER;
 		    SAVETMPS;
@@ -3225,9 +3243,8 @@ PP(pp_require)
 				(void)SvREFCNT_inc(filter_state);
 			    }
 
-			    if (tryrsfp == 0) {
-				tryrsfp = PerlIO_open("/dev/null",
-						      PERL_SCRIPT_MODE);
+			    if (!tryrsfp) {
+				tryrsfp = PerlIO_open("/dev/null", PERL_SCRIPT_MODE);
 			    }
 			}
 			SP--;
@@ -3245,15 +3262,15 @@ PP(pp_require)
 		    filter_has_file = 0;
 		    if (filter_child_proc) {
 			SvREFCNT_dec(filter_child_proc);
-			filter_child_proc = 0;
+			filter_child_proc = NULL;
 		    }
 		    if (filter_state) {
 			SvREFCNT_dec(filter_state);
-			filter_state = 0;
+			filter_state = NULL;
 		    }
 		    if (filter_sub) {
 			SvREFCNT_dec(filter_sub);
-			filter_sub = 0;
+			filter_sub = NULL;
 		    }
 		}
 		else {
@@ -3275,12 +3292,12 @@ PP(pp_require)
 #else
 #  ifdef VMS
 		    char *unixdir;
-		    if ((unixdir = tounixpath(dir, Nullch)) == Nullch)
+		    if ((unixdir = tounixpath(dir, NULL)) == NULL)
 			continue;
 		    sv_setpv(namesv, unixdir);
 		    sv_catpv(namesv, unixname);
 #  else
-#    ifdef SYMBIAN
+#    ifdef __SYMBIAN32__
 		    if (PL_origfilename[0] &&
 			PL_origfilename[1] == ':' &&
 			!(dir[0] && dir[1] == ':'))
@@ -3316,25 +3333,31 @@ PP(pp_require)
     if (!tryrsfp) {
 	if (PL_op->op_type == OP_REQUIRE) {
 	    const char *msgstr = name;
-	    if (namesv) {			/* did we lookup @INC? */
-		SV *msg = sv_2mortal(newSVpv(msgstr,0));
-		SV *dirmsgsv = NEWSV(0, 0);
-		AV *ar = GvAVn(PL_incgv);
-		I32 i;
-		sv_catpvn(msg, " in @INC", 8);
-		if (instr(SvPVX_const(msg), ".h "))
-		    sv_catpv(msg, " (change .h to .ph maybe?)");
-		if (instr(SvPVX_const(msg), ".ph "))
-		    sv_catpv(msg, " (did you run h2ph?)");
-		sv_catpv(msg, " (@INC contains:");
-		for (i = 0; i <= AvFILL(ar); i++) {
-		    const char *dir = SvPVx_nolen_const(*av_fetch(ar, i, TRUE));
-		    Perl_sv_setpvf(aTHX_ dirmsgsv, " %s", dir);
-		    sv_catsv(msg, dirmsgsv);
-		}
-		sv_catpvn(msg, ")", 1);
-		SvREFCNT_dec(dirmsgsv);
+	    if(errno == EMFILE) {
+		SV * const msg
+		    = sv_2mortal(Perl_newSVpvf(aTHX_ "%s:   %s", msgstr,
+					       Strerror(errno)));
 		msgstr = SvPV_nolen_const(msg);
+	    } else {
+	        if (namesv) {			/* did we lookup @INC? */
+		    AV * const ar = GvAVn(PL_incgv);
+		    I32 i;
+		    SV * const msg = sv_2mortal(Perl_newSVpvf(aTHX_ 
+			"%s in @INC%s%s (@INC contains:",
+			msgstr,
+			(instr(msgstr, ".h ")
+			 ? " (change .h to .ph maybe?)" : ""),
+			(instr(msgstr, ".ph ")
+			 ? " (did you run h2ph?)" : "")
+							      ));
+		    
+		    for (i = 0; i <= AvFILL(ar); i++) {
+			sv_catpvn(msg, " ", 1);
+			sv_catsv(msg, *av_fetch(ar, i, TRUE));
+		    }
+		    sv_catpvn(msg, ")", 1);
+		    msgstr = SvPV_nolen_const(msg);
+		}    
 	    }
 	    DIE(aTHX_ "Can't locate %s", msgstr);
 	}
@@ -3345,20 +3368,21 @@ PP(pp_require)
 	SETERRNO(0, SS_NORMAL);
 
     /* Assume success here to prevent recursive requirement. */
-    len = strlen(name);
+    /* name is never assigned to again, so len is still strlen(name)  */
     /* Check whether a hook in @INC has already filled %INC */
-    if (!hook_sv || !(svp = hv_fetch(GvHVn(PL_incgv), name, len, 0))) {
-	(void)hv_store(GvHVn(PL_incgv), name, len,
-		       (hook_sv ? SvREFCNT_inc(hook_sv)
-				: newSVpv(CopFILE(&PL_compiling), 0)),
-		       0 );
+    if (!hook_sv) {
+	(void)hv_store(GvHVn(PL_incgv), name, len, newSVpv(CopFILE(&PL_compiling),0),0);
+    } else {
+	SV** const svp = hv_fetch(GvHVn(PL_incgv), name, len, 0);
+	if (!svp)
+	    (void)hv_store(GvHVn(PL_incgv), name, len, SvREFCNT_inc(hook_sv), 0 );
     }
 
     ENTER;
     SAVETMPS;
     lex_start(sv_2mortal(newSVpvn("",0)));
     SAVEGENERICSV(PL_rsfp_filters);
-    PL_rsfp_filters = Nullav;
+    PL_rsfp_filters = NULL;
 
     PL_rsfp = tryrsfp;
     SAVEHINTS();
@@ -3373,10 +3397,10 @@ PP(pp_require)
     else
         PL_compiling.cop_warnings = pWARN_STD ;
     SAVESPTR(PL_compiling.cop_io);
-    PL_compiling.cop_io = Nullsv;
+    PL_compiling.cop_io = NULL;
 
     if (filter_sub || filter_child_proc) {
-	SV *datasv = filter_add(run_user_filter, Nullsv);
+	SV * const datasv = filter_add(S_run_user_filter, NULL);
 	IoLINES(datasv) = filter_has_file;
 	IoFMT_GV(datasv) = (GV *)filter_child_proc;
 	IoTOP_GV(datasv) = (GV *)filter_state;
@@ -3395,7 +3419,7 @@ PP(pp_require)
 
     /* Store and reset encoding. */
     encoding = PL_encoding;
-    PL_encoding = Nullsv;
+    PL_encoding = NULL;
 
     op = DOCATCH(doeval(gimme, NULL, Nullcv, PL_curcop->cop_seq));
 
@@ -3405,17 +3429,13 @@ PP(pp_require)
     return op;
 }
 
-PP(pp_dofile)
-{
-    return pp_require();
-}
-
 PP(pp_entereval)
 {
     dVAR; dSP;
     register PERL_CONTEXT *cx;
-    dPOPss;
-    const I32 gimme = GIMME_V, was = PL_sub_generation;
+    SV *sv;
+    const I32 gimme = GIMME_V;
+    const I32 was = PL_sub_generation;
     char tbuf[TYPE_DIGITS(long) + 12];
     char *tmpbuf = tbuf;
     char *safestr;
@@ -3423,8 +3443,14 @@ PP(pp_entereval)
     OP *ret;
     CV* runcv;
     U32 seq;
+    HV *saved_hh = NULL;
+    
+    if (PL_op->op_private & OPpEVAL_HAS_HH) {
+	saved_hh = (HV*) SvREFCNT_inc(POPs);
+    }
+    sv = POPs;
 
-    if (!SvPV_const(sv,len))
+    if (!SvPV_nolen_const(sv))
 	RETPUSHUNDEF;
     TAINT_PROPER("eval");
 
@@ -3435,14 +3461,15 @@ PP(pp_entereval)
     /* switch to eval mode */
 
     if (PERLDB_NAMEEVAL && CopLINE(PL_curcop)) {
-	SV *sv = sv_newmortal();
+	SV * const sv = sv_newmortal();
 	Perl_sv_setpvf(aTHX_ sv, "_<(eval %lu)[%s:%"IVdf"]",
 		       (unsigned long)++PL_evalseq,
 		       CopFILE(PL_curcop), (IV)CopLINE(PL_curcop));
 	tmpbuf = SvPVX(sv);
+	len = SvCUR(sv);
     }
     else
-	sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
+	len = my_sprintf(tmpbuf, "_<(eval %lu)", (unsigned long)++PL_evalseq);
     SAVECOPFILE_FREE(&PL_compiling);
     CopFILE_set(&PL_compiling, tmpbuf+2);
     SAVECOPLINE(&PL_compiling);
@@ -3452,10 +3479,12 @@ PP(pp_entereval)
        (i.e. before run-time proper). To work around the coredump that
        ensues, we always turn GvMULTI_on for any globals that were
        introduced within evals. See force_ident(). GSAR 96-10-12 */
-    safestr = savepv(tmpbuf);
-    SAVEDELETE(PL_defstash, safestr, strlen(safestr));
+    safestr = savepvn(tmpbuf, len);
+    SAVEDELETE(PL_defstash, safestr, len);
     SAVEHINTS();
     PL_hints = PL_op->op_targ;
+    if (saved_hh)
+	GvHV(PL_hintgv) = saved_hh;
     SAVESPTR(PL_compiling.cop_warnings);
     if (specialWARN(PL_curcop->cop_warnings))
         PL_compiling.cop_warnings = PL_curcop->cop_warnings;
@@ -3584,7 +3613,6 @@ PP(pp_entertry)
 PP(pp_leavetry)
 {
     dVAR; dSP;
-    register SV **mark;
     SV **newsp;
     PMOP *newpm;
     I32 gimme;
@@ -3599,6 +3627,7 @@ PP(pp_leavetry)
     if (gimme == G_VOID)
 	SP = newsp;
     else if (gimme == G_SCALAR) {
+	register SV **mark;
 	MARK = newsp + 1;
 	if (MARK <= SP) {
 	    if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
@@ -3614,6 +3643,7 @@ PP(pp_leavetry)
     }
     else {
 	/* in case LEAVE wipes old return values */
+	register SV **mark;
 	for (mark = newsp + 1; mark <= SP; mark++) {
 	    if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP))) {
 		*mark = sv_mortalcopy(*mark);
@@ -3628,13 +3658,617 @@ PP(pp_leavetry)
     RETURN;
 }
 
+PP(pp_entergiven)
+{
+    dVAR; dSP;
+    register PERL_CONTEXT *cx;
+    const I32 gimme = GIMME_V;
+    
+    ENTER;
+    SAVETMPS;
+
+    if (PL_op->op_targ == 0) {
+	SV ** const defsv_p = &GvSV(PL_defgv);
+	*defsv_p = newSVsv(POPs);
+	SAVECLEARSV(*defsv_p);
+    }
+    else
+    	sv_setsv(PAD_SV(PL_op->op_targ), POPs);
+
+    PUSHBLOCK(cx, CXt_GIVEN, SP);
+    PUSHGIVEN(cx);
+
+    RETURN;
+}
+
+PP(pp_leavegiven)
+{
+    dVAR; dSP;
+    register PERL_CONTEXT *cx;
+    I32 gimme;
+    SV **newsp;
+    PMOP *newpm;
+    SV **mark;
+
+    POPBLOCK(cx,newpm);
+    assert(CxTYPE(cx) == CXt_GIVEN);
+    mark = newsp;
+
+    SP = newsp;
+    PUTBACK;
+
+    PL_curpm = newpm;   /* pop $1 et al */
+
+    LEAVE;
+
+    return NORMAL;
+}
+
+/* Helper routines used by pp_smartmatch */
+STATIC
+PMOP *
+S_make_matcher(pTHX_ regexp *re)
+{
+    PMOP *matcher = (PMOP *) newPMOP(OP_MATCH, OPf_WANT_SCALAR | OPf_STACKED);
+    PM_SETRE(matcher, ReREFCNT_inc(re));
+    
+    SAVEFREEOP((OP *) matcher);
+    ENTER; SAVETMPS;
+    SAVEOP();
+    return matcher;
+}
+
+STATIC
+bool
+S_matcher_matches_sv(pTHX_ PMOP *matcher, SV *sv)
+{
+    dSP;
+    
+    PL_op = (OP *) matcher;
+    XPUSHs(sv);
+    PUTBACK;
+    (void) pp_match();
+    SPAGAIN;
+    return (SvTRUEx(POPs));
+}
+
+STATIC
+void
+S_destroy_matcher(pTHX_ PMOP *matcher)
+{
+    PERL_UNUSED_ARG(matcher);
+    FREETMPS;
+    LEAVE;
+}
+
+/* Do a smart match */
+PP(pp_smartmatch)
+{
+    return do_smartmatch(Nullhv, Nullhv);
+}
+
+/* This version of do_smartmatch() implements the following
+   table of smart matches:
+    
+    $a      $b        Type of Match Implied    Matching Code
+    ======  =====     =====================    =============
+    (overloading trumps everything)
+
+    Code[+] Code[+]   referential equality     match if refaddr($a) == refaddr($b)
+    Any     Code[+]   scalar sub truth         match if $b->($a)
+
+    Hash    Hash      hash keys identical      match if sort(keys(%$a)) ÈeqÇ sort(keys(%$b))
+    Hash    Array     hash value slice truth   match if $a->{any(@$b)}
+    Hash    Regex     hash key grep            match if any(keys(%$a)) =~ /$b/
+    Hash    Any       hash entry existence     match if exists $a->{$b}
+
+    Array   Array     arrays are identical[*]  match if $a È~~Ç $b
+    Array   Regex     array grep               match if any(@$a) =~ /$b/
+    Array   Num       array contains number    match if any($a) == $b
+    Array   Any       array contains string    match if any($a) eq $b
+
+    Any     undef     undefined                match if !defined $a
+    Any     Regex     pattern match            match if $a =~ /$b/
+    Code()  Code()    results are equal        match if $a->() eq $b->()
+    Any     Code()    simple closure truth     match if $b->() (ignoring $a)
+    Num     numish[!] numeric equality         match if $a == $b
+    Any     Str       string equality          match if $a eq $b
+    Any     Num       numeric equality         match if $a == $b
+
+    Any     Any       string equality          match if $a eq $b
+
+
+ + - this must be a code reference whose prototype (if present) is not ""
+     (subs with a "" prototype are dealt with by the 'Code()' entry lower down)
+ * - if a circular reference is found, we fall back to referential equality
+ ! - either a real number, or a string that looks_like_number()
+
+ */
+STATIC
+OP *
+S_do_smartmatch(pTHX_ HV *seen_this, HV *seen_other)
+{
+    dSP;
+    
+    SV *e = TOPs;	/* e is for 'expression' */
+    SV *d = TOPm1s;	/* d is for 'default', as in PL_defgv */
+    SV *this, *other;
+    MAGIC *mg;
+    regexp *this_regex, *other_regex;
+
+#   define NOT_EMPTY_PROTO(cv) (!SvPOK(cv) || SvCUR(cv) == 0)
+
+#   define SM_REF(type) ( \
+	   (SvROK(d) && (SvTYPE(this = SvRV(d)) == SVt_##type) && (other = e)) \
+	|| (SvROK(e) && (SvTYPE(this = SvRV(e)) == SVt_##type) && (other = d)))
+
+#   define SM_CV_NEP   /* Find a code ref without an empty prototype */ \
+	((SvROK(d) && (SvTYPE(this = SvRV(d)) == SVt_PVCV)		\
+	    && NOT_EMPTY_PROTO(this) && (other = e))			\
+	|| (SvROK(e) && (SvTYPE(this = SvRV(e)) == SVt_PVCV)		\
+	    && NOT_EMPTY_PROTO(this) && (other = d)))
+
+#   define SM_REGEX ( \
+	   (SvROK(d) && SvMAGICAL(this = SvRV(d))			\
+	&& (mg = mg_find(this, PERL_MAGIC_qr))				\
+	&& (this_regex = (regexp *)mg->mg_obj)				\
+	&& (other = e))							\
+    ||									\
+	   (SvROK(e) && SvMAGICAL(this = SvRV(e))			\
+	&& (mg = mg_find(this, PERL_MAGIC_qr))				\
+	&& (this_regex = (regexp *)mg->mg_obj)				\
+	&& (other = d))	)
+	
+
+#   define SM_OTHER_REF(type) \
+	(SvROK(other) && SvTYPE(SvRV(other)) == SVt_##type)
+
+#   define SM_OTHER_REGEX (SvROK(other) && SvMAGICAL(SvRV(other))	\
+	&& (mg = mg_find(SvRV(other), PERL_MAGIC_qr))			\
+	&& (other_regex = (regexp *)mg->mg_obj))
+	
+
+#   define SM_SEEN_THIS(sv) hv_exists_ent(seen_this, \
+	sv_2mortal(newSViv(PTR2IV(sv))), 0)
+
+#   define SM_SEEN_OTHER(sv) hv_exists_ent(seen_other, \
+	sv_2mortal(newSViv(PTR2IV(sv))), 0)
+
+    tryAMAGICbinSET(smart, 0);
+    
+    SP -= 2;	/* Pop the values */
+
+    /* Take care only to invoke mg_get() once for each argument. 
+     * Currently we do this by copying the SV if it's magical. */
+    if (d) {
+	if (SvGMAGICAL(d))
+	    d = sv_mortalcopy(d);
+    }
+    else
+	d = &PL_sv_undef;
+
+    assert(e);
+    if (SvGMAGICAL(e))
+	e = sv_mortalcopy(e);
+
+    if (SM_CV_NEP) {
+	I32 c;
+	
+	if ( SM_OTHER_REF(PVCV) && NOT_EMPTY_PROTO(SvRV(other)) )
+	{
+	    if (this == SvRV(other))
+		RETPUSHYES;
+	    else
+		RETPUSHNO;
+	}
+	
+	ENTER;
+	SAVETMPS;
+	PUSHMARK(SP);
+	PUSHs(other);
+	PUTBACK;
+	c = call_sv(this, G_SCALAR);
+	SPAGAIN;
+	if (c == 0)
+	    PUSHs(&PL_sv_no);
+	else if (SvTEMP(TOPs))
+	    SvREFCNT_inc(TOPs);
+	FREETMPS;
+	LEAVE;
+	RETURN;
+    }
+    else if (SM_REF(PVHV)) {
+	if (SM_OTHER_REF(PVHV)) {
+	    /* Check that the key-sets are identical */
+	    HE *he;
+	    HV *other_hv = (HV *) SvRV(other);
+	    bool tied = FALSE;
+	    bool other_tied = FALSE;
+	    U32 this_key_count  = 0,
+	        other_key_count = 0;
+	    
+	    /* Tied hashes don't know how many keys they have. */
+	    if (SvTIED_mg(this, PERL_MAGIC_tied)) {
+		tied = TRUE;
+	    }
+	    else if (SvTIED_mg((SV *) other_hv, PERL_MAGIC_tied)) {
+		HV * const temp = other_hv;
+		other_hv = (HV *) this;
+		this  = (SV *) temp;
+		tied = TRUE;
+	    }
+	    if (SvTIED_mg((SV *) other_hv, PERL_MAGIC_tied))
+		other_tied = TRUE;
+	    
+	    if (!tied && HvUSEDKEYS((HV *) this) != HvUSEDKEYS(other_hv))
+	    	RETPUSHNO;
+
+	    /* The hashes have the same number of keys, so it suffices
+	       to check that one is a subset of the other. */
+	    (void) hv_iterinit((HV *) this);
+	    while ( (he = hv_iternext((HV *) this)) ) {
+	    	I32 key_len;
+		char * const key = hv_iterkey(he, &key_len);
+	    	
+	    	++ this_key_count;
+	    	
+	    	if(!hv_exists(other_hv, key, key_len)) {
+	    	    (void) hv_iterinit((HV *) this);	/* reset iterator */
+		    RETPUSHNO;
+	    	}
+	    }
+	    
+	    if (other_tied) {
+		(void) hv_iterinit(other_hv);
+		while ( hv_iternext(other_hv) )
+		    ++other_key_count;
+	    }
+	    else
+		other_key_count = HvUSEDKEYS(other_hv);
+	    
+	    if (this_key_count != other_key_count)
+		RETPUSHNO;
+	    else
+		RETPUSHYES;
+	}
+	else if (SM_OTHER_REF(PVAV)) {
+	    AV * const other_av = (AV *) SvRV(other);
+	    const I32 other_len = av_len(other_av) + 1;
+	    I32 i;
+	    
+	    if (HvUSEDKEYS((HV *) this) != other_len)
+		RETPUSHNO;
+	    
+	    for(i = 0; i < other_len; ++i) {
+		SV ** const svp = av_fetch(other_av, i, FALSE);
+		char *key;
+		STRLEN key_len;
+
+		if (!svp)	/* ??? When can this happen? */
+		    RETPUSHNO;
+
+		key = SvPV(*svp, key_len);
+	    	if(!hv_exists((HV *) this, key, key_len))
+		    RETPUSHNO;
+	    }
+	    RETPUSHYES;
+	}
+	else if (SM_OTHER_REGEX) {
+	    PMOP * const matcher = make_matcher(other_regex);
+	    HE *he;
+
+	    (void) hv_iterinit((HV *) this);
+	    while ( (he = hv_iternext((HV *) this)) ) {
+		if (matcher_matches_sv(matcher, hv_iterkeysv(he))) {
+		    (void) hv_iterinit((HV *) this);
+		    destroy_matcher(matcher);
+		    RETPUSHYES;
+		}
+	    }
+	    destroy_matcher(matcher);
+	    RETPUSHNO;
+	}
+	else {
+	    if (hv_exists_ent((HV *) this, other, 0))
+		RETPUSHYES;
+	    else
+		RETPUSHNO;
+	}
+    }
+    else if (SM_REF(PVAV)) {
+	if (SM_OTHER_REF(PVAV)) {
+	    AV *other_av = (AV *) SvRV(other);
+	    if (av_len((AV *) this) != av_len(other_av))
+		RETPUSHNO;
+	    else {
+	    	I32 i;
+	    	const I32 other_len = av_len(other_av);
+
+		if (Nullhv == seen_this) {
+		    seen_this = newHV();
+		    (void) sv_2mortal((SV *) seen_this);
+		}
+		if (Nullhv == seen_other) {
+		    seen_this = newHV();
+		    (void) sv_2mortal((SV *) seen_other);
+		}
+		for(i = 0; i <= other_len; ++i) {
+		    SV * const * const this_elem = av_fetch((AV *)this, i, FALSE);
+		    SV * const * const other_elem = av_fetch(other_av, i, FALSE);
+
+		    if (!this_elem || !other_elem) {
+			if (this_elem || other_elem)
+			    RETPUSHNO;
+		    }
+		    else if (SM_SEEN_THIS(*this_elem)
+			 || SM_SEEN_OTHER(*other_elem))
+		    {
+			if (*this_elem != *other_elem)
+			    RETPUSHNO;
+		    }
+		    else {
+			hv_store_ent(seen_this,
+			    sv_2mortal(newSViv(PTR2IV(*this_elem))),
+			    &PL_sv_undef, 0);
+			hv_store_ent(seen_other,
+			    sv_2mortal(newSViv(PTR2IV(*other_elem))),
+			    &PL_sv_undef, 0);
+			PUSHs(*this_elem);
+			PUSHs(*other_elem);
+			
+			PUTBACK;
+			(void) do_smartmatch(seen_this, seen_other);
+			SPAGAIN;
+			
+			if (!SvTRUEx(POPs))
+			    RETPUSHNO;
+		    }
+		}
+		RETPUSHYES;
+	    }
+	}
+	else if (SM_OTHER_REGEX) {
+	    PMOP * const matcher = make_matcher(other_regex);
+	    const I32 this_len = av_len((AV *) this);
+	    I32 i;
+
+	    for(i = 0; i <= this_len; ++i) {
+		SV * const * const svp = av_fetch((AV *)this, i, FALSE);
+		if (svp && matcher_matches_sv(matcher, *svp)) {
+		    destroy_matcher(matcher);
+		    RETPUSHYES;
+		}
+	    }
+	    destroy_matcher(matcher);
+	    RETPUSHNO;
+	}
+	else if (SvIOK(other) || SvNOK(other)) {
+	    I32 i;
+
+	    for(i = 0; i <= AvFILL((AV *) this); ++i) {
+		SV * const * const svp = av_fetch((AV *)this, i, FALSE);
+		if (!svp)
+		    continue;
+		
+		PUSHs(other);
+		PUSHs(*svp);
+		PUTBACK;
+		if ((PL_curcop->op_private & HINT_INTEGER) == HINT_INTEGER)
+		    (void) pp_i_eq();
+		else
+		    (void) pp_eq();
+		SPAGAIN;
+		if (SvTRUEx(POPs))
+		    RETPUSHYES;
+	    }
+	    RETPUSHNO;
+	}
+	else if (SvPOK(other)) {
+	    const I32 this_len = av_len((AV *) this);
+	    I32 i;
+
+	    for(i = 0; i <= this_len; ++i) {
+		SV * const * const svp = av_fetch((AV *)this, i, FALSE);
+		if (!svp)
+		    continue;
+		
+		PUSHs(other);
+		PUSHs(*svp);
+		PUTBACK;
+		(void) pp_seq();
+		SPAGAIN;
+		if (SvTRUEx(POPs))
+		    RETPUSHYES;
+	    }
+	    RETPUSHNO;
+	}
+    }
+    else if (!SvOK(d) || !SvOK(e)) {
+	if (!SvOK(d) && !SvOK(e))
+	    RETPUSHYES;
+	else
+	    RETPUSHNO;
+    }
+    else if (SM_REGEX) {
+	PMOP * const matcher = make_matcher(this_regex);
+
+	PUTBACK;
+	PUSHs(matcher_matches_sv(matcher, other)
+	    ? &PL_sv_yes
+	    : &PL_sv_no);
+	destroy_matcher(matcher);
+	RETURN;
+    }
+    else if (SM_REF(PVCV)) {
+	I32 c;
+	/* This must be a null-prototyped sub, because we
+	   already checked for the other kind. */
+	
+	ENTER;
+	SAVETMPS;
+	PUSHMARK(SP);
+	PUTBACK;
+	c = call_sv(this, G_SCALAR);
+	SPAGAIN;
+	if (c == 0)
+	    PUSHs(&PL_sv_undef);
+	else if (SvTEMP(TOPs))
+	    SvREFCNT_inc(TOPs);
+
+	if (SM_OTHER_REF(PVCV)) {
+	    /* This one has to be null-proto'd too.
+	       Call both of 'em, and compare the results */
+	    PUSHMARK(SP);
+	    c = call_sv(SvRV(other), G_SCALAR);
+	    SPAGAIN;
+	    if (c == 0)
+		PUSHs(&PL_sv_undef);
+	    else if (SvTEMP(TOPs))
+		SvREFCNT_inc(TOPs);
+	    FREETMPS;
+	    LEAVE;
+	    PUTBACK;
+	    return pp_eq();
+	}
+	
+	FREETMPS;
+	LEAVE;
+	RETURN;
+    }
+    else if ( ((SvIOK(d) || SvNOK(d)) && (this = d) && (other = e))
+         ||   ((SvIOK(e) || SvNOK(e)) && (this = e) && (other = d)) )
+    {
+	if (SvPOK(other) && !looks_like_number(other)) {
+	    /* String comparison */
+	    PUSHs(d); PUSHs(e);
+	    PUTBACK;
+	    return pp_seq();
+	}
+	/* Otherwise, numeric comparison */
+	PUSHs(d); PUSHs(e);
+	PUTBACK;
+	if ((PL_curcop->op_private & HINT_INTEGER) == HINT_INTEGER)
+	    (void) pp_i_eq();
+	else
+	    (void) pp_eq();
+	SPAGAIN;
+	if (SvTRUEx(POPs))
+	    RETPUSHYES;
+	else
+	    RETPUSHNO;
+    }
+    
+    /* As a last resort, use string comparison */
+    PUSHs(d); PUSHs(e);
+    PUTBACK;
+    return pp_seq();
+}
+
+PP(pp_enterwhen)
+{
+    dVAR; dSP;
+    register PERL_CONTEXT *cx;
+    const I32 gimme = GIMME_V;
+
+    /* This is essentially an optimization: if the match
+       fails, we don't want to push a context and then
+       pop it again right away, so we skip straight
+       to the op that follows the leavewhen.
+    */
+    if ((0 == (PL_op->op_flags & OPf_SPECIAL)) && !SvTRUEx(POPs))
+	return cLOGOP->op_other->op_next;
+
+    ENTER;
+    SAVETMPS;
+
+    PUSHBLOCK(cx, CXt_WHEN, SP);
+    PUSHWHEN(cx);
+
+    RETURN;
+}
+
+PP(pp_leavewhen)
+{
+    dVAR; dSP;
+    register PERL_CONTEXT *cx;
+    I32 gimme;
+    SV **newsp;
+    PMOP *newpm;
+
+    POPBLOCK(cx,newpm);
+    assert(CxTYPE(cx) == CXt_WHEN);
+
+    SP = newsp;
+    PUTBACK;
+
+    PL_curpm = newpm;   /* pop $1 et al */
+
+    LEAVE;
+    return NORMAL;
+}
+
+PP(pp_continue)
+{
+    dVAR;   
+    I32 cxix;
+    register PERL_CONTEXT *cx;
+    I32 inner;
+    
+    cxix = dopoptowhen(cxstack_ix); 
+    if (cxix < 0)   
+	DIE(aTHX_ "Can't \"continue\" outside a when block");
+    if (cxix < cxstack_ix)
+        dounwind(cxix);
+    
+    /* clear off anything above the scope we're re-entering */
+    inner = PL_scopestack_ix;
+    TOPBLOCK(cx);
+    if (PL_scopestack_ix < inner)
+        leave_scope(PL_scopestack[PL_scopestack_ix]);
+    PL_curcop = cx->blk_oldcop;
+    return cx->blk_givwhen.leave_op;
+}
+
+PP(pp_break)
+{
+    dVAR;   
+    I32 cxix;
+    register PERL_CONTEXT *cx;
+    I32 inner;
+    
+    cxix = dopoptogiven(cxstack_ix); 
+    if (cxix < 0) {
+	if (PL_op->op_flags & OPf_SPECIAL)
+	    DIE(aTHX_ "Can't use when() outside a topicalizer");
+	else
+	    DIE(aTHX_ "Can't \"break\" outside a given block");
+    }
+    if (CxFOREACH(&cxstack[cxix]) && (0 == (PL_op->op_flags & OPf_SPECIAL)))
+	DIE(aTHX_ "Can't \"break\" in a loop topicalizer");
+
+    if (cxix < cxstack_ix)
+        dounwind(cxix);
+    
+    /* clear off anything above the scope we're re-entering */
+    inner = PL_scopestack_ix;
+    TOPBLOCK(cx);
+    if (PL_scopestack_ix < inner)
+        leave_scope(PL_scopestack[PL_scopestack_ix]);
+    PL_curcop = cx->blk_oldcop;
+
+    if (CxFOREACH(cx))
+	return cx->blk_loop.next_op;
+    else
+	return cx->blk_givwhen.leave_op;
+}
+
 STATIC OP *
 S_doparseform(pTHX_ SV *sv)
 {
     STRLEN len;
     register char *s = SvPV_force(sv, len);
-    register char *send = s + len;
-    register char *base = Nullch;
+    register char * const send = s + len;
+    register char *base = NULL;
     register I32 skipspaces = 0;
     bool noblank   = FALSE;
     bool repeat    = FALSE;
@@ -3656,9 +4290,9 @@ S_doparseform(pTHX_ SV *sv)
 	    maxops += 10;
     }
     s = base;
-    base = Nullch;
+    base = NULL;
 
-    New(804, fops, maxops, U32);
+    Newx(fops, maxops, U32);
     fpc = fops;
 
     if (s < send) {
@@ -3837,7 +4471,7 @@ S_doparseform(pTHX_ SV *sv)
     }
     Copy(fops, s, arg, U32);
     Safefree(fops);
-    sv_magic(sv, Nullsv, PERL_MAGIC_fm, Nullch, 0);
+    sv_magic(sv, NULL, PERL_MAGIC_fm, NULL, 0);
     SvCOMPILED_on(sv);
 
     if (unchopnum && repeat)
@@ -3874,14 +4508,14 @@ S_num_overflow(NV value, I32 fldsize, I32 frcsize)
 }
 
 static I32
-run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
+S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
     dVAR;
-    SV *datasv = FILTER_DATA(idx);
+    SV * const datasv = FILTER_DATA(idx);
     const int filter_has_file = IoLINES(datasv);
-    GV *filter_child_proc = (GV *)IoFMT_GV(datasv);
-    SV *filter_state = (SV *)IoTOP_GV(datasv);
-    SV *filter_sub = (SV *)IoBOTTOM_GV(datasv);
+    GV * const filter_child_proc = (GV *)IoFMT_GV(datasv);
+    SV * const filter_state = (SV *)IoTOP_GV(datasv);
+    SV * const filter_sub = (SV *)IoBOTTOM_GV(datasv);
     int len = 0;
 
     /* I was having segfault trouble under Linux 2.2.5 after a
@@ -3938,7 +4572,7 @@ run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	    SvREFCNT_dec(filter_sub);
 	    IoBOTTOM_GV(datasv) = Nullgv;
 	}
-	filter_del(run_user_filter);
+	filter_del(S_run_user_filter);
     }
 
     return len;
@@ -3951,11 +4585,12 @@ S_path_is_absolute(pTHX_ const char *name)
 {
     if (PERL_FILE_IS_ABSOLUTE(name)
 #ifdef MACOS_TRADITIONAL
-	|| (*name == ':'))
+	|| (*name == ':')
 #else
 	|| (*name == '.' && (name[1] == '/' ||
-			     (name[1] == '.' && name[2] == '/'))))
+			     (name[1] == '.' && name[2] == '/')))
 #endif
+	 )
     {
 	return TRUE;
     }