Separate avhv_foo() key handling into avhv_keys(). Slightly tweaked
[p5sagit/p5-mst-13.2.git] / toke.c
diff --git a/toke.c b/toke.c
index 705b9ab..77a2f16 100644 (file)
--- 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,8 +343,7 @@ char *s;
 }
 
 static char *
-skipspace(s)
-register char *s;
+skipspace(register char *s)
 {
     dTHR;
     if (lex_formbrack && lex_brackets <= lex_formbrack) {
@@ -370,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;
            }
@@ -384,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;
        }
@@ -391,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);
@@ -402,7 +401,7 @@ register char *s;
 }
 
 static void
-check_uni() {
+check_uni(void) {
     char *s;
     char ch;
     char *t;
@@ -426,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;
@@ -459,6 +456,7 @@ expectation x;
 char *s;
 #endif /* CAN_PROTOTYPE */
 {
+    dTHR;
     yylval.ival = f;
     CLINE;
     expect = x;
@@ -477,8 +475,7 @@ char *s;
 }
 
 static void 
-force_next(type)
-I32 type;
+force_next(I32 type)
 {
     nexttype[nexttoke] = type;
     nexttoke++;
@@ -490,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;
@@ -527,9 +519,7 @@ 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* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
@@ -552,8 +542,7 @@ int kind;
 }
 
 static char *
-force_version(s)
-char *s;
+force_version(char *s)
 {
     OP *version = Nullop;
 
@@ -580,8 +569,7 @@ char *s;
 }
 
 static SV *
-q(sv)
-SV *sv;
+q(SV *sv)
 {
     register char *s;
     register char *send;
@@ -614,7 +602,7 @@ SV *sv;
 }
 
 static I32
-sublex_start()
+sublex_start(void)
 {
     register I32 op_type = yylval.ival;
 
@@ -649,8 +637,9 @@ sublex_start()
 }
 
 static I32
-sublex_push()
+sublex_push(void)
 {
+    dTHR;
     push_scope();
 
     lex_state = sublex_info.super_state;
@@ -701,7 +690,7 @@ sublex_push()
 }
 
 static I32
-sublex_done()
+sublex_done(void)
 {
     if (!lex_starts++) {
        expect = XOPERATOR;
@@ -746,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);
@@ -755,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)
@@ -801,7 +789,7 @@ char *start;
        }
        if (*s == '\\' && s+1 < send) {
            s++;
-           if (*s && strchr(leave, *s)) {
+           if (*s && strchr(leaveit, *s)) {
                *d++ = '\\';
                *d++ = *s++;
                continue;
@@ -886,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;
@@ -1015,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];
@@ -1063,7 +1048,7 @@ GV *gv;
 }
 
 static char*
-incl_perldb()
+incl_perldb(void)
 {
     if (perldb) {
        char *pdb = getenv("PERL5DB");
@@ -1094,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);
@@ -1119,8 +1102,7 @@ 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);
@@ -1140,10 +1122,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;
@@ -1198,10 +1180,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) {
 
@@ -1226,7 +1205,7 @@ STRLEN append;
 EXT int yychar;                /* last token */
 
 int
-yylex()
+yylex(void)
 {
     dTHR;
     register char *s;
@@ -1246,27 +1225,39 @@ yylex()
            return PRIVATEREF;
        }
 
-       if (!strchr(tokenbuf,':')
-           && (tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
-           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 magicals */
+           if (tokenbuf[0] == '$' && tokenbuf[2] == '\0'
+               && !isALPHA(tokenbuf[1]) /* Rule out obvious non-magicals */
+               && (tmp = find_thread_magical(&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". */
@@ -1381,7 +1372,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_thread_magical("\"");
+           force_next(PRIVATEREF);
+#else
            force_ident("\"", '$');
+#endif /* USE_THREADS */
            nextval[nexttoke].ival = 0;
            force_next('$');
            nextval[nexttoke].ival = 0;
@@ -1528,7 +1525,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);
@@ -1547,6 +1544,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)) {
@@ -1576,7 +1575,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);
@@ -1701,7 +1700,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 */
@@ -1710,7 +1709,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;
                        }
@@ -1994,19 +1993,73 @@ yylex()
                s = skipspace(s);
                if (*s == '}')
                    OPERATOR(HASHBRACK);
-               if (isALPHA(*s)) {
-                   for (t = s; t < bufend && isALNUM(*t); t++) ;
+               /* This hack serves to disambiguate a pair of curlies
+                * as being a block or an anon hash.  Normally, expectation
+                * determines that, but in cases where we're not in a
+                * position to expect anything in particular (like inside
+                * eval"") we have to resolve the ambiguity.  This code
+                * covers the case where the first term in the curlies is a
+                * quoted string.  Most other cases need to be explicitly
+                * disambiguated by prepending a `+' before the opening
+                * curly in order to force resolution as an anon hash.
+                *
+                * XXX should probably propagate the outer expectation
+                * into eval"" to rely less on this hack, but that could
+                * potentially break current behavior of eval"".
+                * GSAR 97-07-21
+                */
+               t = s;
+               if (*s == '\'' || *s == '"' || *s == '`') {
+                   /* common case: get past first string, handling escapes */
+                   for (t++; t < bufend && *t != *s;)
+                       if (*t++ == '\\' && (*t == '\\' || *t == *s))
+                           t++;
+                   t++;
                }
-               else if (*s == '\'' || *s == '"') {
-                   t = strchr(s+1,*s);
-                   if (!t++)
-                       t = s;
+               else if (*s == 'q') {
+                   if (++t < bufend
+                       && (!isALNUM(*t)
+                           || ((*t == 'q' || *t == 'x') && ++t < bufend
+                               && !isALNUM(*t)))) {
+                       char *tmps;
+                       char open, close, term;
+                       I32 brackets = 1;
+
+                       while (t < bufend && isSPACE(*t))
+                           t++;
+                       term = *t;
+                       open = term;
+                       if (term && (tmps = strchr("([{< )]}> )]}>",term)))
+                           term = tmps[5];
+                       close = term;
+                       if (open == close)
+                           for (t++; t < bufend; t++) {
+                               if (*t == '\\' && t+1 < bufend && open != '\\')
+                                   t++;
+                               else if (*t == open)
+                                   break;
+                           }
+                       else
+                           for (t++; t < bufend; t++) {
+                               if (*t == '\\' && t+1 < bufend)
+                                   t++;
+                               else if (*t == close && --brackets <= 0)
+                                   break;
+                               else if (*t == open)
+                                   brackets++;
+                           }
+                   }
+                   t++;
+               }
+               else if (isALPHA(*s)) {
+                   for (t++; t < bufend && isALNUM(*t); t++) ;
                }
-               else
-                   t = s;
                while (t < bufend && isSPACE(*t))
                    t++;
-               if ((*t == ',' && !isLOWER(*s)) || (*t == '=' && t[1] == '>'))
+               /* if comma follows first term, call it an anon hash */
+               /* XXX it could be a comma expression with loop modifiers */
+               if (t < bufend && ((*t == ',' && (*s == 'q' || !isLOWER(*s)))
+                                  || (*t == '=' && t[1] == '>')))
                    OPERATOR(HASHBRACK);
                if (expect == XREF)
                    expect = XTERM;
@@ -2264,8 +2317,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))
@@ -2452,7 +2520,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);
 
@@ -2494,16 +2565,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:
@@ -2511,7 +2590,6 @@ yylex()
 
        default:                        /* not a keyword */
          just_a_word: {
-               GV *gv;
                SV *sv;
                char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]);
 
@@ -2536,12 +2614,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. */
@@ -2551,7 +2636,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 == '(';
 
@@ -2735,7 +2820,7 @@ yylex()
        case KEY_DESTROY:
        case KEY_BEGIN:
        case KEY_END:
-       case KEY_RESTART:
+       case KEY_INIT:
            if (expect == XSTATE) {
                s = bufptr;
                goto really_sub;
@@ -3677,13 +3762,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 '_':
@@ -3917,7 +4000,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;
@@ -3927,6 +4010,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:
@@ -4066,9 +4152,6 @@ I32 len;
        }
        else if (strEQ(d,"quotemeta"))          return -KEY_quotemeta;
        break;
-    case 'R':
-       if (strEQ(d,"RESTART"))                 return KEY_RESTART;
-       break;
     case 'r':
        switch (len) {
        case 3:
@@ -4299,10 +4382,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;
 
@@ -4316,7 +4396,7 @@ char *what;
        }
        if (*w)
            for (; *w && isSPACE(*w); w++) ;
-       if (!*w || !strchr(";|})]oa!=", *w))    /* an advisory hack only... */
+       if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */
            warn("%s (...) interpreted as function",name);
     }
     while (s < bufend && isSPACE(*s))
