X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=e34f796a7ff960524bcd782a16fb5fda8787e317;hb=1a6108908b085da4d14ad0cdf8549f193a6fb877;hp=7277d8993343da349ae29628c4f0805dcc0423df;hpb=02b34bbea1ac385edebf3102d8f728a3ff73dbfc;p=p5sagit%2Fp5-mst-13.2.git diff --git a/toke.c b/toke.c index 7277d89..e34f796 100644 --- a/toke.c +++ b/toke.c @@ -1,7 +1,7 @@ /* toke.c * * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, - * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others + * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -25,6 +25,49 @@ #define yylval (PL_parser->yylval) +/* YYINITDEPTH -- initial size of the parser's stacks. */ +#define YYINITDEPTH 200 + +/* XXX temporary backwards compatibility */ +#define PL_lex_brackets (PL_parser->lex_brackets) +#define PL_lex_brackstack (PL_parser->lex_brackstack) +#define PL_lex_casemods (PL_parser->lex_casemods) +#define PL_lex_casestack (PL_parser->lex_casestack) +#define PL_lex_defer (PL_parser->lex_defer) +#define PL_lex_dojoin (PL_parser->lex_dojoin) +#define PL_lex_expect (PL_parser->lex_expect) +#define PL_lex_formbrack (PL_parser->lex_formbrack) +#define PL_lex_inpat (PL_parser->lex_inpat) +#define PL_lex_inwhat (PL_parser->lex_inwhat) +#define PL_lex_op (PL_parser->lex_op) +#define PL_lex_repl (PL_parser->lex_repl) +#define PL_lex_starts (PL_parser->lex_starts) +#define PL_lex_stuff (PL_parser->lex_stuff) +#define PL_multi_start (PL_parser->multi_start) +#define PL_multi_open (PL_parser->multi_open) +#define PL_multi_close (PL_parser->multi_close) +#define PL_pending_ident (PL_parser->pending_ident) +#define PL_preambled (PL_parser->preambled) +#define PL_sublex_info (PL_parser->sublex_info) + +#ifdef PERL_MAD +# define PL_endwhite (PL_parser->endwhite) +# define PL_faketokens (PL_parser->faketokens) +# define PL_lasttoke (PL_parser->lasttoke) +# define PL_nextwhite (PL_parser->nextwhite) +# define PL_realtokenstart (PL_parser->realtokenstart) +# define PL_skipwhite (PL_parser->skipwhite) +# define PL_thisclose (PL_parser->thisclose) +# define PL_thismad (PL_parser->thismad) +# define PL_thisopen (PL_parser->thisopen) +# define PL_thisstuff (PL_parser->thisstuff) +# define PL_thistoken (PL_parser->thistoken) +# define PL_thiswhite (PL_parser->thiswhite) +#endif + +static int +S_pending_ident(pTHX); + static const char ident_too_long[] = "Identifier too long"; static const char commaless_variable_list[] = "comma-less variable list"; @@ -568,6 +611,8 @@ S_cr_textfilter(pTHX_ int idx, SV *sv, int maxlen) } #endif + + /* * Perl_lex_start * Initialize variables. Uses the Perl save_stack to save its state (for @@ -578,38 +623,37 @@ void Perl_lex_start(pTHX_ SV *line) { dVAR; - const char *s; + const char *s = NULL; STRLEN len; + yy_parser *parser; + + /* create and initialise a parser */ + + Newxz(parser, 1, yy_parser); + parser->old_parser = PL_parser; + PL_parser = parser; + + Newx(parser->stack, YYINITDEPTH, yy_stack_frame); + parser->ps = parser->stack; + parser->stack_size = YYINITDEPTH; + + parser->stack->state = 0; + parser->yyerrstatus = 0; + parser->yychar = YYEMPTY; /* Cause a token to be read. */ + + /* initialise lexer state */ - SAVEI32(PL_lex_dojoin); - SAVEI32(PL_lex_brackets); - SAVEI32(PL_lex_casemods); - SAVEI32(PL_lex_starts); SAVEI32(PL_lex_state); - SAVEVPTR(PL_lex_inpat); - SAVEI32(PL_lex_inwhat); #ifdef PERL_MAD if (PL_lex_state == LEX_KNOWNEXT) { - I32 toke = PL_lasttoke; + I32 toke = parser->old_parser->lasttoke; while (--toke >= 0) { SAVEI32(PL_nexttoke[toke].next_type); SAVEVPTR(PL_nexttoke[toke].next_val); if (PL_madskills) SAVEVPTR(PL_nexttoke[toke].next_mad); } - SAVEI32(PL_lasttoke); - } - SAVESPTR(PL_endwhite); - SAVESPTR(PL_thistoken); - SAVESPTR(PL_thiswhite); - SAVESPTR(PL_nextwhite); - SAVESPTR(PL_thisopen); - SAVESPTR(PL_thisclose); - SAVESPTR(PL_thisstuff); - SAVEVPTR(PL_thismad); - SAVEI32(PL_realtokenstart); - SAVEI32(PL_faketokens); - SAVESPTR(PL_skipwhite); + } SAVEI32(PL_curforce); #else if (PL_lex_state == LEX_KNOWNEXT) { @@ -630,70 +674,17 @@ Perl_lex_start(pTHX_ SV *line) SAVEPPTR(PL_last_uni); SAVEPPTR(PL_linestart); SAVESPTR(PL_linestr); - SAVEGENERICPV(PL_lex_brackstack); - SAVEGENERICPV(PL_lex_casestack); SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp); - SAVESPTR(PL_lex_stuff); - SAVEI32(PL_lex_defer); - SAVEI32(PL_sublex_info.sub_inwhat); - SAVEI32(PL_sublex_info.super_state); - SAVEVPTR(PL_sublex_info.sub_op); - SAVEPPTR(PL_sublex_info.super_bufptr); - SAVEPPTR(PL_sublex_info.super_bufend); - SAVESPTR(PL_lex_repl); SAVEINT(PL_expect); - SAVEINT(PL_lex_expect); - SAVEI32(PL_lex_formbrack); - SAVEVPTR(PL_lex_op); - SAVEI32(PL_multi_close); - SAVEI32(PL_multi_open); - SAVEI32(PL_multi_start); - SAVEI8(PL_pending_ident); - SAVEBOOL(PL_preambled); PL_lex_state = LEX_NORMAL; - PL_lex_defer = 0; PL_expect = XSTATE; - PL_lex_brackets = 0; - Newx(PL_lex_brackstack, 120, char); - Newx(PL_lex_casestack, 12, char); - PL_lex_casemods = 0; - *PL_lex_casestack = '\0'; - PL_lex_dojoin = 0; - PL_lex_starts = 0; - PL_lex_stuff = NULL; - PL_lex_repl = NULL; - PL_lex_inpat = 0; -#ifdef PERL_MAD - PL_lasttoke = 0; - PL_endwhite = NULL; - PL_faketokens = 0; - PL_nextwhite = NULL; - PL_realtokenstart = 0; - PL_skipwhite = NULL; - PL_thisclose = NULL; - PL_thisopen = NULL; - PL_thisstuff = NULL; - PL_thistoken = NULL; - PL_thiswhite = NULL; - PL_thismad = NULL; -#else + Newx(parser->lex_brackstack, 120, char); + Newx(parser->lex_casestack, 12, char); + *parser->lex_casestack = '\0'; +#ifndef PERL_MAD PL_nexttoke = 0; #endif - PL_lex_inwhat = 0; - PL_sublex_info.sub_inwhat = 0; - PL_sublex_info.super_state = 0; - PL_sublex_info.sub_op = NULL; - PL_sublex_info.super_bufptr = NULL; - PL_sublex_info.super_bufend = NULL; - PL_lex_expect = 0; - PL_lex_formbrack = 0; - PL_lex_op = NULL; - PL_multi_close = 0; - PL_multi_open = 0; - PL_multi_start = 0; - PL_pending_ident = '\0'; - PL_preambled = FALSE; if (line) { s = SvPV_const(line, len); @@ -744,13 +735,12 @@ Perl_lex_end(pTHX) */ STATIC void -S_incline(pTHX_ char *s) +S_incline(pTHX_ const char *s) { dVAR; - char *t; - char *n; - char *e; - char ch; + const char *t; + const char *n; + const char *e; CopLINE_inc(PL_curcop); if (*s++ != '#') @@ -790,34 +780,48 @@ S_incline(pTHX_ char *s) if (*e != '\n' && *e != '\0') return; /* false alarm */ - ch = *t; - *t = '\0'; if (t - s > 0) { + const STRLEN len = t - s; #ifndef USE_ITHREADS const char * const cf = CopFILE(PL_curcop); STRLEN tmplen = cf ? strlen(cf) : 0; if (tmplen > 7 && strnEQ(cf, "(eval ", 6)) { /* must copy *{"::_<(eval N)[oldfilename:L]"} * to *{"::_op_private |= OPpENTERSUB_NOPAREN; @@ -5577,7 +5569,7 @@ Perl_yylex(pTHX) d = PL_tokenbuf; while (isLOWER(*d)) d++; - if (!*d && !gv_stashpv(PL_tokenbuf,FALSE)) + if (!*d && !gv_stashpv(PL_tokenbuf, 0)) Perl_warner(aTHX_ packWARN(WARN_RESERVED), PL_warn_reserved, PL_tokenbuf); } @@ -5688,7 +5680,7 @@ Perl_yylex(pTHX) PUTBACK; PerlIO_apply_layers(aTHX_ PL_rsfp, NULL, Perl_form(aTHX_ ":encoding(%"SVf")", - (void*)name)); + SVfARG(name))); FREETMPS; LEAVE; } @@ -6375,7 +6367,7 @@ Perl_yylex(pTHX) *PL_tokenbuf = '\0'; s = force_word(s,WORD,TRUE,TRUE,FALSE); if (isIDFIRST_lazy_if(PL_tokenbuf,UTF)) - gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), TRUE); + gv_stashpvn(PL_tokenbuf, strlen(PL_tokenbuf), GV_ADD); else if (*s == '<') yyerror("<> should be quotes"); } @@ -6675,7 +6667,7 @@ Perl_yylex(pTHX) if (bad_proto) Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Illegal character in prototype for %"SVf" : %s", - (void*)PL_subname, d); + SVfARG(PL_subname), d); SvCUR_set(PL_lex_stuff, tmp); have_proto = TRUE; @@ -6704,7 +6696,7 @@ Perl_yylex(pTHX) if (!have_name) Perl_croak(aTHX_ "Illegal declaration of anonymous subroutine"); else if (*s != ';') - Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, (void*)PL_subname); + Perl_croak(aTHX_ "Illegal declaration of subroutine %"SVf, SVfARG(PL_subname)); } #ifdef PERL_MAD @@ -10758,7 +10750,8 @@ S_scan_ident(pTHX_ register char *s, register const char *send, char *dest, STRL } if (PL_lex_state == LEX_NORMAL) { if (ckWARN(WARN_AMBIGUOUS) && - (keyword(dest, d - dest, 0) || get_cv(dest, FALSE))) + (keyword(dest, d - dest, 0) + || get_cvn_flags(dest, d - dest, 0))) { if (funny == '#') funny = '@'; @@ -10782,20 +10775,16 @@ void Perl_pmflag(pTHX_ U32* pmfl, int ch) { PERL_UNUSED_CONTEXT; - if (ch == 'i') - *pmfl |= PMf_FOLD; - else if (ch == 'g') - *pmfl |= PMf_GLOBAL; - else if (ch == 'c') - *pmfl |= PMf_CONTINUE; - else if (ch == 'o') - *pmfl |= PMf_KEEP; - else if (ch == 'm') - *pmfl |= PMf_MULTILINE; - else if (ch == 's') - *pmfl |= PMf_SINGLELINE; - else if (ch == 'x') - *pmfl |= PMf_EXTENDED; + if (ch<256) { + char c = (char)ch; + switch (c) { + CASE_STD_PMMOD_FLAGS_PARSE_SET(pmfl); + case GLOBAL_PAT_MOD: *pmfl |= PMf_GLOBAL; break; + case CONTINUE_PAT_MOD: *pmfl |= PMf_CONTINUE; break; + case ONCE_PAT_MOD: *pmfl |= PMf_KEEP; break; + case KEEPCOPY_PAT_MOD: *pmfl |= PMf_KEEPCOPY; break; + } + } } STATIC char * @@ -10805,7 +10794,7 @@ S_scan_pat(pTHX_ char *start, I32 type) PMOP *pm; char *s = scan_str(start,!!PL_madskills,FALSE); const char * const valid_flags = - (const char *)((type == OP_QR) ? "iomsx" : "iogcmsx"); + (const char *)((type == OP_QR) ? QR_PAT_MODS : M_PAT_MODS); #ifdef PERL_MAD char *modstart; #endif @@ -10838,7 +10827,8 @@ S_scan_pat(pTHX_ char *start, I32 type) if ((pm->op_pmflags & PMf_CONTINUE) && !(pm->op_pmflags & PMf_GLOBAL) && ckWARN(WARN_REGEXP)) { - Perl_warner(aTHX_ packWARN(WARN_REGEXP), "Use of /c modifier is meaningless without /g" ); + Perl_warner(aTHX_ packWARN(WARN_REGEXP), + "Use of /c modifier is meaningless without /g" ); } pm->op_pmpermflags = pm->op_pmflags; @@ -10902,11 +10892,11 @@ S_scan_subst(pTHX_ char *start) #endif while (*s) { - if (*s == 'e') { + if (*s == EXEC_PAT_MOD) { s++; es++; } - else if (strchr("iogcmsx", *s)) + else if (strchr(S_PAT_MODS, *s)) pmflag(&pm->op_pmflags,*s++); else break; @@ -11017,7 +11007,7 @@ S_scan_trans(pTHX_ char *start) } no_more: - Newx(tbl, complement&&!del?258:256, short); + tbl = (short *)PerlMemShared_calloc(complement&&!del?258:256, sizeof(short)); o = newPVOP(OP_TRANS, 0, (char*)tbl); o->op_private &= ~OPpTRANS_ALL; o->op_private |= del|squash|complement| @@ -11269,7 +11259,7 @@ S_scan_heredoc(pTHX_ register char *s) PL_bufend[-1] = '\n'; #endif if (PERLDB_LINE && PL_curstash != PL_debstash) - update_debugger_info_sv(PL_linestr); + update_debugger_info(PL_linestr, NULL, 0); if (*s == term && memEQ(s,PL_tokenbuf,len)) { STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr); *(SvPVX(PL_linestr) + off ) = ' '; @@ -11766,7 +11756,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims) /* update debugger info */ if (PERLDB_LINE && PL_curstash != PL_debstash) - update_debugger_info_sv(PL_linestr); + update_debugger_info(PL_linestr, NULL, 0); /* having changed the buffer, we must update PL_bufend */ PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr); @@ -12499,13 +12489,13 @@ Perl_yyerror(pTHX_ const char *s) PL_multi_end = 0; } if (PL_in_eval & EVAL_WARNONLY && ckWARN_d(WARN_SYNTAX)) - Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, (void*)msg); + Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "%"SVf, SVfARG(msg)); else qerror(msg); if (PL_error_count >= 10) { if (PL_in_eval && SvCUR(ERRSV)) Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n", - (void*)ERRSV, OutCopFILE(PL_curcop)); + SVfARG(ERRSV), OutCopFILE(PL_curcop)); else Perl_croak(aTHX_ "%s has too many errors.\n", OutCopFILE(PL_curcop));