Remove ext/Thread

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

diff --git a/toke.c b/toke.c
index 63fdbfa..c2a5566 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -49,6 +49,8 @@
 #define PL_pending_ident        (PL_parser->pending_ident)
 #define PL_preambled           (PL_parser->preambled)
 #define PL_sublex_info         (PL_parser->sublex_info)
+#define PL_linestr             (PL_parser->linestr)
+
 
 #ifdef PERL_MAD
 #  define PL_endwhite          (PL_parser->endwhite)
@@ -645,7 +647,7 @@ Perl_lex_start(pTHX_ SV *line)
 
     /* initialise lexer state */
 
-    SAVEI32(PL_lex_state);
+    SAVEI8(PL_lex_state);
 #ifdef PERL_MAD
     if (PL_lex_state == LEX_KNOWNEXT) {
        I32 toke = parser->old_parser->lasttoke;
@@ -676,9 +678,8 @@ Perl_lex_start(pTHX_ SV *line)
     SAVEPPTR(PL_last_lop);
     SAVEPPTR(PL_last_uni);
     SAVEPPTR(PL_linestart);
-    SAVESPTR(PL_linestr);
     SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp);
-    SAVEINT(PL_expect);
+    SAVEI8(PL_expect);
 
     PL_copline = NOLINE;
     PL_lex_state = LEX_NORMAL;
@@ -695,22 +696,20 @@ Perl_lex_start(pTHX_ SV *line)
     } else {
        len = 0;
     }
+
     if (!len) {
-       PL_linestr = newSVpvs("\n;");
+       parser->linestr = newSVpvs("\n;");
     } else if (SvREADONLY(line) || s[len-1] != ';') {
-       PL_linestr = newSVsv(line);
+       parser->linestr = newSVsv(line);
        if (s[len-1] != ';')
-           sv_catpvs(PL_linestr, "\n;");
+           sv_catpvs(parser->linestr, "\n;");
     } else {
        SvTEMP_off(line);
        SvREFCNT_inc_simple_void_NN(line);
-       PL_linestr = line;
+       parser->linestr = line;
     }
-    /* PL_linestr needs to survive until end of scope, not just the next
-       FREETMPS. See changes 17505 and 17546 which fixed the symptoms only.  */
-    SAVEFREESV(PL_linestr);
-    PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(PL_linestr);
-    PL_bufend = PL_bufptr + SvCUR(PL_linestr);
+    PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(parser->linestr);
+    PL_bufend = PL_bufptr + SvCUR(parser->linestr);
     PL_last_lop = PL_last_uni = NULL;
     PL_rsfp = 0;
 }
@@ -721,6 +720,8 @@ Perl_lex_start(pTHX_ SV *line)
 void
 Perl_parser_free(pTHX_  const yy_parser *parser)
 {
+    SvREFCNT_dec(parser->linestr);
+
     Safefree(parser->stack);
     Safefree(parser->lex_brackstack);
     Safefree(parser->lex_casestack);
@@ -1364,6 +1365,8 @@ S_force_word(pTHX_ register char *start, int token, int check_keyword, int allow
                PL_expect = XOPERATOR;
            }
        }
+       if (PL_madskills)
+           curmad('g', newSVpvs( "forced" ));
        NEXTVAL_NEXTTOKE.opval
            = (OP*)newSVOP(OP_CONST,0,
                           S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
@@ -1627,7 +1630,7 @@ S_sublex_start(pTHX)
     }
 
     PL_sublex_info.super_state = PL_lex_state;
-    PL_sublex_info.sub_inwhat = op_type;
+    PL_sublex_info.sub_inwhat = (U16)op_type;
     PL_sublex_info.sub_op = PL_lex_op;
     PL_lex_state = LEX_INTERPPUSH;
 
@@ -1656,13 +1659,13 @@ S_sublex_push(pTHX)
     ENTER;
 
     PL_lex_state = PL_sublex_info.super_state;
-    SAVEI32(PL_lex_dojoin);
+    SAVEBOOL(PL_lex_dojoin);
     SAVEI32(PL_lex_brackets);
     SAVEI32(PL_lex_casemods);
     SAVEI32(PL_lex_starts);
-    SAVEI32(PL_lex_state);
+    SAVEI8(PL_lex_state);
     SAVEVPTR(PL_lex_inpat);
-    SAVEI32(PL_lex_inwhat);
+    SAVEI16(PL_lex_inwhat);
     SAVECOPLINE(PL_curcop);
     SAVEPPTR(PL_bufptr);
     SAVEPPTR(PL_bufend);
@@ -5197,8 +5200,7 @@ Perl_yylex(pTHX)
            }
            else if (gv && !gvp
                     && -tmp==KEY_lock  /* XXX generalizable kludge */
-                    && GvCVu(gv)
-                    && !hv_fetchs(GvHVn(PL_incgv), "Thread.pm", FALSE))
+                    && GvCVu(gv))
            {
                tmp = 0;                /* any sub overrides "weak" keyword */
            }
@@ -6183,7 +6185,7 @@ Perl_yylex(pTHX)
        case KEY_our:
        case KEY_my:
        case KEY_state:
-           PL_in_my = tmp;
+           PL_in_my = (U16)tmp;
            s = SKIPSPACE1(s);
            if (isIDFIRST_lazy_if(s,UTF)) {
 #ifdef PERL_MAD
@@ -10839,8 +10841,28 @@ S_scan_pat(pTHX_ char *start, I32 type)
     }
 
     pm = (PMOP*)newPMOP(type, 0);
-    if (PL_multi_open == '?')
+    if (PL_multi_open == '?') {
+       /* This is the only point in the code that sets PMf_ONCE:  */
        pm->op_pmflags |= PMf_ONCE;
+
+       /* Hence it's safe to do this bit of PMOP book-keeping here, which
+          allows us to restrict the list needed by reset to just the ??
+          matches.  */
+       assert(type != OP_TRANS);
+       if (PL_curstash) {
+           MAGIC *mg = mg_find((SV*)PL_curstash, PERL_MAGIC_symtab);
+           U32 elements;
+           if (!mg) {
+               mg = sv_magicext((SV*)PL_curstash, 0, PERL_MAGIC_symtab, 0, 0,
+                                0);
+           }
+           elements = mg->mg_len / sizeof(PMOP**);
+           Renewc(mg->mg_ptr, elements + 1, PMOP*, char);
+           ((PMOP**)mg->mg_ptr) [elements++] = pm;
+           mg->mg_len = elements * sizeof(PMOP**);
+           PmopSTASH_set(pm,PL_curstash);
+       }
+    }
 #ifdef PERL_MAD
     modstart = s;
 #endif