@@ -4344,12 +4424,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 */
@@ -4376,12 +4451,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;
@@ -4482,7 +4552,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);
@@ -4497,9 +4567,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;
@@ -4518,8 +4586,7 @@ int ch;
 }
 
 static char *
-scan_pat(start)
-char *start;
+scan_pat(char *start)
 {
     PMOP *pm;
     char *s;
@@ -4545,8 +4612,7 @@ char *start;
 }
 
 static char *
-scan_subst(start)
-char *start;
+scan_subst(char *start)
 {
     register char *s;
     register PMOP *pm;
@@ -4611,8 +4677,7 @@ char *start;
 }
 
 void
-hoistmust(pm)
-register PMOP *pm;
+hoistmust(register PMOP *pm)
 {
     dTHR;
     if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
@@ -4652,14 +4717,13 @@ register PMOP *pm;
 }
 
 static char *
-scan_trans(start)
-char *start;
+scan_trans(char *start)
 {
     register char* s;
     OP *o;
     short *tbl;
     I32 squash;
-    I32 delete;
+    I32 Delete;
     I32 complement;
 
     yylval.ival = OP_NULL;
@@ -4688,17 +4752,17 @@ char *start;
     New(803,tbl,256,short);
     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++;
     }
-    o->op_private = delete|squash|complement;
+    o->op_private = Delete|squash|complement;
 
     lex_op = o;
     yylval.ival = OP_TRANS;
