X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=947dfa32b343ad33157f45629b13036dfa20da0a;hb=c9fdb9e966a1ba8953c235de2e289c17cdd8c75f;hp=a64b435761a036b6e8c36ee875205a47392c6a11;hpb=c6e96bcb406bc8b8d8610606459ff606ad6883aa;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index a64b435..947dfa3 100644
--- a/op.c
+++ b/op.c
@@ -1,6 +1,6 @@
 /*    op.c
  *
- *    Copyright (c) 1991-1997, Larry Wall
+ *    Copyright (c) 1991-1999, 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.
@@ -16,14 +16,38 @@
  */
 
 #include "EXTERN.h"
+#define PERL_IN_OP_C
 #include "perl.h"
 
 #ifdef PERL_OBJECT
 #define CHECKCALL this->*PL_check
 #else
 #define CHECKCALL *PL_check
+#endif              
+
+/* #define PL_OP_SLAB_ALLOC */
+                                                            
+#ifdef PL_OP_SLAB_ALLOC 
+#define SLAB_SIZE 8192
+static char    *PL_OpPtr  = NULL;
+static int     PL_OpSpace = 0;
+#define NewOp(m,var,c,type) do { if ((PL_OpSpace -= c*sizeof(type)) >= 0)     \
+                              var =  (type *)(PL_OpPtr -= c*sizeof(type));    \
+                             else                                             \
+                              var = (type *) Slab_Alloc(m,c*sizeof(type));    \
+                           } while (0)
+
+STATIC void *           
+S_Slab_Alloc(pTHX_ int m, size_t sz)
+{ 
+ Newz(m,PL_OpPtr,SLAB_SIZE,char);
+ PL_OpSpace = SLAB_SIZE - sz;
+ return PL_OpPtr += PL_OpSpace;
+}
+
+#else 
+#define NewOp(m, var, c, type) Newz(m, var, c, type)
 #endif
-
 /*
  * In the following definition, the ", Nullop" is just to make the compiler
  * think the expression is of the right type: croak actually does a Siglongjmp.
@@ -31,78 +55,71 @@
 #define CHECKOP(type,o) \
     ((PL_op_mask && PL_op_mask[type])					\
      ? ( op_free((OP*)o),					\
-	 croak("%s trapped by operation mask", PL_op_desc[type]),	\
+	 Perl_croak(aTHX_ "%s trapped by operation mask", PL_op_desc[type]),	\
 	 Nullop )						\
-     : (CHECKCALL[type])((OP*)o))
+     : (CHECKCALL[type])(aTHX_ (OP*)o))
 
 #define PAD_MAX 999999999
 
-static bool scalar_mod_type _((OP *o, I32 type));
-#ifndef PERL_OBJECT
-static I32 list_assignment _((OP *o));
-static void bad_type _((I32 n, char *t, char *name, OP *kid));
-static OP *modkids _((OP *o, I32 type));
-static OP *no_fh_allowed _((OP *o));
-static OP *scalarboolean _((OP *o));
-static OP *too_few_arguments _((OP *o, char* name));
-static OP *too_many_arguments _((OP *o, char* name));
-static void null _((OP* o));
-static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
-	CV* startcv, I32 cx_ix, I32 saweval));
-static OP *newDEFSVOP _((void));
-static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
-#endif
-
 STATIC char*
-gv_ename(GV *gv)
+S_gv_ename(pTHX_ GV *gv)
 {
+    STRLEN n_a;
     SV* tmpsv = sv_newmortal();
     gv_efullname3(tmpsv, gv, Nullch);
-    return SvPV(tmpsv,PL_na);
+    return SvPV(tmpsv,n_a);
 }
 
 STATIC OP *
-no_fh_allowed(OP *o)
+S_no_fh_allowed(pTHX_ OP *o)
 {
-    yyerror(form("Missing comma after first argument to %s function",
+    yyerror(Perl_form(aTHX_ "Missing comma after first argument to %s function",
 		 PL_op_desc[o->op_type]));
     return o;
 }
 
 STATIC OP *
-too_few_arguments(OP *o, char *name)
+S_too_few_arguments(pTHX_ OP *o, char *name)
 {
-    yyerror(form("Not enough arguments for %s", name));
+    yyerror(Perl_form(aTHX_ "Not enough arguments for %s", name));
     return o;
 }
 
 STATIC OP *
-too_many_arguments(OP *o, char *name)
+S_too_many_arguments(pTHX_ OP *o, char *name)
 {
-    yyerror(form("Too many arguments for %s", name));
+    yyerror(Perl_form(aTHX_ "Too many arguments for %s", name));
     return o;
 }
 
 STATIC void
-bad_type(I32 n, char *t, char *name, OP *kid)
+S_bad_type(pTHX_ I32 n, char *t, char *name, OP *kid)
 {
-    yyerror(form("Type of arg %d to %s must be %s (not %s)",
+    yyerror(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)",
 		 (int)n, name, t, PL_op_desc[kid->op_type]));
 }
 
+STATIC void
+S_no_bareword_allowed(pTHX_ OP *o)
+{
+    Perl_warn(aTHX_ "Bareword \"%s\" not allowed while \"strict subs\" in use",
+	  SvPV_nolen(cSVOPo->op_sv));
+    ++PL_error_count;
+}
+
 void
-assertref(OP *o)
+Perl_assertref(pTHX_ OP *o)
 {
     int type = o->op_type;
     if (type != OP_AELEM && type != OP_HELEM && type != OP_GELEM) {
-	yyerror(form("Can't use subscript on %s", PL_op_desc[type]));
+	yyerror(Perl_form(aTHX_ "Can't use subscript on %s", PL_op_desc[type]));
 	if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV) {
 	    dTHR;
 	    SV *msg = sv_2mortal(
-			newSVpvf("(Did you mean $ or @ instead of %c?)\n",
+			Perl_newSVpvf(aTHX_ "(Did you mean $ or @ instead of %c?)\n",
 				 type == OP_ENTERSUB ? '&' : '%'));
-	    if (PL_in_eval & 2)
-		warn("%_", msg);
+	    if (PL_in_eval & EVAL_WARNONLY)
+		Perl_warn(aTHX_ "%_", msg);
 	    else if (PL_in_eval)
 		sv_catsv(GvSV(PL_errgv), msg);
 	    else
@@ -114,7 +131,7 @@ assertref(OP *o)
 /* "register" allocation */
 
 PADOFFSET
-pad_allocmy(char *name)
+Perl_pad_allocmy(pTHX_ char *name)
 {
     dTHR;
     PADOFFSET off;
@@ -126,11 +143,25 @@ pad_allocmy(char *name)
 	name[1] == '_' && (int)strlen(name) > 2))
     {
 	if (!isPRINT(name[1])) {
-	    name[3] = '\0';
+	    /* 1999-02-27 mjd@plover.com */
+	    char *p;
+	    p = strchr(name, '\0');
+	    /* The next block assumes the buffer is at least 205 chars
+	       long.  At present, it's always at least 256 chars. */
+	    if (p-name > 200) {
+		strcpy(name+200, "...");
+		p = name+199;
+	    }
+	    else {
+		p[1] = '\0';
+	    }
+	    /* Move everything else down one character */
+	    for (; p-name > 2; p--)
+		*p = *(p-1);
 	    name[2] = toCTRL(name[1]);
 	    name[1] = '^';
 	}
-	croak("Can't use global %s in \"my\"",name);
+	yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
     }
     if (ckWARN(WARN_UNSAFE) && AvFILLp(PL_comppad_name) >= 0) {
 	SV **svp = AvARRAY(PL_comppad_name);
@@ -140,7 +171,7 @@ pad_allocmy(char *name)
 		&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
 		&& strEQ(name, SvPVX(sv)))
 	    {
-		warner(WARN_UNSAFE,
+		Perl_warner(aTHX_ WARN_UNSAFE,
 			"\"my\" variable %s masks earlier declaration in same %s", 
 			name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
 		break;
@@ -153,7 +184,8 @@ pad_allocmy(char *name)
     sv_setpv(sv, name);
     if (PL_in_my_stash) {
 	if (*name != '$')
-	    croak("Can't declare class for non-scalar %s in \"my\"",name);
+	    yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"my\"",
+			 name));
 	SvOBJECT_on(sv);
 	(void)SvUPGRADE(sv, SVt_PVMG);
 	SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
@@ -173,8 +205,11 @@ pad_allocmy(char *name)
     return off;
 }
 
+#define FINDLEX_NOSEARCH	1		/* don't search outer contexts */
+
 STATIC PADOFFSET
-pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 saweval)
+S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
+	    I32 cx_ix, I32 saweval, U32 flags)
 {
     dTHR;
     CV *cv;
@@ -248,7 +283,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 s
 				    if (ckWARN(WARN_CLOSURE)
 					&& !CvUNIQUE(bcv) && !CvUNIQUE(cv))
 				    {
-					warner(WARN_CLOSURE,
+					Perl_warner(aTHX_ WARN_CLOSURE,
 					  "Variable \"%s\" may be unavailable",
 					     name);
 				    }
@@ -259,7 +294,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 s
 		    }
 		    else if (!CvUNIQUE(PL_compcv)) {
 			if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv))
-			    warner(WARN_CLOSURE,
+			    Perl_warner(aTHX_ WARN_CLOSURE,
 				"Variable \"%s\" will not stay shared", name);
 		    }
 		}
@@ -269,6 +304,9 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 s
 	}
     }
 
+    if (flags & FINDLEX_NOSEARCH)
+	return 0;
+
     /* Nothing in current lexical context--try eval's context, if any.
      * This is necessary to let the perldb get at lexically scoped variables.
      * XXX This will also probably interact badly with eval tree caching.
@@ -280,7 +318,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 s
 	default:
 	    if (i == 0 && saweval) {
 		seq = cxstack[saweval].blk_oldcop->cop_seq;
-		return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval);
+		return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
 	    }
 	    break;
 	case CXt_EVAL:
@@ -303,7 +341,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 s
 		continue;
 	    }
 	    seq = cxstack[saweval].blk_oldcop->cop_seq;
-	    return pad_findlex(name, newoff, seq, cv, i-1, saweval);
+	    return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
 	}
     }
 
@@ -311,7 +349,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix, I32 s
 }
 
 PADOFFSET
-pad_findmy(char *name)
+Perl_pad_findmy(pTHX_ char *name)
 {
     dTHR;
     I32 off;
@@ -355,15 +393,15 @@ pad_findmy(char *name)
     /* Check if if we're compiling an eval'', and adjust seq to be the
      * eval's seq number.  This depends on eval'' having a non-null
      * CvOUTSIDE() while it is being compiled.  The eval'' itself is
-     * identified by CvUNIQUE being set and CvGV being null. */
-    if (outside && CvUNIQUE(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
+     * identified by CvEVAL being true and CvGV being null. */
+    if (outside && CvEVAL(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
 	cx = &cxstack[cxstack_ix];
 	if (CxREALEVAL(cx))
 	    seq = cx->blk_oldcop->cop_seq;
     }
 
     /* See if it's in a nested scope */
-    off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0);
+    off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0, 0);
     if (off) {
 	/* If there is a pending local definition, this new alias must die */
 	if (pendoff)
@@ -374,7 +412,7 @@ pad_findmy(char *name)
 }
 
 void
-pad_leavemy(I32 fill)
+Perl_pad_leavemy(pTHX_ I32 fill)
 {
     I32 off;
     SV **svp = AvARRAY(PL_comppad_name);
@@ -382,7 +420,7 @@ pad_leavemy(I32 fill)
     if (PL_min_intro_pending && fill < PL_min_intro_pending) {
 	for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
 	    if ((sv = svp[off]) && sv != &PL_sv_undef)
-		warn("%s never introduced", SvPVX(sv));
+		Perl_warn(aTHX_ "%s never introduced", SvPVX(sv));
 	}
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
@@ -393,14 +431,14 @@ pad_leavemy(I32 fill)
 }
 
 PADOFFSET
-pad_alloc(I32 optype, U32 tmptype)
+Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 {
     dTHR;
     SV *sv;
     I32 retval;
 
     if (AvARRAY(PL_comppad) != PL_curpad)
-	croak("panic: pad_alloc");
+	Perl_croak(aTHX_ "panic: pad_alloc");
     if (PL_pad_reset_pending)
 	pad_reset();
     if (tmptype & SVs_PADMY) {
@@ -442,7 +480,7 @@ pad_alloc(I32 optype, U32 tmptype)
 }
 
 SV *
-pad_sv(PADOFFSET po)
+Perl_pad_sv(pTHX_ PADOFFSET po)
 {
     dTHR;
 #ifdef USE_THREADS
@@ -450,7 +488,7 @@ pad_sv(PADOFFSET po)
 			  (unsigned long) thr, (unsigned long) PL_curpad, po));
 #else
     if (!po)
-	croak("panic: pad_sv po");
+	Perl_croak(aTHX_ "panic: pad_sv po");
     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n",
 			  (unsigned long) PL_curpad, po));
 #endif /* USE_THREADS */
