X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=28ea26dd38e8ac2e31d71d7d4ca5373c0e33b0a9;hb=0a5d5e8be390bda2f9b7684490082d428228d28f;hp=c5c32bf0e39b530bcaf82f34574b8b3c1b14b44a;hpb=d1f3fb15f579862f85c82ed69eba4baa20281b3c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/toke.c b/toke.c
index c5c32bf..28ea26d 100644
--- a/toke.c
+++ b/toke.c
@@ -66,6 +66,8 @@ static struct {
  * can get by with a single comparison (if the compiler is smart enough).
  */
 
+/* #define LEX_NOTPARSING		11 is done in perl.h. */
+
 #define LEX_NORMAL		10
 #define LEX_INTERPNORMAL	 9
 #define LEX_INTERPCASEMOD	 8
@@ -142,8 +144,7 @@ static struct {
 #define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP)
 
 static int
-ao(toketype)
-int toketype;
+ao(int toketype)
 {
     if (*bufptr == '=') {
 	bufptr++;
@@ -157,9 +158,7 @@ int toketype;
 }
 
 static void
-no_op(what, s)
-char *what;
-char *s;
+no_op(char *what, char *s)
 {
     char *oldbp = bufptr;
     bool is_first = (oldbufptr == linestart);
@@ -182,8 +181,7 @@ char *s;
 }
 
 static void
-missingterm(s)
-char *s;
+missingterm(char *s)
 {
     char tmpbuf[3];
     char q;
@@ -209,23 +207,22 @@ char *s;
 }
 
 void
-deprecate(s)
-char *s;
+deprecate(char *s)
 {
     if (dowarn)
 	warn("Use of %s is deprecated", s);
 }
 
 static void
-depcom()
+depcom(void)
 {
     deprecate("comma-less variable list");
 }
 
 void
-lex_start(line)
-SV *line;
+lex_start(SV *line)
 {
+    dTHR;
     char *s;
     STRLEN len;
 
@@ -287,14 +284,13 @@ SV *line;
 }
 
 void
-lex_end()
+lex_end(void)
 {
     doextract = FALSE;
 }
 
 static void
-restore_rsfp(f)
-void *f;
+restore_rsfp(void *f)
 {
     PerlIO *fp = (PerlIO*)f;
 
@@ -306,9 +302,9 @@ void *f;
 }
 
 static void
-incline(s)
-char *s;
+incline(char *s)
 {
+    dTHR;
     char *t;
     char *n;
     char ch;
@@ -347,9 +343,9 @@ char *s;
 }
 
 static char *
-skipspace(s)
-register char *s;
+skipspace(register char *s)
 {
+    dTHR;
     if (lex_formbrack && lex_brackets <= lex_formbrack) {
 	while (s < bufend && (*s == ' ' || *s == '\t'))
 	    s++;
@@ -369,7 +365,9 @@ register char *s;
 	    return s;
 	if ((s = filter_gets(linestr, rsfp, (prevlen = SvCUR(linestr)))) == Nullch) {
 	    if (minus_n || minus_p) {
-		sv_setpv(linestr,minus_p ? ";}continue{print" : "");
+		sv_setpv(linestr,minus_p ?
+			 ";}continue{print or die qq(-p destination: $!\\n)" :
+			 "");
 		sv_catpv(linestr,";}");
 		minus_n = minus_p = 0;
 	    }
@@ -383,6 +381,8 @@ register char *s;
 		PerlIO_clearerr(rsfp);
 	    else
 		(void)PerlIO_close(rsfp);
+	    if (e_fp == rsfp)
+		e_fp = Nullfp;
 	    rsfp = Nullfp;
 	    return s;
 	}
@@ -390,7 +390,7 @@ register char *s;
 	bufend = s + SvCUR(linestr);
 	s = bufptr;
 	incline(s);
-	if (perldb && curstash != debstash) {
+	if (PERLDB_LINE && curstash != debstash) {
 	    SV *sv = NEWSV(85,0);
 
 	    sv_upgrade(sv, SVt_PVMG);
@@ -401,7 +401,7 @@ register char *s;
 }
 
 static void
-check_uni() {
+check_uni(void) {
     char *s;
     char ch;
     char *t;
@@ -425,9 +425,7 @@ check_uni() {
 #define UNI(f) return uni(f,s)
 
 static int
-uni(f,s)
-I32 f;
-char *s;
+uni(I32 f, char *s)
 {
     yylval.ival = f;
     expect = XTERM;
@@ -458,6 +456,7 @@ expectation x;
 char *s;
 #endif /* CAN_PROTOTYPE */
 {
+    dTHR;
     yylval.ival = f;
     CLINE;
     expect = x;
@@ -476,8 +475,7 @@ char *s;
 }
 
 static void 
-force_next(type)
-I32 type;
+force_next(I32 type)
 {
     nexttype[nexttoke] = type;
     nexttoke++;
@@ -489,12 +487,7 @@ I32 type;
 }
 
 static char *
-force_word(start,token,check_keyword,allow_pack,allow_tick)
-register char *start;
-int token;
-int check_keyword;
-int allow_pack;
-int allow_tick;
+force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_tick)
 {
     register char *s;
     STRLEN len;
@@ -526,16 +519,15 @@ int allow_tick;
 }
 
 static void
-force_ident(s, kind)
-register char *s;
-int kind;
+force_ident(register char *s, int kind)
 {
     if (s && *s) {
-	OP* op = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
-	nextval[nexttoke].opval = op;
+	OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
+	nextval[nexttoke].opval = o;
 	force_next(WORD);
 	if (kind) {
-	    op->op_private = OPpCONST_ENTERED;
+	    dTHR;		/* just for in_eval */
+	    o->op_private = OPpCONST_ENTERED;
 	    /* XXX see note in pp_entereval() for why we forgo typo
 	       warnings if the symbol must be introduced in an eval.
 	       GSAR 96-10-12 */
@@ -550,8 +542,7 @@ int kind;
 }
 
 static char *
-force_version(s)
-char *s;
+force_version(char *s)
 {
     OP *version = Nullop;
 
@@ -578,8 +569,7 @@ char *s;
 }
 
 static SV *
-q(sv)
-SV *sv;
+q(SV *sv)
 {
     register char *s;
     register char *send;
@@ -612,7 +602,7 @@ SV *sv;
 }
 
 static I32
-sublex_start()
+sublex_start(void)
 {
     register I32 op_type = yylval.ival;
 
@@ -647,8 +637,9 @@ sublex_start()
 }
 
 static I32
-sublex_push()
+sublex_push(void)
 {
+    dTHR;
     push_scope();
 
     lex_state = sublex_info.super_state;
@@ -699,7 +690,7 @@ sublex_push()
 }
 
 static I32
-sublex_done()
+sublex_done(void)
 {
     if (!lex_starts++) {
 	expect = XOPERATOR;
@@ -744,8 +735,7 @@ sublex_done()
 }
 
 static char *
-scan_const(start)
-char *start;
+scan_const(char *start)
 {
     register char *send = bufend;
     SV *sv = NEWSV(93, send - start);
@@ -753,7 +743,7 @@ char *start;
     register char *d = SvPVX(sv);
     bool dorange = FALSE;
     I32 len;
-    char *leave =
+    char *leaveit =
 	lex_inpat
 	    ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#"
 	    : (lex_inwhat & OP_TRANS)
@@ -794,12 +784,12 @@ char *start;
 	else if (*s == '$') {
 	    if (!lex_inpat)	/* not a regexp, so $ must be var */
 		break;
-	    if (s + 1 < send && !strchr(")| \n\t", s[1]))
+	    if (s + 1 < send && !strchr("()| \n\t", s[1]))
 		break;		/* in regexp, $ might be tail anchor */
 	}
 	if (*s == '\\' && s+1 < send) {
 	    s++;
-	    if (*s && strchr(leave, *s)) {
+	    if (*s && strchr(leaveit, *s)) {
 		*d++ = '\\';
 		*d++ = *s++;
 		continue;
@@ -884,8 +874,7 @@ char *start;
 
 /* This is the one truly awful dwimmer necessary to conflate C and sed. */
 static int
-intuit_more(s)
-register char *s;
+intuit_more(register char *s)
 {
     if (lex_brackets)
 	return TRUE;
@@ -1013,9 +1002,7 @@ register char *s;
 }
 
 static int
-intuit_method(start,gv)
-char *start;
-GV *gv;
+intuit_method(char *start, GV *gv)
 {
     char *s = start + (*start == '$');
     char tmpbuf[sizeof tokenbuf];
@@ -1061,7 +1048,7 @@ GV *gv;
 }
 
 static char*
-incl_perldb()
+incl_perldb(void)
 {
     if (perldb) {
 	char *pdb = getenv("PERL5DB");
@@ -1092,9 +1079,7 @@ incl_perldb()
 static int filter_debug = 0;
 
 SV *
-filter_add(funcp, datasv)
-    filter_t funcp;
-    SV *datasv;
+filter_add(filter_t funcp, SV *datasv)
 {
     if (!funcp){ /* temporary handy debugging hack to be deleted */
 	filter_debug = atoi((char*)datasv);
@@ -1117,17 +1102,15 @@ filter_add(funcp, datasv)
 
 /* Delete most recently added instance of this filter function.	*/
 void
-filter_del(funcp)
-    filter_t funcp;
+filter_del(filter_t funcp)
 {
     if (filter_debug)
 	warn("filter_del func %p", funcp);
     if (!rsfp_filters || AvFILL(rsfp_filters)<0)
 	return;
     /* if filter is on top of stack (usual case) just pop it off */
-    if (IoDIRP(FILTER_DATA(0)) == (void*)funcp){
-	/* sv_free(av_pop(rsfp_filters)); */
-	sv_free(av_shift(rsfp_filters));
+    if (IoDIRP(FILTER_DATA(AvFILL(rsfp_filters))) == (void*)funcp){
+	sv_free(av_pop(rsfp_filters));
 
         return;
     }
@@ -1138,10 +1121,10 @@ filter_del(funcp)
 
 /* Invoke the n'th filter function for the current rsfp.	 */
 I32
-filter_read(idx, buf_sv, maxlen)
-    int idx;
-    SV *buf_sv;
-    int maxlen;		/* 0 = read one text line */
+filter_read(int idx, SV *buf_sv, int maxlen)
+            
+               
+               		/* 0 = read one text line */
 {
     filter_t funcp;
     SV *datasv = NULL;
@@ -1196,10 +1179,7 @@ filter_read(idx, buf_sv, maxlen)
 }
 
 static char *
-filter_gets(sv,fp, append)
-register SV *sv;
-register PerlIO *fp;
-STRLEN append;
+filter_gets(register SV *sv, register FILE *fp, STRLEN append)
 {
     if (rsfp_filters) {
 
@@ -1224,8 +1204,9 @@ STRLEN append;
 EXT int yychar;		/* last token */
 
 int
-yylex()
+yylex(void)
 {
+    dTHR;
     register char *s;
     register char *d;
     register I32 tmp;
@@ -1243,26 +1224,39 @@ yylex()
 	    return PRIVATEREF;
 	}
 
-	if (!strchr(tokenbuf,':') && (tmp = pad_findmy(tokenbuf))) {
-	    if (last_lop_op == OP_SORT &&
-		tokenbuf[0] == '$' &&
-		(tokenbuf[1] == 'a' || tokenbuf[1] == 'b')
-		&& !tokenbuf[2])
+	if (!strchr(tokenbuf,':')) {
+#ifdef USE_THREADS
+	    /* Check for single character per-thread SVs */
+	    if (tokenbuf[0] == '$' && tokenbuf[2] == '\0'
+		&& !isALPHA(tokenbuf[1]) /* Rule out obvious non-threadsvs */
+		&& (tmp = find_threadsv(&tokenbuf[1])) != NOT_IN_PAD)
 	    {
-		for (d = in_eval ? oldoldbufptr : linestart;
-		     d < bufend && *d != '\n';
-		     d++)
+		yylval.opval = newOP(OP_THREADSV, 0);
+		yylval.opval->op_targ = tmp;
+		return PRIVATEREF;
+	    }
+#endif /* USE_THREADS */
+	    if ((tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
+		if (last_lop_op == OP_SORT &&
+		    tokenbuf[0] == '$' &&
+		    (tokenbuf[1] == 'a' || tokenbuf[1] == 'b')
+		    && !tokenbuf[2])
 		{
-		    if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
-			croak("Can't use \"my %s\" in sort comparison",
-			      tokenbuf);
+		    for (d = in_eval ? oldoldbufptr : linestart;
+			 d < bufend && *d != '\n';
+			 d++)
+		    {
+			if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
+			    croak("Can't use \"my %s\" in sort comparison",
+				  tokenbuf);
+			}
 		    }
 		}
-	    }
 
-	    yylval.opval = newOP(OP_PADANY, 0);
-	    yylval.opval->op_targ = tmp;
-	    return PRIVATEREF;
+		yylval.opval = newOP(OP_PADANY, 0);
+		yylval.opval->op_targ = tmp;
+		return PRIVATEREF;
+	    }
 	}
 
 	/* Force them to make up their mind on "@foo". */
@@ -1377,7 +1371,13 @@ yylex()
 	if (lex_dojoin) {
 	    nextval[nexttoke].ival = 0;
 	    force_next(',');
+#ifdef USE_THREADS
+	    nextval[nexttoke].opval = newOP(OP_THREADSV, 0);
+	    nextval[nexttoke].opval->op_targ = find_threadsv("\"");
+	    force_next(PRIVATEREF);
+#else
 	    force_ident("\"", '$');
+#endif /* USE_THREADS */
 	    nextval[nexttoke].ival = 0;
 	    force_next('$');
 	    nextval[nexttoke].ival = 0;
@@ -1524,7 +1524,7 @@ yylex()
 	    sv_catpv(linestr, "\n");
 	    oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
 	    bufend = SvPVX(linestr) + SvCUR(linestr);
-	    if (perldb && curstash != debstash) {
+	    if (PERLDB_LINE && curstash != debstash) {
 		SV *sv = NEWSV(85,0);
 
 		sv_upgrade(sv, SVt_PVMG);
@@ -1543,6 +1543,8 @@ yylex()
 			PerlIO_clearerr(rsfp);
 		    else
 			(void)PerlIO_close(rsfp);
+		    if (e_fp == rsfp)
+			e_fp = Nullfp;
 		    rsfp = Nullfp;
 		}
 		if (!in_eval && (minus_n || minus_p)) {
@@ -1572,7 +1574,7 @@ yylex()
 	    incline(s);
 	} while (doextract);
 	oldoldbufptr = oldbufptr = bufptr = linestart = s;
-	if (perldb && curstash != debstash) {
+	if (PERLDB_LINE && curstash != debstash) {
 	    SV *sv = NEWSV(85,0);
 
 	    sv_upgrade(sv, SVt_PVMG);
@@ -1697,7 +1699,7 @@ yylex()
 			    }
 			    d = moreswitches(d);
 			} while (d);
-			if (perldb && !oldpdb ||
+			if (PERLDB_LINE && !oldpdb ||
 			    ( minus_n || minus_p ) && !(oldn || oldp) )
 			      /* if we have already added "LINE: while (<>) {",
 			         we must not do it again */
@@ -1706,7 +1708,7 @@ yylex()
 			    oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
 			    bufend = SvPVX(linestr) + SvCUR(linestr);
 			    preambled = FALSE;
-			    if (perldb)
+			    if (PERLDB_LINE)
 				(void)gv_fetchfile(origfilename);
 			    goto retry;
 			}
@@ -2031,16 +2033,16 @@ yylex()
 			close = term;
 			if (open == close)
 			    for (t++; t < bufend; t++) {
-				if (*t == '\\' && t+1 < bufend && term != '\\')
+				if (*t == '\\' && t+1 < bufend && open != '\\')
 				    t++;
-				else if (*t == term)
+				else if (*t == open)
 				    break;
 			    }
 			else
 			    for (t++; t < bufend; t++) {
-				if (*t == '\\' && t+1 < bufend && term != '\\')
+				if (*t == '\\' && t+1 < bufend)
 				    t++;
-				else if (*t == term && --brackets <= 0)
+				else if (*t == close && --brackets <= 0)
 				    break;
 				else if (*t == open)
 				    brackets++;
@@ -2314,8 +2316,23 @@ yylex()
 	    else if (isIDFIRST(*s)) {
 		char tmpbuf[sizeof tokenbuf];
 		scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
-		if (keyword(tmpbuf, len))
-		    expect = XTERM;	/* e.g. print $fh length() */
+		if (tmp = keyword(tmpbuf, len)) {
+		    /* binary operators exclude handle interpretations */
+		    switch (tmp) {
+		    case -KEY_x:
+		    case -KEY_eq:
+		    case -KEY_ne:
+		    case -KEY_gt:
+		    case -KEY_lt:
+		    case -KEY_ge:
+		    case -KEY_le:
+		    case -KEY_cmp:
+			break;
+		    default:
+			expect = XTERM;	/* e.g. print $fh length() */
+			break;
+		    }
+		}
 		else {
 		    GV *gv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
 		    if (gv && GvCVu(gv))
@@ -2371,7 +2388,11 @@ yylex()
     case '/':			/* may either be division or pattern */
     case '?':			/* may either be conditional or pattern */
 	if (expect != XOPERATOR) {
-	    check_uni();
+	    /* Disable warning on "study /blah/" */
+	    if (oldoldbufptr == last_uni 
+		&& (*last_uni != 's' || s - last_uni < 5 
+		    || memNE(last_uni, "study", 5) || isALNUM(last_uni[5])))
+		check_uni();
 	    s = scan_pat(s);
 	    TERM(sublex_start());
 	}
@@ -2502,7 +2523,10 @@ yylex()
     case 'y': case 'Y':
     case 'z': case 'Z':
 
-      keylookup:
+      keylookup: {
+	GV *gv = Nullgv;
+	GV **gvp = 0;
+
 	bufptr = s;
 	s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
 
@@ -2544,16 +2568,24 @@ yylex()
 	}
 
 	if (tmp < 0) {			/* second-class keyword? */
-	    GV* gv;
-	    if (expect != XOPERATOR &&
-		(*s != ':' || s[1] != ':') &&
-		(gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) &&
-		GvIMPORTED_CV(gv))
+	    if (expect != XOPERATOR && (*s != ':' || s[1] != ':') &&
+		(((gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) &&
+		  GvCVu(gv) && GvIMPORTED_CV(gv)) ||
+		 ((gvp = (GV**)hv_fetch(globalstash,tokenbuf,len,FALSE)) &&
+		  (gv = *gvp) != (GV*)&sv_undef &&
+		  GvCVu(gv) && GvIMPORTED_CV(gv))))
 	    {
-		tmp = 0;
+		tmp = 0;		/* overridden by importation */
+	    }
+	    else if (gv && !gvp
+		     && -tmp==KEY_lock	/* XXX generalizable kludge */
+		     && !hv_fetch(GvHVn(incgv), "Thread.pm", 9, FALSE))
+	    {
+		tmp = 0;		/* any sub overrides "weak" keyword */
+	    }
+	    else {
+		tmp = -tmp; gv = Nullgv; gvp = 0;
 	    }
-	    else
-		tmp = -tmp;
 	}
 
       reserved_word:
@@ -2561,7 +2593,6 @@ yylex()
 
 	default:			/* not a keyword */
 	  just_a_word: {
-		GV *gv;
 		SV *sv;
 		char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]);
 
@@ -2586,12 +2617,19 @@ yylex()
 
 		/* Look for a subroutine with this name in current package. */
 
-		gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV);
+		if (gvp) {
+		    sv = newSVpv("CORE::GLOBAL::",14);
+		    sv_catpv(sv,tokenbuf);
+		}
+		else
+		    sv = newSVpv(tokenbuf,0);
+		if (!gv)
+		    gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV);
 
 		/* Presume this is going to be a bareword of some sort. */
 
 		CLINE;
-		yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
+		yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
 		yylval.opval->op_private = OPpCONST_BARE;
 
 		/* See if it's the indirect object for a list operator. */
@@ -2601,7 +2639,7 @@ yylex()
 		    (oldoldbufptr == last_lop || oldoldbufptr == last_uni) &&
 		    /* NO SKIPSPACE BEFORE HERE! */
 		    (expect == XREF ||
-		     (opargs[last_lop_op] >> OASHIFT & 7) == OA_FILEREF) )
+		     ((opargs[last_lop_op] >> OASHIFT)& 7) == OA_FILEREF) )
 		{
 		    bool immediate_paren = *s == '(';
 
@@ -2785,6 +2823,7 @@ yylex()
 	case KEY_DESTROY:
 	case KEY_BEGIN:
 	case KEY_END:
+	case KEY_INIT:
 	    if (expect == XSTATE) {
 		s = bufptr;
 		goto really_sub;
@@ -3147,6 +3186,9 @@ yylex()
 	case KEY_listen:
 	    LOP(OP_LISTEN,XTERM);
 
+	case KEY_lock:
+	    UNI(OP_LOCK);
+
 	case KEY_lstat:
 	    UNI(OP_LSTAT);
 
@@ -3174,6 +3216,17 @@ yylex()
 
 	case KEY_my:
 	    in_my = TRUE;
+	    s = skipspace(s);
+	    if (isIDFIRST(*s)) {
+		s = scan_word(s, tokenbuf, sizeof tokenbuf, TRUE, &len);
+		in_my_stash = gv_stashpv(tokenbuf, FALSE);
+		if (!in_my_stash) {
+		    char tmpbuf[1024];
+		    bufptr = s;
+		    sprintf(tmpbuf, "No such class %.1000s", tokenbuf);
+		    yyerror(tmpbuf);
+		}
+	    }
 	    OPERATOR(MY);
 
 	case KEY_next:
@@ -3712,13 +3765,11 @@ yylex()
 	    s = scan_trans(s);
 	    TERM(sublex_start());
 	}
-    }
+    }}
 }
 
 I32
-keyword(d, len)
-register char *d;
-I32 len;
+keyword(register char *d, I32 len)
 {
     switch (*d) {
     case '_':
@@ -3952,7 +4003,7 @@ I32 len;
 	case 4:
 	    if (strEQ(d,"grep"))		return KEY_grep;
 	    if (strEQ(d,"goto"))		return KEY_goto;
-	    if (strEQ(d,"glob"))		return -KEY_glob;
+	    if (strEQ(d,"glob"))		return KEY_glob;
 	    break;
 	case 6:
 	    if (strEQ(d,"gmtime"))		return -KEY_gmtime;
@@ -3962,6 +4013,9 @@ I32 len;
     case 'h':
 	if (strEQ(d,"hex"))			return -KEY_hex;
 	break;
+    case 'I':
+	if (strEQ(d,"INIT"))			return KEY_INIT;
+	break;
     case 'i':
 	switch (len) {
 	case 2:
@@ -4004,6 +4058,7 @@ I32 len;
 	case 4:
 	    if (strEQ(d,"last"))		return KEY_last;
 	    if (strEQ(d,"link"))		return -KEY_link;
+	    if (strEQ(d,"lock"))		return -KEY_lock;
 	    break;
 	case 5:
 	    if (strEQ(d,"local"))		return KEY_local;
@@ -4330,10 +4385,7 @@ I32 len;
 }
 
 static void
-checkcomma(s,name,what)
-register char *s;
-char *name;
-char *what;
+checkcomma(register char *s, char *name, char *what)
 {
     char *w;
 
@@ -4375,12 +4427,7 @@ char *what;
 }
 
 static char *
-scan_word(s, dest, destlen, allow_package, slp)
-register char *s;
-char *dest;
-STRLEN destlen;
-int allow_package;
-STRLEN *slp;
+scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
 {
     register char *d = dest;
     register char *e = d + destlen - 3;  /* two-character token, ending NUL */
@@ -4407,12 +4454,7 @@ STRLEN *slp;
 }
 
 static char *
-scan_ident(s, send, dest, destlen, ck_uni)
-register char *s;
-register char *send;
-char *dest;
-STRLEN destlen;
-I32 ck_uni;
+scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
 {
     register char *d;
     register char *e;
@@ -4513,7 +4555,7 @@ I32 ck_uni;
 		lex_state = LEX_INTERPEND;
 	    if (funny == '#')
 		funny = '@';
-	    if (dowarn &&
+	    if (dowarn && lex_state == LEX_NORMAL &&
 	      (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
 		warn("Ambiguous use of %c{%s} resolved to %c%s",
 		    funny, dest, funny, dest);
@@ -4528,9 +4570,7 @@ I32 ck_uni;
     return s;
 }
 
-void pmflag(pmfl,ch)
-U16* pmfl;
-int ch;
+void pmflag(U16 *pmfl, int ch)
 {
     if (ch == 'i')
 	*pmfl |= PMf_FOLD;
@@ -4549,8 +4589,7 @@ int ch;
 }
 
 static char *
-scan_pat(start)
-char *start;
+scan_pat(char *start)
 {
     PMOP *pm;
     char *s;
@@ -4576,8 +4615,7 @@ char *start;
 }
 
 static char *
-scan_subst(start)
-char *start;
+scan_subst(char *start)
 {
     register char *s;
     register PMOP *pm;
@@ -4641,55 +4679,14 @@ char *start;
     return s;
 }
 
-void
-hoistmust(pm)
-register PMOP *pm;
-{
-    if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
-	(!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
-       ) {
-	if (!(pm->op_pmregexp->reganch & ROPT_ANCH))
-	    pm->op_pmflags |= PMf_SCANFIRST;
-	pm->op_pmshort = SvREFCNT_inc(pm->op_pmregexp->regstart);
-	pm->op_pmslen = SvCUR(pm->op_pmshort);
-    }
-    else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */
-	if (pm->op_pmshort &&
-	  sv_eq(pm->op_pmshort,pm->op_pmregexp->regmust))
-	{
-	    if (pm->op_pmflags & PMf_SCANFIRST) {
-		SvREFCNT_dec(pm->op_pmshort);
-		pm->op_pmshort = Nullsv;
-	    }
-	    else {
-		SvREFCNT_dec(pm->op_pmregexp->regmust);
-		pm->op_pmregexp->regmust = Nullsv;
-		return;
-	    }
-	}
-	/* promote the better string */
-	if ((!pm->op_pmshort &&
-	     !(pm->op_pmregexp->reganch & ROPT_ANCH_GPOS)) ||
-	    ((pm->op_pmflags & PMf_SCANFIRST) &&
-	     (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)))) {
-	    SvREFCNT_dec(pm->op_pmshort);		/* ok if null */
-	    pm->op_pmshort = pm->op_pmregexp->regmust;
-	    pm->op_pmslen = SvCUR(pm->op_pmshort);
-	    pm->op_pmregexp->regmust = Nullsv;
-	    pm->op_pmflags |= PMf_SCANFIRST;
-	}
-    }
-}
-
 static char *
-scan_trans(start)
-char *start;
+scan_trans(char *start)
 {
     register char* s;
-    OP *op;
+    OP *o;
     short *tbl;
     I32 squash;
-    I32 delete;
+    I32 Delete;
     I32 complement;
 
     yylval.ival = OP_NULL;
@@ -4716,29 +4713,29 @@ char *start;
     }
 
     New(803,tbl,256,short);
-    op = newPVOP(OP_TRANS, 0, (char*)tbl);
+    o = newPVOP(OP_TRANS, 0, (char*)tbl);
 
-    complement = delete = squash = 0;
+    complement = Delete = squash = 0;
     while (*s == 'c' || *s == 'd' || *s == 's') {
 	if (*s == 'c')
 	    complement = OPpTRANS_COMPLEMENT;
 	else if (*s == 'd')
-	    delete = OPpTRANS_DELETE;
+	    Delete = OPpTRANS_DELETE;
 	else
 	    squash = OPpTRANS_SQUASH;
 	s++;
     }
-    op->op_private = delete|squash|complement;
+    o->op_private = Delete|squash|complement;
 
-    lex_op = op;
+    lex_op = o;
     yylval.ival = OP_TRANS;
     return s;
 }
 
 static char *
-scan_heredoc(s)
-register char *s;
+scan_heredoc(register char *s)
 {
+    dTHR;
     SV *herewas;
     I32 op_type = OP_SCALAR;
     I32 len;
@@ -4829,7 +4826,7 @@ register char *s;
 	    missingterm(tokenbuf);
 	}
 	curcop->cop_line++;
-	if (perldb && curstash != debstash) {
+	if (PERLDB_LINE && curstash != debstash) {
 	    SV *sv = NEWSV(88,0);
 
 	    sv_upgrade(sv, SVt_PVMG);
@@ -4862,8 +4859,7 @@ register char *s;
 }
 
 static char *
-scan_inputsymbol(start)
-char *start;
+scan_inputsymbol(char *start)
 {
     register char *s = start;
     register char *d;
@@ -4895,10 +4891,10 @@ char *start;
 	    (void)strcpy(d,"ARGV");
 	if (*d == '$') {
 	    I32 tmp;
-	    if (tmp = pad_findmy(d)) {
-		OP *op = newOP(OP_PADSV, 0);
-		op->op_targ = tmp;
-		lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, op));
+	    if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
+		OP *o = newOP(OP_PADSV, 0);
+		o->op_targ = tmp;
+		lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, o));
 	    }
 	    else {
 		GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
@@ -4919,9 +4915,9 @@ char *start;
 }
 
 static char *
-scan_str(start)
-char *start;
+scan_str(char *start)
 {
+    dTHR;
     SV *sv;
     char *tmps;
     register char *s = start;
@@ -4966,13 +4962,13 @@ char *start;
 	    for (; s < bufend; s++,to++) {
 		if (*s == '\n' && !rsfp)
 		    curcop->cop_line++;
-		if (*s == '\\' && s+1 < bufend && term != '\\') {
-		    if (s[1] == term)
+		if (*s == '\\' && s+1 < bufend) {
+		    if ((s[1] == multi_open) || (s[1] == multi_close))
 			s++;
 		    else
 			*to++ = *s++;
 		}
-		else if (*s == term && --brackets <= 0)
+		else if (*s == multi_close && --brackets <= 0)
 		    break;
 		else if (*s == multi_open)
 		    brackets++;
@@ -4991,7 +4987,7 @@ char *start;
 	    return Nullch;
 	}
 	curcop->cop_line++;
-	if (perldb && curstash != debstash) {
+	if (PERLDB_LINE && curstash != debstash) {
 	    SV *sv = NEWSV(88,0);
 
 	    sv_upgrade(sv, SVt_PVMG);
@@ -5015,8 +5011,7 @@ char *start;
 }
 
 char *
-scan_num(start)
-char *start;
+scan_num(char *start)
 {
     register char *s = start;
     register char *d;
@@ -5144,9 +5139,9 @@ char *start;
 }
 
 static char *
-scan_formline(s)
-register char *s;
+scan_formline(register char *s)
 {
+    dTHR;
     register char *eol;
     register char *t;
     SV *stuff = newSVpv("",0);
@@ -5214,7 +5209,7 @@ register char *s;
 }
 
 static void
-set_csh()
+set_csh(void)
 {
 #ifdef CSH
     if (!cshlen)
@@ -5223,10 +5218,9 @@ set_csh()
 }
 
 I32
-start_subparse(is_format, flags)
-I32 is_format;
-U32 flags;
+start_subparse(I32 is_format, U32 flags)
 {
+    dTHR;
     I32 oldsavestack_ix = savestack_ix;
     CV* outsidecv = compcv;
     AV* comppadlist;
@@ -5251,13 +5245,21 @@ U32 flags;
     CvFLAGS(compcv) |= flags;
 
     comppad = newAV();
+    av_push(comppad, Nullsv);
+    curpad = AvARRAY(comppad);
     comppad_name = newAV();
     comppad_name_fill = 0;
     min_intro_pending = 0;
-    av_push(comppad, Nullsv);
-    curpad = AvARRAY(comppad);
     padix = 0;
     subline = curcop->cop_line;
+#ifdef USE_THREADS
+    av_store(comppad_name, 0, newSVpv("@_", 2));
+    curpad[0] = (SV*)newAV();
+    SvPADMY_on(curpad[0]);	/* XXX Needed? */
+    CvOWNER(compcv) = 0;
+    New(666, CvMUTEXP(compcv), 1, perl_mutex);
+    MUTEX_INIT(CvMUTEXP(compcv));
+#endif /* USE_THREADS */
 
     comppadlist = newAV();
     AvREAL_off(comppadlist);
@@ -5265,15 +5267,20 @@ U32 flags;
     av_store(comppadlist, 1, (SV*)comppad);
 
     CvPADLIST(compcv) = comppadlist;
-    CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv);
+    CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(outsidecv);
+#ifdef USE_THREADS
+    CvOWNER(compcv) = 0;
+    New(666, CvMUTEXP(compcv), 1, perl_mutex);
+    MUTEX_INIT(CvMUTEXP(compcv));
+#endif /* USE_THREADS */
 
     return oldsavestack_ix;
 }
 
 int
-yywarn(s)
-char *s;
+yywarn(char *s)
 {
+    dTHR;
     --error_count;
     in_eval |= 2;
     yyerror(s);
@@ -5282,9 +5289,9 @@ char *s;
 }
 
 int
-yyerror(s)
-char *s;
+yyerror(char *s)
 {
+    dTHR;
     char *where = NULL;
     char *context = NULL;
     int contlen = -1;
@@ -5343,11 +5350,13 @@ char *s;
     if (in_eval & 2)
 	warn("%_", msg);
     else if (in_eval)
-	sv_catsv(GvSV(errgv), msg);
+	sv_catsv(ERRSV, msg);
     else
 	PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
     if (++error_count >= 10)
 	croak("%_ has too many errors.\n", GvSV(curcop->cop_filegv));
     in_my = 0;
+    in_my_stash = Nullhv;
     return 0;
 }
+