@@ -4706,8 +4770,7 @@ char *start;
 }
 
 static char *
-scan_heredoc(s)
-register char *s;
+scan_heredoc(register char *s)
 {
     dTHR;
     SV *herewas;
@@ -4800,7 +4863,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);
@@ -4833,8 +4896,7 @@ register char *s;
 }
 
 static char *
-scan_inputsymbol(start)
-char *start;
+scan_inputsymbol(char *start)
 {
     register char *s = start;
     register char *d;
@@ -4890,8 +4952,7 @@ char *start;
 }
 
 static char *
-scan_str(start)
-char *start;
+scan_str(char *start)
 {
     dTHR;
     SV *sv;
@@ -4938,13 +4999,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++;
@@ -4963,7 +5024,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);
@@ -4987,8 +5048,7 @@ char *start;
 }
 
 char *
-scan_num(start)
-char *start;
+scan_num(char *start)
 {
     register char *s = start;
     register char *d;
@@ -5116,8 +5176,7 @@ char *start;
 }
 
 static char *
-scan_formline(s)
-register char *s;
+scan_formline(register char *s)
 {
     dTHR;
     register char *eol;
@@ -5187,7 +5246,7 @@ register char *s;
 }
 
 static void
-set_csh()
+set_csh(void)
 {
 #ifdef CSH
     if (!cshlen)
@@ -5196,9 +5255,7 @@ 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;
@@ -5225,16 +5282,21 @@ U32 flags;
     CvFLAGS(compcv) |= flags;
 
     comppad = newAV();
+    av_push(comppad, Nullsv);
+    curpad = AvARRAY(comppad);
     comppad_name = newAV();
     comppad_name_fill = 0;
-#ifdef USE_THREADS
-    av_store(comppad_name, 0, newSVpv("@_", 2));
-#endif /* USE_THREADS */
     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);
@@ -5242,21 +5304,18 @@ 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, pthread_mutex_t);
+    New(666, CvMUTEXP(compcv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(compcv));
-    New(666, CvCONDP(compcv), 1, pthread_cond_t);
-    COND_INIT(CvCONDP(compcv));
 #endif /* USE_THREADS */
 
     return oldsavestack_ix;
 }
 
 int
-yywarn(s)
-char *s;
+yywarn(char *s)
 {
     dTHR;
     --error_count;
@@ -5267,8 +5326,7 @@ char *s;
 }
 
 int
-yyerror(s)
-char *s;
+yyerror(char *s)
 {
     dTHR;
     char *where = NULL;
@@ -5329,7 +5387,7 @@ 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)
@@ -5338,3 +5396,4 @@ char *s;
     in_my_stash = Nullhv;
     return 0;
 }
+