@@ -458,15 +496,15 @@ pad_sv(PADOFFSET po)
 }
 
 void
-pad_free(PADOFFSET po)
+Perl_pad_free(pTHX_ PADOFFSET po)
 {
     dTHR;
     if (!PL_curpad)
 	return;
     if (AvARRAY(PL_comppad) != PL_curpad)
-	croak("panic: pad_free curpad");
+	Perl_croak(aTHX_ "panic: pad_free curpad");
     if (!po)
-	croak("panic: pad_free po");
+	Perl_croak(aTHX_ "panic: pad_free po");
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n",
 			  (unsigned long) thr, (unsigned long) PL_curpad, po));
@@ -481,13 +519,13 @@ pad_free(PADOFFSET po)
 }
 
 void
-pad_swipe(PADOFFSET po)
+Perl_pad_swipe(pTHX_ PADOFFSET po)
 {
     dTHR;
     if (AvARRAY(PL_comppad) != PL_curpad)
-	croak("panic: pad_swipe curpad");
+	Perl_croak(aTHX_ "panic: pad_swipe curpad");
     if (!po)
-	croak("panic: pad_swipe po");
+	Perl_croak(aTHX_ "panic: pad_swipe po");
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n",
 			  (unsigned long) thr, (unsigned long) PL_curpad, po));
@@ -509,14 +547,14 @@ pad_swipe(PADOFFSET po)
  * We avoid doing this until we can think of a Better Way.
  * GSAR 97-10-29 */
 void
-pad_reset(void)
+Perl_pad_reset(pTHX)
 {
 #ifdef USE_BROKEN_PAD_RESET
     dTHR;
     register I32 po;
 
     if (AvARRAY(PL_comppad) != PL_curpad)
-	croak("panic: pad_reset curpad");
+	Perl_croak(aTHX_ "panic: pad_reset curpad");
 #ifdef USE_THREADS
     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n",
 			  (unsigned long) thr, (unsigned long) PL_curpad));
@@ -538,7 +576,7 @@ pad_reset(void)
 #ifdef USE_THREADS
 /* find_threadsv is not reentrant */
 PADOFFSET
