Add to MANIFEST: README.threads, lib/ISA.pm, lib/Class/Fields.pm

[p5sagit/p5-mst-13.2.git] / toke.c

diff --git a/toke.c b/toke.c
index b443bb2..dc2c2a2 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -226,6 +226,7 @@ void
 lex_start(line)
 SV *line;
 {
+    dTHR;
     char *s;
     STRLEN len;
 
@@ -309,6 +310,7 @@ static void
 incline(s)
 char *s;
 {
+    dTHR;
     char *t;
     char *n;
     char ch;
@@ -350,6 +352,7 @@ static char *
 skipspace(s)
 register char *s;
 {
+    dTHR;
     if (lex_formbrack && lex_brackets <= lex_formbrack) {
        while (s < bufend && (*s == ' ' || *s == '\t'))
            s++;
@@ -458,6 +461,7 @@ expectation x;
 char *s;
 #endif /* CAN_PROTOTYPE */
 {
+    dTHR;
     yylval.ival = f;
     CLINE;
     expect = x;
@@ -531,11 +535,12 @@ 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 */
@@ -649,6 +654,7 @@ sublex_start()
 static I32
 sublex_push()
 {
+    dTHR;
     push_scope();
 
     lex_state = sublex_info.super_state;
@@ -753,7 +759,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)
@@ -799,7 +805,7 @@ char *start;
        }
        if (*s == '\\' && s+1 < send) {
            s++;
-           if (*s && strchr(leave, *s)) {
+           if (*s && strchr(leaveit, *s)) {
                *d++ = '\\';
                *d++ = *s++;
                continue;
@@ -1226,6 +1232,7 @@ EXT int yychar;           /* last token */
 int
 yylex()
 {
+    dTHR;
     register char *s;
     register char *d;
     register I32 tmp;
@@ -1243,7 +1250,8 @@ yylex()
            return PRIVATEREF;
        }
 
-       if (!strchr(tokenbuf,':') && (tmp = pad_findmy(tokenbuf))) {
+       if (!strchr(tokenbuf,':')
+           && (tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
            if (last_lop_op == OP_SORT &&
                tokenbuf[0] == '$' &&
                (tokenbuf[1] == 'a' || tokenbuf[1] == 'b')
@@ -2731,6 +2739,7 @@ yylex()
        case KEY_DESTROY:
        case KEY_BEGIN:
        case KEY_END:
+       case KEY_INIT:
            if (expect == XSTATE) {
                s = bufptr;
                goto really_sub;
@@ -3093,6 +3102,9 @@ yylex()
        case KEY_listen:
            LOP(OP_LISTEN,XTERM);
 
+       case KEY_lock:
+           UNI(OP_LOCK);
+
        case KEY_lstat:
            UNI(OP_LSTAT);
 
@@ -3120,6 +3132,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:
@@ -3908,6 +3931,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:
@@ -3950,6 +3976,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;
@@ -4591,6 +4618,7 @@ void
 hoistmust(pm)
 register PMOP *pm;
 {
+    dTHR;
     if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
        (!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
        ) {
@@ -4632,7 +4660,7 @@ scan_trans(start)
 char *start;
 {
     register char* s;
-    OP *op;
+    OP *o;
     short *tbl;
     I32 squash;
     I32 delete;
@@ -4662,7 +4690,7 @@ 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;
     while (*s == 'c' || *s == 'd' || *s == 's') {
@@ -4674,9 +4702,9 @@ char *start;
            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;
 }
@@ -4685,6 +4713,7 @@ static char *
 scan_heredoc(s)
 register char *s;
 {
+    dTHR;
     SV *herewas;
     I32 op_type = OP_SCALAR;
     I32 len;
@@ -4841,10 +4870,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);
@@ -4868,6 +4897,7 @@ static char *
 scan_str(start)
 char *start;
 {
+    dTHR;
     SV *sv;
     char *tmps;
     register char *s = start;
@@ -5093,6 +5123,7 @@ static char *
 scan_formline(s)
 register char *s;
 {
+    dTHR;
     register char *eol;
     register char *t;
     SV *stuff = newSVpv("",0);
@@ -5173,6 +5204,7 @@ start_subparse(is_format, flags)
 I32 is_format;
 U32 flags;
 {
+    dTHR;
     I32 oldsavestack_ix = savestack_ix;
     CV* outsidecv = compcv;
     AV* comppadlist;
@@ -5197,13 +5229,23 @@ 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));
+    New(666, CvCONDP(compcv), 1, perl_cond);
+    COND_INIT(CvCONDP(compcv));
+#endif /* USE_THREADS */
 
     comppadlist = newAV();
     AvREAL_off(comppadlist);
@@ -5212,6 +5254,13 @@ U32 flags;
 
     CvPADLIST(compcv) = comppadlist;
     CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv);
+#ifdef USE_THREADS
+    CvOWNER(compcv) = 0;
+    New(666, CvMUTEXP(compcv), 1, perl_mutex);
+    MUTEX_INIT(CvMUTEXP(compcv));
+    New(666, CvCONDP(compcv), 1, perl_cond);
+    COND_INIT(CvCONDP(compcv));
+#endif /* USE_THREADS */
 
     return oldsavestack_ix;
 }
@@ -5220,6 +5269,7 @@ int
 yywarn(s)
 char *s;
 {
+    dTHR;
     --error_count;
     in_eval |= 2;
     yyerror(s);
@@ -5231,6 +5281,7 @@ int
 yyerror(s)
 char *s;
 {
+    dTHR;
     char *where = NULL;
     char *context = NULL;
     int contlen = -1;
@@ -5295,5 +5346,6 @@ char *s;
     if (++error_count >= 10)
        croak("%_ has too many errors.\n", GvSV(curcop->cop_filegv));
     in_my = 0;
+    in_my_stash = Nullhv;
     return 0;
 }