-find_threadsv(char *name)
+Perl_find_threadsv(pTHX_ const char *name)
 {
     dTHR;
     char *p;
@@ -549,11 +587,15 @@ find_threadsv(char *name)
     if (!p)
 	return NOT_IN_PAD;
     key = p - PL_threadsv_names;
+    MUTEX_LOCK(&thr->mutex);
     svp = av_fetch(thr->threadsv, key, FALSE);
-    if (!svp) {
+    if (svp)
+	MUTEX_UNLOCK(&thr->mutex);
+    else {
 	SV *sv = NEWSV(0, 0);
 	av_store(thr->threadsv, key, sv);
 	thr->threadsvp = AvARRAY(thr->threadsv);
+	MUTEX_UNLOCK(&thr->mutex);
 	/*
 	 * Some magic variables used to be automagically initialised
 	 * in gv_fetchpv. Those which are now per-thread magicals get
@@ -570,6 +612,16 @@ find_threadsv(char *name)
 	case '`':
 	case '\'':
 	    PL_sawampersand = TRUE;
+	    /* FALL THROUGH */
+	case '1':
+	case '2':
+	case '3':
+	case '4':
+	case '5':
+	case '6':
+	case '7':
+	case '8':
+	case '9':
 	    SvREADONLY_on(sv);
 	    /* FALL THROUGH */
 
@@ -592,7 +644,7 @@ find_threadsv(char *name)
 /* Destructor */
 
 void
-op_free(OP *o)
+Perl_op_free(pTHX_ OP *o)
 {
     register OP *kid, *nextkid;
 
@@ -624,7 +676,7 @@ op_free(OP *o)
 #endif /* USE_THREADS */
     default:
 	if (!(o->op_flags & OPf_REF)
-	    || (PL_check[o->op_type] != FUNC_NAME_TO_PTR(ck_ftst)))
+	    || (PL_check[o->op_type] != FUNC_NAME_TO_PTR(Perl_ck_ftst)))
 	    break;
 	/* FALL THROUGH */
     case OP_GVSV:
@@ -668,11 +720,17 @@ op_free(OP *o)
     if (o->op_targ > 0)
 	pad_free(o->op_targ);
 
+#ifdef PL_OP_SLAB_ALLOC
+    if ((char *) o == PL_OpPtr)
+     {
+     }
+#else
     Safefree(o);
+#endif
 }
 
 STATIC void
-null(OP *o)
+S_null(pTHX_ OP *o)
 {
     if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
 	pad_free(o->op_targ);
@@ -686,7 +744,7 @@ null(OP *o)
 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
 
 OP *
-linklist(OP *o)
+Perl_linklist(pTHX_ OP *o)
 {
     register OP *kid;
 
@@ -710,7 +768,7 @@ linklist(OP *o)
 }
 
 OP *
-scalarkids(OP *o)
+Perl_scalarkids(pTHX_ OP *o)
 {
     OP *kid;
     if (o && o->op_flags & OPf_KIDS) {
@@ -721,7 +779,7 @@ scalarkids(OP *o)
 }
 
 STATIC OP *
-scalarboolean(OP *o)
+S_scalarboolean(pTHX_ OP *o)
 {
     if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
 	dTHR;
@@ -730,7 +788,7 @@ scalarboolean(OP *o)
 
 	    if (PL_copline != NOLINE)
 		PL_curcop->cop_line = PL_copline;
-	    warner(WARN_SYNTAX, "Found = in conditional, should be ==");
+	    Perl_warner(aTHX_ WARN_SYNTAX, "Found = in conditional, should be ==");
 	    PL_curcop->cop_line = oldline;
 	}
     }
@@ -738,7 +796,7 @@ scalarboolean(OP *o)
 }
 
 OP *
-scalar(OP *o)
+Perl_scalar(pTHX_ OP *o)
 {
     OP *kid;
 
@@ -805,14 +863,24 @@ scalar(OP *o)
 }
 
 OP *
-scalarvoid(OP *o)
+Perl_scalarvoid(pTHX_ OP *o)
 {
     OP *kid;
     char* useless = 0;
     SV* sv;
+    U8 want;
+
+    if (o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE ||
+	(o->op_type == OP_NULL &&
+	 (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)))
+    {
+	dTHR;
+	PL_curcop = (COP*)o;		/* for warning below */
+    }
 
     /* assumes no premature commitment */
-    if (!o || (o->op_flags & OPf_WANT) == OPf_WANT_LIST || PL_error_count
+    want = o->op_flags & OPf_WANT;
+    if ((want && want != OPf_WANT_SCALAR) || PL_error_count
 	 || o->op_type == OP_RETURN)
 	return o;
 
@@ -912,14 +980,11 @@ scalarvoid(OP *o)
 	    useless = "a variable";
 	break;
 
-    case OP_NEXTSTATE:
-    case OP_DBSTATE:
-	WITH_THR(PL_curcop = ((COP*)o));		/* for warning below */
-	break;
-
     case OP_CONST:
 	sv = cSVOPo->op_sv;
-	{
+	if (cSVOPo->op_private & OPpCONST_STRICT)
+	    no_bareword_allowed(o);
+	else {
 	    dTHR;
 	    if (ckWARN(WARN_VOID)) {
 		useless = "a constant";
@@ -955,11 +1020,11 @@ scalarvoid(OP *o)
 	break;
 
     case OP_NULL:
-	if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
-	    WITH_THR(PL_curcop = ((COP*)o));	/* for warning below */
 	if (o->op_flags & OPf_STACKED)
 	    break;
 	/* FALL THROUGH */
+    case OP_NEXTSTATE:
+    case OP_DBSTATE:
     case OP_ENTERTRY:
     case OP_ENTER:
     case OP_SCALAR:
@@ -992,13 +1057,13 @@ scalarvoid(OP *o)
     if (useless) {
 	dTHR;
 	if (ckWARN(WARN_VOID))
-	    warner(WARN_VOID, "Useless use of %s in void context", useless);
+	    Perl_warner(aTHX_ WARN_VOID, "Useless use of %s in void context", useless);
     }
     return o;
 }
 
 OP *
-listkids(OP *o)
+Perl_listkids(pTHX_ OP *o)
 {
     OP *kid;
     if (o && o->op_flags & OPf_KIDS) {
@@ -1009,7 +1074,7 @@ listkids(OP *o)
 }
 
 OP *
-list(OP *o)
+Perl_list(pTHX_ OP *o)
 {
     OP *kid;
 
@@ -1076,7 +1141,7 @@ list(OP *o)
 }
 
 OP *
-scalarseq(OP *o)
+Perl_scalarseq(pTHX_ OP *o)
 {
     OP *kid;
 
@@ -1104,7 +1169,7 @@ scalarseq(OP *o)
 }
 
 STATIC OP *
-modkids(OP *o, I32 type)
+S_modkids(pTHX_ OP *o, I32 type)
 {
     OP *kid;
     if (o && o->op_flags & OPf_KIDS) {
@@ -1115,11 +1180,12 @@ modkids(OP *o, I32 type)
 }
 
 OP *
-mod(OP *o, I32 type)
+Perl_mod(pTHX_ OP *o, I32 type)
 {
     dTHR;
     OP *kid;
     SV *sv;
+    STRLEN n_a;
 
     if (!o || PL_error_count)
 	return o;
@@ -1142,7 +1208,7 @@ mod(OP *o, I32 type)
 	else if (type == OP_REFGEN)
 	    goto nomod;
 	else
-	    croak("That use of $[ is unsupported");
+	    Perl_croak(aTHX_ "That use of $[ is unsupported");
 	break;
     case OP_STUB:
 	if (o->op_flags & OPf_PARENS)
@@ -1163,7 +1229,7 @@ mod(OP *o, I32 type)
 	/* grep, foreach, subcalls, refgen */
 	if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
 	    break;
-	yyerror(form("Can't modify %s in %s",
+	yyerror(Perl_form(aTHX_ "Can't modify %s in %s",
 		     (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
 		      ? "do block" : PL_op_desc[o->op_type]),
 		     type ? PL_op_desc[type] : "local"));
@@ -1202,7 +1268,7 @@ mod(OP *o, I32 type)
     case OP_RV2AV:
     case OP_RV2HV:
 	if (!type && cUNOPo->op_first->op_type != OP_GV)
-	    croak("Can't localize through a reference");
+	    Perl_croak(aTHX_ "Can't localize through a reference");
 	if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
 	    PL_modcount = 10000;
 	    return o;		/* Treat \(@foo) like ordinary list. */
@@ -1224,13 +1290,15 @@ mod(OP *o, I32 type)
 	break;
     case OP_RV2SV:
 	if (!type && cUNOPo->op_first->op_type != OP_GV)
-	    croak("Can't localize through a reference");
+	    Perl_croak(aTHX_ "Can't localize through a reference");
 	ref(cUNOPo->op_first, o->op_type);
 	/* FALL THROUGH */
     case OP_GV:
     case OP_AV2ARYLEN:
 	PL_hints |= HINT_BLOCK_SCOPE;
     case OP_SASSIGN:
+    case OP_ANDASSIGN:
+    case OP_ORASSIGN:
     case OP_AELEMFAST:
 	PL_modcount++;
 	break;
@@ -1246,8 +1314,8 @@ mod(OP *o, I32 type)
     case OP_PADSV:
 	PL_modcount++;
 	if (!type)
-	    croak("Can't localize lexical variable %s",
-		SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), PL_na));
+	    Perl_croak(aTHX_ "Can't localize lexical variable %s",
+		SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), n_a));
 	break;
 
 #ifdef USE_THREADS
@@ -1322,8 +1390,8 @@ mod(OP *o, I32 type)
     return o;
 }
 
-static bool
-scalar_mod_type(OP *o, I32 type)
+STATIC bool
+S_scalar_mod_type(pTHX_ OP *o, I32 type)
 {
     switch (type) {
     case OP_SASSIGN:
@@ -1361,16 +1429,39 @@ scalar_mod_type(OP *o, I32 type)
     case OP_READ:
     case OP_SYSREAD:
     case OP_RECV:
-    case OP_ANDASSIGN:	/* may work later */
-    case OP_ORASSIGN:	/* may work later */
+    case OP_ANDASSIGN:
+    case OP_ORASSIGN:
 	return TRUE;
     default:
 	return FALSE;
     }
 }
 
+STATIC bool
+S_is_handle_constructor(pTHX_ OP *o, I32 argnum)
+{
+    switch (o->op_type) {
+    case OP_PIPE_OP:
+    case OP_SOCKPAIR:
+	if (argnum == 2)
+	    return TRUE;
+	/* FALL THROUGH */
+    case OP_SYSOPEN:
+    case OP_OPEN:
+    case OP_SELECT:		/* XXX c.f. SelectSaver.pm */
+    case OP_SOCKET:
+    case OP_OPEN_DIR:
+    case OP_ACCEPT:
+	if (argnum == 1)
+	    return TRUE;
+	/* FALL THROUGH */
+    default:
+	return FALSE;
+    }
+}
+
 OP *
-refkids(OP *o, I32 type)
+Perl_refkids(pTHX_ OP *o, I32 type)
 {
     OP *kid;
     if (o && o->op_flags & OPf_KIDS) {
@@ -1381,7 +1472,7 @@ refkids(OP *o, I32 type)
 }
 
 OP *
-ref(OP *o, I32 type)
+Perl_ref(pTHX_ OP *o, I32 type)
 {
     OP *kid;
 
@@ -1405,6 +1496,8 @@ ref(OP *o, I32 type)
 	    ref(kid, type);
 	break;
     case OP_RV2SV:
+	if (type == OP_DEFINED)
+	    o->op_flags |= OPf_SPECIAL;		/* don't create GV */
 	ref(cUNOPo->op_first, o->op_type);
 	/* FALL THROUGH */
     case OP_PADSV:
@@ -1425,6 +1518,8 @@ ref(OP *o, I32 type)
 	o->op_flags |= OPf_REF;
 	/* FALL THROUGH */
     case OP_RV2GV:
+	if (type == OP_DEFINED)
+	    o->op_flags |= OPf_SPECIAL;		/* don't create GV */
 	ref(cUNOPo->op_first, o->op_type);
 	break;
 
@@ -1466,7 +1561,7 @@ ref(OP *o, I32 type)
 }
 
 OP *
-my(OP *o)
+Perl_my(pTHX_ OP *o)
 {
     OP *kid;
     I32 type;
@@ -1485,7 +1580,7 @@ my(OP *o)
 	     type != OP_PADHV &&
 	     type != OP_PUSHMARK)
     {
-	yyerror(form("Can't declare %s in my", PL_op_desc[o->op_type]));
+	yyerror(Perl_form(aTHX_ "Can't declare %s in my", PL_op_desc[o->op_type]));
 	return o;
     }
     o->op_flags |= OPf_MOD;
@@ -1494,7 +1589,7 @@ my(OP *o)
 }
 
 OP *
-sawparens(OP *o)
+Perl_sawparens(pTHX_ OP *o)
 {
     if (o)
 	o->op_flags |= OPf_PARENS;
@@ -1502,7 +1597,7 @@ sawparens(OP *o)
 }
 
 OP *
-bind_match(I32 type, OP *left, OP *right)
+Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
 {
     dTHR;
     OP *o;
@@ -1518,7 +1613,7 @@ bind_match(I32 type, OP *left, OP *right)
       char *sample = ((left->op_type == OP_RV2AV ||
                        left->op_type == OP_PADAV)
                       ? "@array" : "%hash");
-      warner(WARN_UNSAFE,
+      Perl_warner(aTHX_ WARN_UNSAFE,
              "Applying %s to %s will act on scalar(%s)", 
              desc, sample, sample);
     }
@@ -1543,7 +1638,7 @@ bind_match(I32 type, OP *left, OP *right)
 }
 
 OP *
-invert(OP *o)
+Perl_invert(pTHX_ OP *o)
 {
     if (!o)
 	return o;
@@ -1552,7 +1647,7 @@ invert(OP *o)
 }
 
 OP *
-scope(OP *o)
+Perl_scope(pTHX_ OP *o)
 {
     if (o) {
 	if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || PL_tainting) {
@@ -1579,7 +1674,7 @@ scope(OP *o)
 }
 
 void
-save_hints(void)
+Perl_save_hints(pTHX)
 {
     SAVEI32(PL_hints);
     SAVESPTR(GvHV(PL_hintgv));
@@ -1588,7 +1683,7 @@ save_hints(void)
 }
 
 int
-block_start(int full)
+Perl_block_start(pTHX_ int full)
 {
     dTHR;
     int retval = PL_savestack_ix;
@@ -1621,7 +1716,7 @@ block_start(int full)
 }
 
 OP*
-block_end(I32 floor, OP *seq)
+Perl_block_end(pTHX_ I32 floor, OP *seq)
 {
     dTHR;
     int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
@@ -1637,7 +1732,7 @@ block_end(I32 floor, OP *seq)
 }
 
 STATIC OP *
-newDEFSVOP(void)
+S_newDEFSVOP(pTHX)
 {
 #ifdef USE_THREADS
     OP *o = newOP(OP_THREADSV, 0);
@@ -1649,11 +1744,15 @@ newDEFSVOP(void)
 }
 
 void
-newPROG(OP *o)
+Perl_newPROG(pTHX_ OP *o)
 {
     dTHR;
     if (PL_in_eval) {
-	PL_eval_root = newUNOP(OP_LEAVEEVAL, ((PL_in_eval & 4) ? OPf_SPECIAL : 0), o);
+	if (PL_eval_root)
+		return;
+	PL_eval_root = newUNOP(OP_LEAVEEVAL,
+			       ((PL_in_eval & EVAL_KEEPERR)
+				? OPf_SPECIAL : 0), o);
 	PL_eval_start = linklist(PL_eval_root);
 	PL_eval_root->op_next = 0;
 	peep(PL_eval_start);
@@ -1670,20 +1769,20 @@ newPROG(OP *o)
 
 	/* Register with debugger */
 	if (PERLDB_INTER) {
-	    CV *cv = perl_get_cv("DB::postponed", FALSE);
+	    CV *cv = get_cv("DB::postponed", FALSE);
 	    if (cv) {
 		dSP;
 		PUSHMARK(SP);
 		XPUSHs((SV*)PL_compiling.cop_filegv);
 		PUTBACK;
-		perl_call_sv((SV*)cv, G_DISCARD);
+		call_sv((SV*)cv, G_DISCARD);
 	    }
 	}
     }
 }
 
 OP *
-localize(OP *o, I32 lex)
+Perl_localize(pTHX_ OP *o, I32 lex)
 {
     if (o->op_flags & OPf_PARENS)
 	list(o);
@@ -1693,7 +1792,7 @@ localize(OP *o, I32 lex)
 	    char *s;
 	    for (s = PL_bufptr; *s && (isALNUM(*s) || (*s & 0x80) || strchr("@$%, ",*s)); s++) ;
 	    if (*s == ';' || *s == '=')
-		warner(WARN_PARENTHESIS, "Parens missing around \"%s\" list",
+		Perl_warner(aTHX_ WARN_PARENTHESIS, "Parentheses missing around \"%s\" list",
 				lex ? "my" : "local");
 	}
     }
@@ -1706,7 +1805,7 @@ localize(OP *o, I32 lex)
 }
 
 OP *
-jmaybe(OP *o)
+Perl_jmaybe(pTHX_ OP *o)
 {
     if (o->op_type == OP_LIST) {
 	OP *o2;
@@ -1722,7 +1821,7 @@ jmaybe(OP *o)
 }
 
 OP *
-fold_constants(register OP *o)
+Perl_fold_constants(pTHX_ register OP *o)
 {
     dTHR;
     register OP *curop;
@@ -1741,6 +1840,10 @@ fold_constants(register OP *o)
 	goto nope;
 
     switch (type) {
+    case OP_NEGATE:
+	/* XXX might want a ck_negate() for this */
+	cUNOPo->op_first->op_private &= ~OPpCONST_STRICT;
+	break;
     case OP_SPRINTF:
     case OP_UCFIRST:
     case OP_LCFIRST:
@@ -1761,10 +1864,11 @@ fold_constants(register OP *o)
 
     for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
 	if (curop->op_type != OP_CONST &&
-		curop->op_type != OP_LIST &&
-		curop->op_type != OP_SCALAR &&
-		curop->op_type != OP_NULL &&
-		curop->op_type != OP_PUSHMARK) {
+	    curop->op_type != OP_LIST &&
+	    curop->op_type != OP_SCALAR &&
+	    curop->op_type != OP_NULL &&
+	    curop->op_type != OP_PUSHMARK)
+	{
 	    goto nope;
 	}
     }
@@ -1772,7 +1876,7 @@ fold_constants(register OP *o)
     curop = LINKLIST(o);
     o->op_next = 0;
     PL_op = curop;
-    CALLRUNOPS();
+    CALLRUNOPS(aTHX);
     sv = *(PL_stack_sp--);
     if (o->op_targ && sv == PAD_SV(o->op_targ))	/* grab pad temp? */
 	pad_swipe(o->op_targ);
@@ -1824,7 +1928,7 @@ fold_constants(register OP *o)
 }
 
 OP *
-gen_constant_list(register OP *o)
+Perl_gen_constant_list(pTHX_ register OP *o)
 {
     dTHR;
     register OP *curop;
@@ -1836,10 +1940,10 @@ gen_constant_list(register OP *o)
 
     PL_op = curop = LINKLIST(o);
     o->op_next = 0;
-    pp_pushmark(ARGS);
-    CALLRUNOPS();
+    pp_pushmark();
+    CALLRUNOPS(aTHX);
     PL_op = curop;
-    pp_anonlist(ARGS);
+    pp_anonlist();
     PL_tmps_floor = oldtmps_floor;
 
     o->op_type = OP_RV2AV;
@@ -1852,7 +1956,7 @@ gen_constant_list(register OP *o)
 }
 
 OP *
-convert(I32 type, I32 flags, OP *o)
+Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
 {
     OP *kid;
     OP *last = 0;
@@ -1886,7 +1990,7 @@ convert(I32 type, I32 flags, OP *o)
 /* List constructors */
 
 OP *
-append_elem(I32 type, OP *first, OP *last)
+Perl_append_elem(pTHX_ I32 type, OP *first, OP *last)
 {
     if (!first)
 	return last;
@@ -1909,7 +2013,7 @@ append_elem(I32 type, OP *first, OP *last)
 }
 
 OP *
-append_list(I32 type, LISTOP *first, LISTOP *last)
+Perl_append_list(pTHX_ I32 type, LISTOP *first, LISTOP *last)
 {
     if (!first)
 	return (OP*)last;
@@ -1928,13 +2032,16 @@ append_list(I32 type, LISTOP *first, LISTOP *last)
     first->op_children += last->op_children;
     if (first->op_children)
 	first->op_flags |= OPf_KIDS;
-
-    Safefree(last);
+    
+#ifdef PL_OP_SLAB_ALLOC
+#else
+    Safefree(last);     
+#endif
     return (OP*)first;
 }
 
 OP *
-prepend_elem(I32 type, OP *first, OP *last)
+Perl_prepend_elem(pTHX_ I32 type, OP *first, OP *last)
 {
     if (!first)
 	return last;
@@ -1965,13 +2072,13 @@ prepend_elem(I32 type, OP *first, OP *last)
 /* Constructors */
 
 OP *
-newNULLLIST(void)
+Perl_newNULLLIST(pTHX)
 {
     return newOP(OP_STUB, 0);
 }
 
 OP *
-force_list(OP *o)
+Perl_force_list(pTHX_ OP *o)
 {
     if (!o || o->op_type != OP_LIST)
 	o = newLISTOP(OP_LIST, 0, o, Nullop);
@@ -1980,11 +2087,11 @@ force_list(OP *o)
 }
 
 OP *
-newLISTOP(I32 type, I32 flags, OP *first, OP *last)
+Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 {
     LISTOP *listop;
 
-    Newz(1101, listop, 1, LISTOP);
+    NewOp(1101, listop, 1, LISTOP);
 
     listop->op_type = type;
     listop->op_ppaddr = PL_ppaddr[type];
@@ -2015,10 +2122,10 @@ newLISTOP(I32 type, I32 flags, OP *first, OP *last)
 }
 
 OP *
-newOP(I32 type, I32 flags)
+Perl_newOP(pTHX_ I32 type, I32 flags)
 {
     OP *o;
-    Newz(1101, o, 1, OP);
+    NewOp(1101, o, 1, OP);
     o->op_type = type;
     o->op_ppaddr = PL_ppaddr[type];
     o->op_flags = flags;
@@ -2033,7 +2140,7 @@ newOP(I32 type, I32 flags)
 }
 
 OP *
-newUNOP(I32 type, I32 flags, OP *first)
+Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
 {
     UNOP *unop;
 
@@ -2042,7 +2149,7 @@ newUNOP(I32 type, I32 flags, OP *first)
     if (PL_opargs[type] & OA_MARK)
 	first = force_list(first);
 
-    Newz(1101, unop, 1, UNOP);
+    NewOp(1101, unop, 1, UNOP);
     unop->op_type = type;
     unop->op_ppaddr = PL_ppaddr[type];
     unop->op_first = first;
@@ -2056,10 +2163,10 @@ newUNOP(I32 type, I32 flags, OP *first)
 }
 
 OP *
-newBINOP(I32 type, I32 flags, OP *first, OP *last)
+Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 {
     BINOP *binop;
-    Newz(1101, binop, 1, BINOP);
+    NewOp(1101, binop, 1, BINOP);
 
     if (!first)
 	first = newOP(OP_NULL, 0);
@@ -2100,7 +2207,7 @@ utf8compare(const void *a, const void *b)
 }
 
 OP *
-pmtrans(OP *o, OP *expr, OP *repl)
+Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 {
     SV *tstr = ((SVOP*)expr)->op_sv;
     SV *rstr = ((SVOP*)repl)->op_sv;
@@ -2120,7 +2227,7 @@ pmtrans(OP *o, OP *expr, OP *repl)
     squash	= o->op_private & OPpTRANS_SQUASH;
 
     if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
-	SV* listsv = newSVpv("# comment\n",0);
+	SV* listsv = newSVpvn("# comment\n",10);
 	SV* transv = 0;
 	U8* tend = t + tlen;
 	U8* rend = r + rlen;
@@ -2148,7 +2255,7 @@ pmtrans(OP *o, OP *expr, OP *repl)
 	    UV nextmin = 0;
 	    New(1109, cp, tlen, U8*);
 	    i = 0;
-	    transv = newSVpv("",0);
+	    transv = newSVpvn("",0);
 	    while (t < tend) {
 		cp[i++] = t;
 		t += UTF8SKIP(t);
@@ -2245,15 +2352,15 @@ pmtrans(OP *o, OP *expr, OP *repl)
 	    if (rfirst == 0xffffffff) {
 		diff = tdiff;	/* oops, pretend rdiff is infinite */
 		if (diff > 0)
-		    sv_catpvf(listsv, "%04x\t%04x\tXXXX\n", tfirst, tlast);
+		    Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\tXXXX\n", tfirst, tlast);
 		else
-		    sv_catpvf(listsv, "%04x\t\tXXXX\n", tfirst);
+		    Perl_sv_catpvf(aTHX_ listsv, "%04x\t\tXXXX\n", tfirst);
 	    }
 	    else {
 		if (diff > 0)
-		    sv_catpvf(listsv, "%04x\t%04x\t%04x\n", tfirst, tfirst + diff, rfirst);
+		    Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\t%04x\n", tfirst, tfirst + diff, rfirst);
 		else
-		    sv_catpvf(listsv, "%04x\t\t%04x\n", tfirst, rfirst);
+		    Perl_sv_catpvf(aTHX_ listsv, "%04x\t\t%04x\n", tfirst, rfirst);
 
 		if (rfirst + diff > max)
 		    max = rfirst + diff;
@@ -2351,12 +2458,12 @@ pmtrans(OP *o, OP *expr, OP *repl)
 }
 
 OP *
-newPMOP(I32 type, I32 flags)
+Perl_newPMOP(pTHX_ I32 type, I32 flags)
 {
     dTHR;
     PMOP *pmop;
 
-    Newz(1101, pmop, 1, PMOP);
+    NewOp(1101, pmop, 1, PMOP);
     pmop->op_type = type;
     pmop->op_ppaddr = PL_ppaddr[type];
     pmop->op_flags = flags;
@@ -2378,7 +2485,7 @@ newPMOP(I32 type, I32 flags)
 }
 
 OP *
-pmruntime(OP *o, OP *expr, OP *repl)
+Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
 {
     dTHR;
     PMOP *pm;
@@ -2400,7 +2507,7 @@ pmruntime(OP *o, OP *expr, OP *repl)
 	    p = SvPV(pat, plen);
 	    pm->op_pmflags |= PMf_SKIPWHITE;
 	}
-	pm->op_pmregexp = CALLREGCOMP(p, p + plen, pm);
+	pm->op_pmregexp = CALLREGCOMP(aTHX_ p, p + plen, pm);
 	if (strEQ("\\s+", pm->op_pmregexp->precomp))
 	    pm->op_pmflags |= PMf_WHITE;
 	op_free(expr);
@@ -2411,7 +2518,7 @@ pmruntime(OP *o, OP *expr, OP *repl)
 			    ? OP_REGCRESET
 			    : OP_REGCMAYBE),0,expr);
 
-	Newz(1101, rcop, 1, LOGOP);
+	NewOp(1101, rcop, 1, LOGOP);
 	rcop->op_type = OP_REGCOMP;
 	rcop->op_ppaddr = PL_ppaddr[OP_REGCOMP];
 	rcop->op_first = scalar(expr);
@@ -2437,8 +2544,11 @@ pmruntime(OP *o, OP *expr, OP *repl)
 
     if (repl) {
 	OP *curop;
-	if (pm->op_pmflags & PMf_EVAL)
+	if (pm->op_pmflags & PMf_EVAL) {
 	    curop = 0;
+	    if (PL_curcop->cop_line < PL_multi_end)
+		PL_curcop->cop_line = PL_multi_end;
+	}
 #ifdef USE_THREADS
 	else if (repl->op_type == OP_THREADSV
 		 && strchr("&`'123456789+",
@@ -2503,7 +2613,7 @@ pmruntime(OP *o, OP *expr, OP *repl)
 		pm->op_pmflags |= PMf_MAYBE_CONST;
 		pm->op_pmpermflags |= PMf_MAYBE_CONST;
 	    }
-	    Newz(1101, rcop, 1, LOGOP);
+	    NewOp(1101, rcop, 1, LOGOP);
 	    rcop->op_type = OP_SUBSTCONT;
 	    rcop->op_ppaddr = PL_ppaddr[OP_SUBSTCONT];
 	    rcop->op_first = scalar(repl);
@@ -2525,10 +2635,10 @@ pmruntime(OP *o, OP *expr, OP *repl)
 }
 
 OP *
-newSVOP(I32 type, I32 flags, SV *sv)
+Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
 {
     SVOP *svop;
-    Newz(1101, svop, 1, SVOP);
+    NewOp(1101, svop, 1, SVOP);
     svop->op_type = type;
     svop->op_ppaddr = PL_ppaddr[type];
     svop->op_sv = sv;
@@ -2542,11 +2652,11 @@ newSVOP(I32 type, I32 flags, SV *sv)
 }
 
 OP *
-newGVOP(I32 type, I32 flags, GV *gv)
+Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
 {
     dTHR;
     GVOP *gvop;
-    Newz(1101, gvop, 1, GVOP);
+    NewOp(1101, gvop, 1, GVOP);
     gvop->op_type = type;
     gvop->op_ppaddr = PL_ppaddr[type];
     gvop->op_gv = (GV*)SvREFCNT_inc(gv);
@@ -2560,10 +2670,10 @@ newGVOP(I32 type, I32 flags, GV *gv)
 }
 
 OP *
-newPVOP(I32 type, I32 flags, char *pv)
+Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
 {
     PVOP *pvop;
-    Newz(1101, pvop, 1, PVOP);
+    NewOp(1101, pvop, 1, PVOP);
     pvop->op_type = type;
     pvop->op_ppaddr = PL_ppaddr[type];
     pvop->op_pv = pv;
@@ -2577,7 +2687,7 @@ newPVOP(I32 type, I32 flags, char *pv)
 }
 
 void
-package(OP *o)
+Perl_package(pTHX_ OP *o)
 {
     dTHR;
     SV *sv;
@@ -2597,12 +2707,13 @@ package(OP *o)
 	sv_setpv(PL_curstname,"<none>");
 	PL_curstash = Nullhv;
     }
+    PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
     PL_expect = XSTATE;
 }
 
 void
-utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
+Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
 {
     OP *pack;
     OP *meth;
@@ -2612,7 +2723,7 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
     GV *gv;
 
     if (id->op_type != OP_CONST)
-	croak("Module name must be constant");
+	Perl_croak(aTHX_ "Module name must be constant");
 
     veop = Nullop;
 
@@ -2627,13 +2738,13 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
 	    OP *meth;
 
 	    if (version->op_type != OP_CONST || !SvNIOK(vesv))
-		croak("Version number must be constant number");
+		Perl_croak(aTHX_ "Version number must be constant number");
 
 	    /* Make copy of id so we don't free it twice */
 	    pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
 
 	    /* Fake up a method call to VERSION */
-	    meth = newSVOP(OP_CONST, 0, newSVpv("VERSION", 7));
+	    meth = newSVOP(OP_CONST, 0, newSVpvn("VERSION", 7));
 	    veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
 			    append_elem(OP_LIST,
 			    prepend_elem(OP_LIST, pack, list(version)),
@@ -2652,8 +2763,8 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
 	pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
 	meth = newSVOP(OP_CONST, 0,
 	    aver
-		? newSVpv("import", 6)
-		: newSVpv("unimport", 8)
+		? newSVpvn("import", 6)
+		: newSVpvn("unimport", 8)
 	    );
 	imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
 		    append_elem(OP_LIST,
@@ -2679,7 +2790,7 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
 
     /* Fake up the BEGIN {}, which does its thing immediately. */
     newSUB(floor,
-	newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
+	newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
 	Nullop,
 	append_elem(OP_LINESEQ,
 	    append_elem(OP_LINESEQ,
@@ -2692,7 +2803,7 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
 }
 
 OP *
-dofile(OP *term)
+Perl_dofile(pTHX_ OP *term)
 {
     OP *doop;
     GV *gv;
@@ -2715,7 +2826,7 @@ dofile(OP *term)
 }
 
 OP *
-newSLICEOP(I32 flags, OP *subscript, OP *listval)
+Perl_newSLICEOP(pTHX_ I32 flags, OP *subscript, OP *listval)
 {
     return newBINOP(OP_LSLICE, flags,
 	    list(force_list(subscript)),
@@ -2723,7 +2834,7 @@ newSLICEOP(I32 flags, OP *subscript, OP *listval)
 }
 
 STATIC I32
-list_assignment(register OP *o)
+S_list_assignment(pTHX_ register OP *o)
 {
     if (!o)
 	return TRUE;
@@ -2757,7 +2868,7 @@ list_assignment(register OP *o)
 }
 
 OP *
-newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right)
+Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 {
     OP *o;
 
@@ -2894,13 +3005,13 @@ newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right)
 }
 
 OP *
-newSTATEOP(I32 flags, char *label, OP *o)
+Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 {
     dTHR;
     U32 seq = intro_my();
     register COP *cop;
 
-    Newz(1101, cop, 1, COP);
+    NewOp(1101, cop, 1, COP);
     if (PERLDB_LINE && PL_curcop->cop_line && PL_curstash != PL_debstash) {
 	cop->op_type = OP_DBSTATE;
 	cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ];
@@ -2953,7 +3064,7 @@ newSTATEOP(I32 flags, char *label, OP *o)
 
 /* "Introduce" my variables to visible status. */
 U32
-intro_my(void)
+Perl_intro_my(pTHX)
 {
     SV **svp;
     SV *sv;
@@ -2975,13 +3086,13 @@ intro_my(void)
 }
 
 OP *
-newLOGOP(I32 type, I32 flags, OP *first, OP *other)
+Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other)
 {
     return new_logop(type, flags, &first, &other);
 }
 
 STATIC OP *
-new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
+S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 {
     dTHR;
     LOGOP *logop;
@@ -3010,7 +3121,7 @@ new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
     }
     if (first->op_type == OP_CONST) {
 	if (ckWARN(WARN_PRECEDENCE) && (first->op_private & OPpCONST_BARE))
-	    warner(WARN_PRECEDENCE, "Probable precedence problem on %s", 
+	    Perl_warner(aTHX_ WARN_PRECEDENCE, "Probable precedence problem on %s", 
 			PL_op_desc[type]);
 	if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
 	    op_free(first);
@@ -3052,7 +3163,7 @@ new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
 	if (warnop) {
 	    line_t oldline = PL_curcop->cop_line;
 	    PL_curcop->cop_line = PL_copline;
-	    warner(WARN_UNSAFE,
+	    Perl_warner(aTHX_ WARN_UNSAFE,
 		 "Value of %s%s can be \"0\"; test with defined()",
 		 PL_op_desc[warnop],
 		 ((warnop == OP_READLINE || warnop == OP_GLOB)
@@ -3067,7 +3178,7 @@ new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
     if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
 	other->op_private |= OPpASSIGN_BACKWARDS;  /* other is an OP_SASSIGN */
 
-    Newz(1101, logop, 1, LOGOP);
+    NewOp(1101, logop, 1, LOGOP);
 
     logop->op_type = type;
     logop->op_ppaddr = PL_ppaddr[type];
@@ -3088,7 +3199,7 @@ new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
 }
 
 OP *
-newCONDOP(I32 flags, OP *first, OP *trueop, OP *falseop)
+Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
 {
     dTHR;
     CONDOP *condop;
@@ -3116,7 +3227,7 @@ newCONDOP(I32 flags, OP *first, OP *trueop, OP *falseop)
 	list(trueop);
 	scalar(falseop);
     }
-    Newz(1101, condop, 1, CONDOP);
+    NewOp(1101, condop, 1, CONDOP);
 
     condop->op_type = OP_COND_EXPR;
     condop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
@@ -3141,7 +3252,7 @@ newCONDOP(I32 flags, OP *first, OP *trueop, OP *falseop)
 }
 
 OP *
-newRANGE(I32 flags, OP *left, OP *right)
+Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
 {
     dTHR;
     CONDOP *condop;
@@ -3149,7 +3260,7 @@ newRANGE(I32 flags, OP *left, OP *right)
     OP *flop;
     OP *o;
 
-    Newz(1101, condop, 1, CONDOP);
+    NewOp(1101, condop, 1, CONDOP);
 
     condop->op_type = OP_RANGE;
     condop->op_ppaddr = PL_ppaddr[OP_RANGE];
@@ -3186,7 +3297,7 @@ newRANGE(I32 flags, OP *left, OP *right)
 }
 
 OP *
-newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block)
+Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
 {
     dTHR;
     OP* listop;
@@ -3241,7 +3352,7 @@ newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block)
 }
 
 OP *
-newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *block, OP *cont)
+Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *block, OP *cont)
 {
     dTHR;
     OP *redo;
@@ -3310,7 +3421,7 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b
 	o = listop;
 
     if (!loop) {
-	Newz(1101,loop,1,LOOP);
+	NewOp(1101,loop,1,LOOP);
 	loop->op_type = OP_ENTERLOOP;
 	loop->op_ppaddr = PL_ppaddr[OP_ENTERLOOP];
 	loop->op_private = 0;
@@ -3333,9 +3444,10 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b
 }
 
 OP *
-newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
+Perl_newFOROP(pTHX_ I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
 {
     LOOP *loop;
+    LOOP *tmp;
     OP *wop;
     int padoff = 0;
     I32 iterflags = 0;
@@ -3357,7 +3469,7 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
 	    sv = Nullop;
 	}
 	else
-	    croak("Can't use %s for loop variable", PL_op_desc[sv->op_type]);
+	    Perl_croak(aTHX_ "Can't use %s for loop variable", PL_op_desc[sv->op_type]);
     }
     else {
 #ifdef USE_THREADS
@@ -3407,7 +3519,13 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
     loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
 			       append_elem(OP_LIST, expr, scalar(sv))));
     assert(!loop->op_next);
+#ifdef PL_OP_SLAB_ALLOC
+    NewOp(1234,tmp,1,LOOP);
+    Copy(loop,tmp,1,LOOP);
+    loop = tmp;
+#else
     Renew(loop, 1, LOOP);
+#endif 
     loop->op_targ = padoff;
     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont);
     PL_copline = forline;
@@ -3415,17 +3533,19 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont
 }
 
 OP*
-newLOOPEX(I32 type, OP *label)
+Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 {
     dTHR;
     OP *o;
+    STRLEN n_a;
+
     if (type != OP_GOTO || label->op_type == OP_CONST) {
 	/* "last()" means "last" */
 	if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
 	    o = newOP(type, OPf_SPECIAL);
 	else {
 	    o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
-					? SvPVx(((SVOP*)label)->op_sv, PL_na)
+					? SvPVx(((SVOP*)label)->op_sv, n_a)
 					: ""));
 	}
 	op_free(label);
@@ -3440,7 +3560,7 @@ newLOOPEX(I32 type, OP *label)
 }
 
 void
-cv_undef(CV *cv)
+Perl_cv_undef(pTHX_ CV *cv)
 {
     dTHR;
 #ifdef USE_THREADS
@@ -3454,10 +3574,10 @@ cv_undef(CV *cv)
     if (!CvXSUB(cv) && CvROOT(cv)) {
 #ifdef USE_THREADS
 	if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
-	    croak("Can't undef active subroutine");
+	    Perl_croak(aTHX_ "Can't undef active subroutine");
 #else
 	if (CvDEPTH(cv))
-	    croak("Can't undef active subroutine");
+	    Perl_croak(aTHX_ "Can't undef active subroutine");
 #endif /* USE_THREADS */
 	ENTER;
 
@@ -3500,8 +3620,7 @@ cv_undef(CV *cv)
 
 #ifdef DEBUG_CLOSURES
 STATIC void
-cv_dump(cv)
-CV* cv;
+cv_dump(CV *cv)
 {
     CV *outside = CvOUTSIDE(cv);
     AV* padlist = CvPADLIST(cv);
@@ -3545,7 +3664,7 @@ CV* cv;
 #endif /* DEBUG_CLOSURES */
 
 STATIC CV *
-cv_clone2(CV *proto, CV *outside)
+S_cv_clone2(pTHX_ CV *proto, CV *outside)
 {
     dTHR;
     AV* av;
@@ -3615,11 +3734,11 @@ cv_clone2(CV *proto, CV *outside)
 	    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, 0);
+				      CvOUTSIDE(cv), cxstack_ix, 0, 0);
 		if (!off)
 		    PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
 		else if (off != ix)
-		    croak("panic: cv_clone: %s", name);
+		    Perl_croak(aTHX_ "panic: cv_clone: %s", name);
 	    }
 	    else {				/* our own lexical */
 		SV* sv;
@@ -3677,13 +3796,17 @@ cv_clone2(CV *proto, CV *outside)
 }
 
 CV *
-cv_clone(CV *proto)
+Perl_cv_clone(pTHX_ CV *proto)
 {
-    return cv_clone2(proto, CvOUTSIDE(proto));
+    CV *cv;
+    MUTEX_LOCK(&PL_cred_mutex);		/* XXX create separate mutex */
+    cv = cv_clone2(proto, CvOUTSIDE(proto));
+    MUTEX_UNLOCK(&PL_cred_mutex);	/* XXX create separate mutex */
+    return cv;
 }
 
 void
-cv_ckproto(CV *cv, GV *gv, char *p)
+Perl_cv_ckproto(pTHX_ CV *cv, GV *gv, char *p)
 {
     if ((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) {
 	SV* msg = sv_newmortal();
@@ -3693,20 +3816,20 @@ cv_ckproto(CV *cv, GV *gv, char *p)
 	    gv_efullname3(name = sv_newmortal(), gv, Nullch);
 	sv_setpv(msg, "Prototype mismatch:");
 	if (name)
-	    sv_catpvf(msg, " sub %_", name);
+	    Perl_sv_catpvf(aTHX_ msg, " sub %_", name);
 	if (SvPOK(cv))
-	    sv_catpvf(msg, " (%s)", SvPVX(cv));
+	    Perl_sv_catpvf(aTHX_ msg, " (%s)", SvPVX(cv));
 	sv_catpv(msg, " vs ");
 	if (p)
-	    sv_catpvf(msg, "(%s)", p);
+	    Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
 	else
 	    sv_catpv(msg, "none");
-	warn("%_", msg);
+	Perl_warn(aTHX_ "%_", msg);
     }
 }
 
 SV *
-cv_const_sv(CV *cv)
+Perl_cv_const_sv(pTHX_ CV *cv)
 {
     if (!cv || !SvPOK(cv) || SvCUR(cv))
 	return Nullsv;
@@ -3714,7 +3837,7 @@ cv_const_sv(CV *cv)
 }
 
 SV *
-op_const_sv(OP *o, CV *cv)
+Perl_op_const_sv(pTHX_ OP *o, CV *cv)
 {
     SV *sv = Nullsv;
 
@@ -3752,13 +3875,14 @@ op_const_sv(OP *o, CV *cv)
 }
 
 CV *
-newSUB(I32 floor, OP *o, OP *proto, OP *block)
+Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
 {
     dTHR;
-    char *name = o ? SvPVx(cSVOPo->op_sv, PL_na) : Nullch;
+    STRLEN n_a;
+    char *name = o ? SvPVx(cSVOPo->op_sv, n_a) : Nullch;
     GV *gv = gv_fetchpv(name ? name : "__ANON__",
 			GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
-    char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, PL_na) : Nullch;
+    char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, n_a) : Nullch;
     register CV *cv=0;
     I32 ix;
 
@@ -3771,7 +3895,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 					   maximum a prototype before. */
 	if (SvTYPE(gv) > SVt_NULL) {
 	    if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1))
-		warn("Runaway prototype");
+		Perl_warn(aTHX_ "Runaway prototype");
 	    cv_ckproto((CV*)gv, NULL, ps);
 	}
 	if (ps)
@@ -3799,7 +3923,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 	    }
 	    /* ahem, death to those who redefine active sort subs */
 	    if (PL_curstackinfo->si_type == PERLSI_SORT && PL_sortcop == CvSTART(cv))
-		croak("Can't redefine active sort subroutine %s", name);
+		Perl_croak(aTHX_ "Can't redefine active sort subroutine %s", name);
 	    if(const_sv = cv_const_sv(cv))
 		const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
 	    if ((const_sv && const_changed) || ckWARN(WARN_REDEFINE) 
@@ -3809,7 +3933,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 						 "autouse"))) {
 		line_t oldline = PL_curcop->cop_line;
 		PL_curcop->cop_line = PL_copline;
-		warner(WARN_REDEFINE,
+		Perl_warner(aTHX_ WARN_REDEFINE,
 			const_sv ? "Constant subroutine %s redefined"
 		                 : "Subroutine %s redefined", name);
 		PL_curcop->cop_line = oldline;
@@ -3860,12 +3984,12 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 	    if (strEQ(s, "BEGIN")) {
 		char *not_safe =
 		    "BEGIN not safe after errors--compilation aborted";
-		if (PL_in_eval & 4)
-		    croak(not_safe);
+		if (PL_in_eval & EVAL_KEEPERR)
+		    Perl_croak(aTHX_ not_safe);
 		else {
 		    /* force display of errors found but not reported */
 		    sv_catpv(ERRSV, not_safe);
-		    croak("%s", SvPVx(ERRSV, PL_na));
+		    Perl_croak(aTHX_ "%s", SvPVx(ERRSV, n_a));
 		}
 	    }
 	}
@@ -3931,7 +4055,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 	    CV *cv;
 	    HV *hv;
 
-	    sv_setpvf(sv, "%_:%ld-%ld",
+	    Perl_sv_setpvf(aTHX_ sv, "%_:%ld-%ld",
 		    GvSV(PL_curcop->cop_filegv),
 		    (long)PL_subline, (long)PL_curcop->cop_line);
 	    gv_efullname3(tmpstr, gv, Nullch);
@@ -3943,7 +4067,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
 		PUSHMARK(SP);
 		XPUSHs(tmpstr);
 		PUTBACK;
-		perl_call_sv((SV*)cv, G_DISCARD);
+		call_sv((SV*)cv, G_DISCARD);
 	    }
 	}
 
@@ -3991,8 +4115,9 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
     return cv;
 }
 
+/* XXX unsafe for threads if eval_owner isn't held */
 void
-newCONSTSUB(HV *stash, char *name, SV *sv)
+Perl_newCONSTSUB(pTHX_ HV *stash, char *name, SV *sv)
 {
     dTHR;
     U32 oldhints = PL_hints;
@@ -4019,7 +4144,7 @@ newCONSTSUB(HV *stash, char *name, SV *sv)
 }
 
 CV *
-newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
+Perl_newXS(pTHX_ char *name, XSUBADDR_t subaddr, char *filename)
 {
     dTHR;
     GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
@@ -4039,7 +4164,7 @@ newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
 		line_t oldline = PL_curcop->cop_line;
 		if (PL_copline != NOLINE)
 		    PL_curcop->cop_line = PL_copline;
-		warner(WARN_REDEFINE, "Subroutine %s redefined",name);
+		Perl_warner(aTHX_ WARN_REDEFINE, "Subroutine %s redefined",name);
 		PL_curcop->cop_line = oldline;
 	    }
 	    SvREFCNT_dec(cv);
@@ -4100,16 +4225,17 @@ newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
 }
 
 void
-newFORM(I32 floor, OP *o, OP *block)
+Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 {
     dTHR;
     register CV *cv;
     char *name;
     GV *gv;
     I32 ix;
+    STRLEN n_a;
 
     if (o)
-	name = SvPVx(cSVOPo->op_sv, PL_na);
+	name = SvPVx(cSVOPo->op_sv, n_a);
     else
 	name = "STDOUT";
     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
@@ -4119,7 +4245,7 @@ newFORM(I32 floor, OP *o, OP *block)
 	    line_t oldline = PL_curcop->cop_line;
 
 	    PL_curcop->cop_line = PL_copline;
-	    warner(WARN_REDEFINE, "Format %s redefined",name);
+	    Perl_warner(aTHX_ WARN_REDEFINE, "Format %s redefined",name);
 	    PL_curcop->cop_line = oldline;
 	}
 	SvREFCNT_dec(cv);
@@ -4144,28 +4270,28 @@ newFORM(I32 floor, OP *o, OP *block)
 }
 
 OP *
-newANONLIST(OP *o)
+Perl_newANONLIST(pTHX_ OP *o)
 {
     return newUNOP(OP_REFGEN, 0,
 	mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
 }
 
 OP *
-newANONHASH(OP *o)
+Perl_newANONHASH(pTHX_ OP *o)
 {
     return newUNOP(OP_REFGEN, 0,
 	mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
 }
 
 OP *
-newANONSUB(I32 floor, OP *proto, OP *block)
+Perl_newANONSUB(pTHX_ I32 floor, OP *proto, OP *block)
 {
     return newUNOP(OP_REFGEN, 0,
 	newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
 }
 
 OP *
-oopsAV(OP *o)
+Perl_oopsAV(pTHX_ OP *o)
 {
     switch (o->op_type) {
     case OP_PADSV:
@@ -4180,14 +4306,14 @@ oopsAV(OP *o)
 	break;
 
     default:
-	warn("oops: oopsAV");
+	Perl_warn(aTHX_ "oops: oopsAV");
 	break;
     }
     return o;
 }
 
 OP *
-oopsHV(OP *o)
+Perl_oopsHV(pTHX_ OP *o)
 {
     switch (o->op_type) {
     case OP_PADSV:
@@ -4204,14 +4330,14 @@ oopsHV(OP *o)
 	break;
 
     default:
-	warn("oops: oopsHV");
+	Perl_warn(aTHX_ "oops: oopsHV");
 	break;
     }
     return o;
 }
 
 OP *
-newAVREF(OP *o)
+Perl_newAVREF(pTHX_ OP *o)
 {
     if (o->op_type == OP_PADANY) {
 	o->op_type = OP_PADAV;
@@ -4222,15 +4348,15 @@ newAVREF(OP *o)
 }
 
 OP *
-newGVREF(I32 type, OP *o)
+Perl_newGVREF(pTHX_ I32 type, OP *o)
 {
-    if (type == OP_MAPSTART)
+    if (type == OP_MAPSTART || type == OP_GREPSTART || type == OP_SORT)
 	return newUNOP(OP_NULL, 0, o);
     return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
 }
 
 OP *
-newHVREF(OP *o)
+Perl_newHVREF(pTHX_ OP *o)
 {
     if (o->op_type == OP_PADANY) {
 	o->op_type = OP_PADHV;
@@ -4241,21 +4367,21 @@ newHVREF(OP *o)
 }
 
 OP *
-oopsCV(OP *o)
+Perl_oopsCV(pTHX_ OP *o)
 {
-    croak("NOT IMPL LINE %d",__LINE__);
+    Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
     /* STUB */
     return o;
 }
 
 OP *
-newCVREF(I32 flags, OP *o)
+Perl_newCVREF(pTHX_ I32 flags, OP *o)
 {
     return newUNOP(OP_RV2CV, flags, scalar(o));
 }
 
 OP *
-newSVREF(OP *o)
+Perl_newSVREF(pTHX_ OP *o)
 {
     if (o->op_type == OP_PADANY) {
 	o->op_type = OP_PADSV;
@@ -4272,7 +4398,7 @@ newSVREF(OP *o)
 /* Check routines. */
 
 OP *
-ck_anoncode(OP *o)
+Perl_ck_anoncode(pTHX_ OP *o)
 {
     PADOFFSET ix;
     SV* name;
@@ -4292,14 +4418,14 @@ ck_anoncode(OP *o)
 }
 
 OP *
-ck_bitop(OP *o)
+Perl_ck_bitop(pTHX_ OP *o)
 {
     o->op_private = PL_hints;
     return o;
 }
 
 OP *
-ck_concat(OP *o)
+Perl_ck_concat(pTHX_ OP *o)
 {
     if (cUNOPo->op_first->op_type == OP_CONCAT)
 	o->op_flags |= OPf_STACKED;
@@ -4307,7 +4433,7 @@ ck_concat(OP *o)
 }
 
 OP *
-ck_spair(OP *o)
+Perl_ck_spair(pTHX_ OP *o)
 {
     if (o->op_flags & OPf_KIDS) {
 	OP* newop;
@@ -4332,7 +4458,7 @@ ck_spair(OP *o)
 }
 
 OP *
-ck_delete(OP *o)
+Perl_ck_delete(pTHX_ OP *o)
 {
     o = ck_fun(o);
     o->op_private = 0;
@@ -4341,7 +4467,7 @@ ck_delete(OP *o)
 	if (kid->op_type == OP_HSLICE)
 	    o->op_private |= OPpSLICE;
 	else if (kid->op_type != OP_HELEM)
-	    croak("%s argument is not a HASH element or slice",
+	    Perl_croak(aTHX_ "%s argument is not a HASH element or slice",
 		  PL_op_desc[o->op_type]);
 	null(kid);
     }
@@ -4349,7 +4475,7 @@ ck_delete(OP *o)
 }
 
 OP *
-ck_eof(OP *o)
+Perl_ck_eof(pTHX_ OP *o)
 {
     I32 type = o->op_type;
 
@@ -4365,7 +4491,7 @@ ck_eof(OP *o)
 }
 
 OP *
-ck_eval(OP *o)
+Perl_ck_eval(pTHX_ OP *o)
 {
     PL_hints |= HINT_BLOCK_SCOPE;
     if (o->op_flags & OPf_KIDS) {
@@ -4382,7 +4508,7 @@ ck_eval(OP *o)
 	    cUNOPo->op_first = 0;
 	    op_free(o);
 
-	    Newz(1101, enter, 1, LOGOP);
+	    NewOp(1101, enter, 1, LOGOP);
 	    enter->op_type = OP_ENTERTRY;
 	    enter->op_ppaddr = PL_ppaddr[OP_ENTERTRY];
 	    enter->op_private = 0;
@@ -4408,7 +4534,7 @@ ck_eval(OP *o)
 }
 
 OP *
-ck_exec(OP *o)
+Perl_ck_exec(pTHX_ OP *o)
 {
     OP *kid;
     if (o->op_flags & OPf_STACKED) {
@@ -4423,13 +4549,13 @@ ck_exec(OP *o)
 }
 
 OP *
-ck_exists(OP *o)
+Perl_ck_exists(pTHX_ OP *o)
 {
     o = ck_fun(o);
     if (o->op_flags & OPf_KIDS) {
 	OP *kid = cUNOPo->op_first;
 	if (kid->op_type != OP_HELEM)
-	    croak("%s argument is not a HASH element", PL_op_desc[o->op_type]);
+	    Perl_croak(aTHX_ "%s argument is not a HASH element", PL_op_desc[o->op_type]);
 	null(kid);
     }
     return o;
@@ -4437,7 +4563,7 @@ ck_exists(OP *o)
 
 #if 0
 OP *
-ck_gvconst(register OP *o)
+Perl_ck_gvconst(pTHX_ register OP *o)
 {
     o = fold_constants(o);
     if (o->op_type == OP_CONST)
@@ -4447,7 +4573,7 @@ ck_gvconst(register OP *o)
 #endif
 
 OP *
-ck_rvconst(register OP *o)
+Perl_ck_rvconst(pTHX_ register OP *o)
 {
     dTHR;
     SVOP *kid = (SVOP*)cUNOPo->op_first;
@@ -4458,6 +4584,7 @@ ck_rvconst(register OP *o)
 	int iscv;
 	GV *gv;
 	SV *kidsv = kid->op_sv;
+	STRLEN n_a;
 
 	/* Is it a constant from cv_const_sv()? */
 	if (SvROK(kidsv) && SvREADONLY(kidsv)) {
@@ -4493,10 +4620,10 @@ ck_rvconst(register OP *o)
 		break;
 	    }
 	    if (badtype)
-		croak("Constant is not %s reference", badtype);
+		Perl_croak(aTHX_ "Constant is not %s reference", badtype);
 	    return o;
 	}
-	name = SvPV(kidsv, PL_na);
+	name = SvPV(kidsv, n_a);
 	if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
 	    char *badthing = Nullch;
 	    switch (o->op_type) {
@@ -4511,7 +4638,7 @@ ck_rvconst(register OP *o)
 		break;
 	    }
 	    if (badthing)
-		croak(
+		Perl_croak(aTHX_ 
 	  "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
 		      name, badthing);
 	}
@@ -4547,7 +4674,7 @@ ck_rvconst(register OP *o)
 }
 
 OP *
-ck_ftst(OP *o)
+Perl_ck_ftst(pTHX_ OP *o)
 {
     dTHR;
     I32 type = o->op_type;
@@ -4559,8 +4686,9 @@ ck_ftst(OP *o)
 	SVOP *kid = (SVOP*)cUNOPo->op_first;
 
 	if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+	    STRLEN n_a;
 	    OP *newop = newGVOP(type, OPf_REF,
-		gv_fetchpv(SvPVx(kid->op_sv, PL_na), TRUE, SVt_PVIO));
+		gv_fetchpv(SvPVx(kid->op_sv, n_a), TRUE, SVt_PVIO));
 	    op_free(o);
 	    return newop;
 	}
@@ -4577,7 +4705,7 @@ ck_ftst(OP *o)
 }
 
 OP *
-ck_fun(OP *o)
+Perl_ck_fun(pTHX_ OP *o)
 {
     dTHR;
     register OP *kid;
@@ -4595,6 +4723,7 @@ ck_fun(OP *o)
     }
 
     if (o->op_flags & OPf_KIDS) {
+	STRLEN n_a;
 	tokid = &cLISTOPo->op_first;
 	kid = cLISTOPo->op_first;
 	if (kid->op_type == OP_PUSHMARK ||
@@ -4611,6 +4740,12 @@ ck_fun(OP *o)
 	    sibl = kid->op_sibling;
 	    switch (oa & 7) {
 	    case OA_SCALAR:
+		/* list seen where single (scalar) arg expected? */
+		if (numargs == 1 && !(oa >> 4)
+		    && kid->op_type == OP_LIST && type != OP_SCALAR)
+		{
+		    return too_many_arguments(o,PL_op_desc[type]);
+		}
 		scalar(kid);
 		break;
 	    case OA_LIST:
@@ -4623,12 +4758,13 @@ ck_fun(OP *o)
 		break;
 	    case OA_AVREF:
 		if (kid->op_type == OP_CONST &&
-		  (kid->op_private & OPpCONST_BARE)) {
-		    char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
+		    (kid->op_private & OPpCONST_BARE))
+		{
+		    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
 		    OP *newop = newAVREF(newGVOP(OP_GV, 0,
 			gv_fetchpv(name, TRUE, SVt_PVAV) ));
 		    if (ckWARN(WARN_SYNTAX))
-			warner(WARN_SYNTAX,
+			Perl_warner(aTHX_ WARN_SYNTAX,
 			    "Array @%s missing the @ in argument %ld of %s()",
 			    name, (long)numargs, PL_op_desc[type]);
 		    op_free(kid);
@@ -4637,17 +4773,18 @@ ck_fun(OP *o)
 		    *tokid = kid;
 		}
 		else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
-		    bad_type(numargs, "array", PL_op_desc[o->op_type], kid);
+		    bad_type(numargs, "array", PL_op_desc[type], kid);
 		mod(kid, type);
 		break;
 	    case OA_HVREF:
 		if (kid->op_type == OP_CONST &&
-		  (kid->op_private & OPpCONST_BARE)) {
-		    char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
+		    (kid->op_private & OPpCONST_BARE))
+		{
+		    char *name = SvPVx(((SVOP*)kid)->op_sv, n_a);
 		    OP *newop = newHVREF(newGVOP(OP_GV, 0,
 			gv_fetchpv(name, TRUE, SVt_PVHV) ));
 		    if (ckWARN(WARN_SYNTAX))
-			warner(WARN_SYNTAX,
+			Perl_warner(aTHX_ WARN_SYNTAX,
 			    "Hash %%%s missing the %% in argument %ld of %s()",
 			    name, (long)numargs, PL_op_desc[type]);
 		    op_free(kid);
@@ -4656,7 +4793,7 @@ ck_fun(OP *o)
 		    *tokid = kid;
 		}
 		else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
-		    bad_type(numargs, "hash", PL_op_desc[o->op_type], kid);
+		    bad_type(numargs, "hash", PL_op_desc[type], kid);
 		mod(kid, type);
 		break;
 	    case OA_CVREF:
@@ -4673,9 +4810,10 @@ ck_fun(OP *o)
 	    case OA_FILEREF:
 		if (kid->op_type != OP_GV && kid->op_type != OP_RV2GV) {
 		    if (kid->op_type == OP_CONST &&
-		      (kid->op_private & OPpCONST_BARE)) {
+			(kid->op_private & OPpCONST_BARE))
+		    {
 			OP *newop = newGVOP(OP_GV, 0,
-			    gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, PL_na), TRUE,
+			    gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, n_a), TRUE,
 					SVt_PVIO) );
 			op_free(kid);
 			kid = newop;
@@ -4685,8 +4823,28 @@ ck_fun(OP *o)
 			bad_type(numargs, "HANDLE", PL_op_desc[o->op_type], kid);
 		    }
 		    else {
+			I32 flags = OPf_SPECIAL;
+			I32 priv = 0;
+			/* is this op a FH constructor? */
+			if (is_handle_constructor(o,numargs)) {
+			    flags   = 0;                         
+			    /* Set a flag to tell rv2gv to vivify 
+			     * need to "prove" flag does not mean something
+			     * else already - NI-S 1999/05/07
+			     */ 
+			    priv = OPpDEREF; 
+#if 0
+			    /* Helps with open($array[$n],...) 
+			       but is too simplistic - need to do selectively
+			    */
+			    mod(kid,type);
+#endif
+			}
 			kid->op_sibling = 0;
-			kid = newUNOP(OP_RV2GV, 0, scalar(kid));
+			kid = newUNOP(OP_RV2GV, flags, scalar(kid));
+			if (priv) {
+			    kid->op_private |= priv;
+			}
 		    }
 		    kid->op_sibling = sibl;
 		    *tokid = kid;
@@ -4721,7 +4879,7 @@ ck_fun(OP *o)
 }
 
 OP *
-ck_glob(OP *o)
+Perl_ck_glob(pTHX_ OP *o)
 {
     GV *gv;
 
@@ -4732,10 +4890,8 @@ ck_glob(OP *o)
 	gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
 
     if (gv && GvIMPORTED_CV(gv)) {
-	static int glob_index;
-
 	append_elem(OP_GLOB, o,
-		    newSVOP(OP_CONST, 0, newSViv(glob_index++)));
+		    newSVOP(OP_CONST, 0, newSViv(PL_glob_index++)));
 	o->op_type = OP_LIST;
 	o->op_ppaddr = PL_ppaddr[OP_LIST];
 	cLISTOPo->op_first->op_type = OP_PUSHMARK;
@@ -4756,14 +4912,14 @@ ck_glob(OP *o)
 }
 
 OP *
-ck_grep(OP *o)
+Perl_ck_grep(pTHX_ OP *o)
 {
     LOGOP *gwop;
     OP *kid;
     OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
 
     o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
-    Newz(1101, gwop, 1, LOGOP);
+    NewOp(1101, gwop, 1, LOGOP);
 
     if (o->op_flags & OPf_STACKED) {
 	OP* k;
@@ -4785,7 +4941,7 @@ ck_grep(OP *o)
 	return o;
     kid = cLISTOPo->op_first->op_sibling;
     if (kid->op_type != OP_NULL)
-	croak("panic: ck_grep");
+	Perl_croak(aTHX_ "panic: ck_grep");
     kid = kUNOP->op_first;
 
     gwop->op_type = type;
@@ -4807,7 +4963,7 @@ ck_grep(OP *o)
 }
 
 OP *
-ck_index(OP *o)
+Perl_ck_index(pTHX_ OP *o)
 {
     if (o->op_flags & OPf_KIDS) {
 	OP *kid = cLISTOPo->op_first->op_sibling;	/* get past pushmark */
@@ -4820,28 +4976,53 @@ ck_index(OP *o)
 }
 
 OP *
-ck_lengthconst(OP *o)
+Perl_ck_lengthconst(pTHX_ OP *o)
 {
     /* XXX length optimization goes here */
     return ck_fun(o);
 }
 
 OP *
-ck_lfun(OP *o)
+Perl_ck_lfun(pTHX_ OP *o)
 {
     OPCODE type = o->op_type;
     return modkids(ck_fun(o), type);
 }
 
 OP *
-ck_rfun(OP *o)
+Perl_ck_defined(pTHX_ OP *o)		/* 19990527 MJD */
+{
+    dTHR;
+    if (ckWARN(WARN_DEPRECATED) && (o->op_flags & OPf_KIDS)) {
+      switch (cUNOPo->op_first->op_type) {
+      case OP_RV2AV:
+      case OP_PADAV:
+      case OP_AASSIGN:		/* Is this a good idea? */
+	Perl_warner(aTHX_ WARN_DEPRECATED, "defined(@array) is deprecated (and not really meaningful)");
+	Perl_warner(aTHX_ WARN_DEPRECATED, "(Maybe you should just omit the defined()?)\n");
+	break;
+      case OP_RV2HV:
+      case OP_PADHV:
+	Perl_warner(aTHX_ WARN_DEPRECATED, "defined(%hash) is deprecated (and not really meaningful)");
+	Perl_warner(aTHX_ WARN_DEPRECATED, "(Maybe you should just omit the defined()?)\n");
+	break;
+      default:
+	/* no warning */
+	break;
+      }
+    }
+    return ck_rfun(o);
+}
+
+OP *
+Perl_ck_rfun(pTHX_ OP *o)
 {
     OPCODE type = o->op_type;
     return refkids(ck_fun(o), type);
 }
 
 OP *
-ck_listiob(OP *o)
+Perl_ck_listiob(pTHX_ OP *o)
 {
     register OP *kid;
 
@@ -4879,7 +5060,7 @@ ck_listiob(OP *o)
 }
 
 OP *
-ck_fun_locale(OP *o)
+Perl_ck_fun_locale(pTHX_ OP *o)
 {
     o = ck_fun(o);
 
@@ -4893,7 +5074,7 @@ ck_fun_locale(OP *o)
 }
 
 OP *
-ck_scmp(OP *o)
+Perl_ck_scmp(pTHX_ OP *o)
 {
     o->op_private = 0;
 #ifdef USE_LOCALE
@@ -4905,20 +5086,20 @@ ck_scmp(OP *o)
 }
 
 OP *
-ck_match(OP *o)
+Perl_ck_match(pTHX_ OP *o)
 {
     o->op_private |= OPpRUNTIME;
     return o;
 }
 
 OP *
-ck_null(OP *o)
+Perl_ck_null(pTHX_ OP *o)
 {
     return o;
 }
 
 OP *
-ck_repeat(OP *o)
+Perl_ck_repeat(pTHX_ OP *o)
 {
     if (cBINOPo->op_first->op_flags & OPf_PARENS) {
 	o->op_private |= OPpREPEAT_DOLIST;
@@ -4930,7 +5111,7 @@ ck_repeat(OP *o)
 }
 
 OP *
-ck_require(OP *o)
+Perl_ck_require(pTHX_ OP *o)
 {
     if (o->op_flags & OPf_KIDS) {	/* Shall we supply missing .pm? */
 	SVOP *kid = (SVOP*)cUNOPo->op_first;
@@ -4952,16 +5133,16 @@ ck_require(OP *o)
 
 #if 0
 OP *
-ck_retarget(OP *o)
+Perl_ck_retarget(pTHX_ OP *o)
 {
-    croak("NOT IMPL LINE %d",__LINE__);
+    Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
     /* STUB */
     return o;
 }
 #endif
 
 OP *
-ck_select(OP *o)
+Perl_ck_select(pTHX_ OP *o)
 {
     OP* kid;
     if (o->op_flags & OPf_KIDS) {
@@ -4981,7 +5162,7 @@ ck_select(OP *o)
 }
 
 OP *
-ck_shift(OP *o)
+Perl_ck_shift(pTHX_ OP *o)
 {
     I32 type = o->op_type;
 
@@ -5010,7 +5191,7 @@ ck_shift(OP *o)
 }
 
 OP *
-ck_sort(OP *o)
+Perl_ck_sort(pTHX_ OP *o)
 {
     o->op_private = 0;
 #ifdef USE_LOCALE
@@ -5018,10 +5199,12 @@ ck_sort(OP *o)
 	o->op_private |= OPpLOCALE;
 #endif
 
-    if (o->op_flags & OPf_STACKED) {
+    if (o->op_type == OP_SORT && o->op_flags & OPf_STACKED)
+	simplify_sort(o);
+    if (o->op_flags & OPf_STACKED) {		     /* may have been cleared */
 	OP *kid = cLISTOPo->op_first->op_sibling;	/* get past pushmark */
 	OP *k;
-	kid = kUNOP->op_first;				/* get past rv2gv */
+	kid = kUNOP->op_first;				/* get past null */
 
 	if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
 	    linklist(kid);
@@ -5046,7 +5229,6 @@ ck_sort(OP *o)
 	    peep(k);
 
 	    kid = cLISTOPo->op_first->op_sibling;	/* get past pushmark */
-	    null(kid);					/* wipe out rv2gv */
 	    if (o->op_type == OP_SORT)
 		kid->op_next = kid;
 	    else
@@ -5060,8 +5242,70 @@ ck_sort(OP *o)
     return o;
 }
 
+STATIC void
+S_simplify_sort(pTHX_ OP *o)
+{
+    dTHR;
+    register OP *kid = cLISTOPo->op_first->op_sibling;	/* get past pushmark */
+    OP *k;
+    int reversed;
+    if (!(o->op_flags & OPf_STACKED))
+	return;
+    GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV)); 
+    GvMULTI_on(gv_fetchpv("b", TRUE, SVt_PV)); 
+    kid = kUNOP->op_first;				/* get past null */
+    if (kid->op_type != OP_SCOPE)
+	return;
+    kid = kLISTOP->op_last;				/* get past scope */
+    switch(kid->op_type) {
+	case OP_NCMP:
+	case OP_I_NCMP:
+	case OP_SCMP:
+	    break;
+	default:
+	    return;
+    }
+    k = kid;						/* remember this node*/
+    if (kBINOP->op_first->op_type != OP_RV2SV)
+	return;
+    kid = kBINOP->op_first;				/* get past cmp */
+    if (kUNOP->op_first->op_type != OP_GV)
+	return;
+    kid = kUNOP->op_first;				/* get past rv2sv */
+    if (GvSTASH(kGVOP->op_gv) != PL_curstash)
+	return;
+    if (strEQ(GvNAME(kGVOP->op_gv), "a"))
+	reversed = 0;
+    else if(strEQ(GvNAME(kGVOP->op_gv), "b"))
+	reversed = 1;
+    else
+	return;
+    kid = k;						/* back to cmp */
+    if (kBINOP->op_last->op_type != OP_RV2SV)
+	return;
+    kid = kBINOP->op_last;				/* down to 2nd arg */
+    if (kUNOP->op_first->op_type != OP_GV)
+	return;
+    kid = kUNOP->op_first;				/* get past rv2sv */
+    if (GvSTASH(kGVOP->op_gv) != PL_curstash
+	|| ( reversed
+	    ? strNE(GvNAME(kGVOP->op_gv), "a")
+	    : strNE(GvNAME(kGVOP->op_gv), "b")))
+	return;
+    o->op_flags &= ~(OPf_STACKED | OPf_SPECIAL);
+    if (reversed)
+	o->op_private |= OPpSORT_REVERSE;
+    if (k->op_type == OP_NCMP)
+	o->op_private |= OPpSORT_NUMERIC;
+    if (k->op_type == OP_I_NCMP)
+	o->op_private |= OPpSORT_NUMERIC | OPpSORT_INTEGER;
+    op_free(cLISTOPo->op_first->op_sibling);	/* delete comparison block */
+    cLISTOPo->op_first->op_sibling = cLISTOPo->op_last;
+    cLISTOPo->op_children = 1;
+}
+
 OP *
-ck_split(OP *o)
+Perl_ck_split(pTHX_ OP *o)
 {
     register OP *kid;
 
@@ -5070,12 +5314,12 @@ ck_split(OP *o)
 
     kid = cLISTOPo->op_first;
     if (kid->op_type != OP_NULL)
-	croak("panic: ck_split");
+	Perl_croak(aTHX_ "panic: ck_split");
     kid = kid->op_sibling;
     op_free(cLISTOPo->op_first);
     cLISTOPo->op_first = kid;
     if (!kid) {
-	cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
+	cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpvn(" ", 1));
 	cLISTOPo->op_last = kid; /* There was only one element previously */
     }
 
@@ -5112,7 +5356,7 @@ ck_split(OP *o)
 }
 
 OP *
-ck_subr(OP *o)
+Perl_ck_subr(pTHX_ OP *o)
 {
     dTHR;
     OP *prev = ((cUNOPo->op_first->op_sibling)
@@ -5124,6 +5368,7 @@ ck_subr(OP *o)
     GV *namegv = 0;
     int optional = 0;
     I32 arg = 0;
+    STRLEN n_a;
 
     for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
     if (cvop->op_type == OP_RV2CV) {
@@ -5135,10 +5380,19 @@ ck_subr(OP *o)
 	    cv = GvCVu(tmpop->op_sv);
 	    if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
 		namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
-		proto = SvPV((SV*)cv, PL_na);
+		proto = SvPV((SV*)cv, n_a);
 	    }
 	}
     }
+    else if (cvop->op_type == OP_METHOD) {
+	if (o2->op_type == OP_CONST)
+	    o2->op_private &= ~OPpCONST_STRICT;
+	else if (o2->op_type == OP_LIST) {
+	    OP *o = ((UNOP*)o2)->op_first->op_sibling;
+	    if (o && o->op_type == OP_CONST)
+		o->op_private &= ~OPpCONST_STRICT;
+	}
+    }
     o->op_private |= (PL_hints & HINT_STRICT_REFS);
     if (PERLDB_SUB && PL_curstash != PL_debstash)
 	o->op_private |= OPpENTERSUB_DB;
@@ -5168,19 +5422,42 @@ ck_subr(OP *o)
 		    bad_type(arg, "block", gv_ename(namegv), o2);
 		break;
 	    case '*':
+		/* '*' allows any scalar type, including bareword */
 		proto++;
 		arg++;
 		if (o2->op_type == OP_RV2GV)
-		    goto wrapref;
-		{
-		    OP* kid = o2;
-		    OP* sib = kid->op_sibling;
-		    kid->op_sibling = 0;
-		    o2 = newUNOP(OP_RV2GV, 0, kid);
-		    o2->op_sibling = sib;
-		    prev->op_sibling = o2;
+		    goto wrapref;	/* autoconvert GLOB -> GLOBref */
+		else if (o2->op_type == OP_CONST)
+		    o2->op_private &= ~OPpCONST_STRICT;
+		else if (o2->op_type == OP_ENTERSUB) {
+		    /* accidental subroutine, revert to bareword */
+		    OP *gvop = ((UNOP*)o2)->op_first;
+		    if (gvop && gvop->op_type == OP_NULL) {
+			gvop = ((UNOP*)gvop)->op_first;
+			if (gvop) {
+			    for (; gvop->op_sibling; gvop = gvop->op_sibling)
+				;
+			    if (gvop &&
+				(gvop->op_private & OPpENTERSUB_NOPAREN) &&
+				(gvop = ((UNOP*)gvop)->op_first) &&
+				gvop->op_type == OP_GV)
+			    {
+				GV *gv = (GV*)((SVOP*)gvop)->op_sv;
+				OP *sibling = o2->op_sibling;
+				SV *n = newSVpvn("",0);
+				op_free(o2);
+				gv_fullname3(n, gv, "");
+				if (SvCUR(n)>6 && strnEQ(SvPVX(n),"main::",6))
+				    sv_chop(n, SvPVX(n)+6);
+				o2 = newSVOP(OP_CONST, 0, n);
+				prev->op_sibling = o2;
+				o2->op_sibling = sibling;
+			    }
+			}
+		    }
 		}
-		goto wrapref;
+		scalar(o2);
+		break;
 	    case '\\':
 		proto++;
 		arg++;
@@ -5226,8 +5503,8 @@ ck_subr(OP *o)
 		continue;
 	    default:
 	      oops:
-		croak("Malformed prototype for %s: %s",
-			gv_ename(namegv), SvPV((SV*)cv, PL_na));
+		Perl_croak(aTHX_ "Malformed prototype for %s: %s",
+			gv_ename(namegv), SvPV((SV*)cv, n_a));
 	    }
 	}
 	else
@@ -5243,23 +5520,26 @@ ck_subr(OP *o)
 }
 
 OP *
-ck_svconst(OP *o)
+Perl_ck_svconst(pTHX_ OP *o)
 {
     SvREADONLY_on(cSVOPo->op_sv);
     return o;
 }
 
 OP *
-ck_trunc(OP *o)
+Perl_ck_trunc(pTHX_ OP *o)
 {
     if (o->op_flags & OPf_KIDS) {
 	SVOP *kid = (SVOP*)cUNOPo->op_first;
 
 	if (kid->op_type == OP_NULL)
 	    kid = (SVOP*)kid->op_sibling;
-	if (kid &&
-	  kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
+	if (kid && kid->op_type == OP_CONST &&
+	    (kid->op_private & OPpCONST_BARE))
+	{
 	    o->op_flags |= OPf_SPECIAL;
+	    kid->op_private &= ~OPpCONST_STRICT;
+	}
     }
     return ck_fun(o);
 }
@@ -5267,10 +5547,12 @@ ck_trunc(OP *o)
 /* A peephole optimizer.  We visit the ops in the order they're to execute. */
 
 void
-peep(register OP *o)
+Perl_peep(pTHX_ register OP *o)
 {
     dTHR;
     register OP* oldop = 0;
+    STRLEN n_a;
+
     if (!o || o->op_seq)
 	return;
     ENTER;
@@ -5289,8 +5571,11 @@ peep(register OP *o)
 	    o->op_seq = PL_op_seqmax++;
 	    break;
 
-	case OP_CONCAT:
 	case OP_CONST:
+	    if (cSVOPo->op_private & OPpCONST_STRICT)
+		no_bareword_allowed(o);
+	    /* FALL THROUGH */
+	case OP_CONCAT:
 	case OP_JOIN:
 	case OP_UC:
 	case OP_UCFIRST:
@@ -5400,8 +5685,8 @@ peep(register OP *o)
 		    line_t oldline = PL_curcop->cop_line;
 
 		    PL_curcop->cop_line = ((COP*)o->op_next)->cop_line;
-		    warner(WARN_SYNTAX, "Statement unlikely to be reached");
-		    warner(WARN_SYNTAX, "(Maybe you meant system() when you said exec()?)\n");
+		    Perl_warner(aTHX_ WARN_SYNTAX, "Statement unlikely to be reached");
+		    Perl_warner(aTHX_ WARN_SYNTAX, "(Maybe you meant system() when you said exec()?)\n");
 		    PL_curcop->cop_line = oldline;
 		}
 	    }
@@ -5416,7 +5701,7 @@ peep(register OP *o)
 	    char *key;
 	    STRLEN keylen;
 	
-	    if (o->op_private & (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)
+	    if ((o->op_private & (OPpLVAL_INTRO))
 		|| ((BINOP*)o)->op_last->op_type != OP_CONST)
 		break;
 	    rop = (UNOP*)((BINOP*)o)->op_first;
@@ -5432,12 +5717,12 @@ peep(register OP *o)
 	    key = SvPV(*svp, keylen);
 	    indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
 	    if (!indsvp) {
-		croak("No such field \"%s\" in variable %s of type %s",
-		      key, SvPV(lexname, PL_na), HvNAME(SvSTASH(lexname)));
+		Perl_croak(aTHX_ "No such field \"%s\" in variable %s of type %s",
+		      key, SvPV(lexname, n_a), HvNAME(SvSTASH(lexname)));
 	    }
 	    ind = SvIV(*indsvp);
 	    if (ind < 1)
-		croak("Bad index while coercing array into hash");
+		Perl_croak(aTHX_ "Bad index while coercing array into hash");
 	    rop->op_type = OP_RV2AV;
 	    rop->op_ppaddr = PL_ppaddr[OP_RV2AV];
 	    o->op_type = OP_AELEM;