diff options
| -rw-r--r-- | MANIFEST | 1 | ||||
| -rw-r--r-- | embedvar.h | 6 | ||||
| -rw-r--r-- | intrpvar.h | 4 | ||||
| -rw-r--r-- | parser.h | 34 | ||||
| -rw-r--r-- | perl.h | 1 | ||||
| -rw-r--r-- | perlapi.h | 6 | ||||
| -rw-r--r-- | perly.c | 106 | ||||
| -rw-r--r-- | pod/perlapi.pod | 2 | ||||
| -rw-r--r-- | pod/perlintern.pod | 2 | ||||
| -rw-r--r-- | toke.c | 4 |
10 files changed, 82 insertions, 84 deletions
@@ -2915,6 +2915,7 @@ overload.h generated overload enum and name table overload.pl generate overload.h pad.c Scratchpad functions pad.h Scratchpad headers +parser.h parser object header patchlevel.h The current patch level of perl perlapi.c Perl API functions perlapi.h Perl API function declarations diff --git a/embedvar.h b/embedvar.h index 96ff9ee89c..189d4b65cc 100644 --- a/embedvar.h +++ b/embedvar.h @@ -312,6 +312,7 @@ #define PL_pad_reset_pending (vTHX->Ipad_reset_pending) #define PL_padix (vTHX->Ipadix) #define PL_padix_floor (vTHX->Ipadix_floor) +#define PL_parser (vTHX->Iparser) #define PL_patchlevel (vTHX->Ipatchlevel) #define PL_pending_ident (vTHX->Ipending_ident) #define PL_perl_destruct_level (vTHX->Iperl_destruct_level) @@ -411,8 +412,6 @@ #define PL_warnhook (vTHX->Iwarnhook) #define PL_widesyscalls (vTHX->Iwidesyscalls) #define PL_xmlfp (vTHX->Ixmlfp) -#define PL_yycharp (vTHX->Iyycharp) -#define PL_yylvalp (vTHX->Iyylvalp) #else /* !MULTIPLICITY */ @@ -610,6 +609,7 @@ #define PL_Ipad_reset_pending PL_pad_reset_pending #define PL_Ipadix PL_padix #define PL_Ipadix_floor PL_padix_floor +#define PL_Iparser PL_parser #define PL_Ipatchlevel PL_patchlevel #define PL_Ipending_ident PL_pending_ident #define PL_Iperl_destruct_level PL_perl_destruct_level @@ -709,8 +709,6 @@ #define PL_Iwarnhook PL_warnhook #define PL_Iwidesyscalls PL_widesyscalls #define PL_Ixmlfp PL_xmlfp -#define PL_Iyycharp PL_yycharp -#define PL_Iyylvalp PL_yylvalp #define PL_TSv PL_Sv #define PL_TXpv PL_Xpv diff --git a/intrpvar.h b/intrpvar.h index 8c94284322..7fd8670fa5 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -402,9 +402,7 @@ PERLVARA(Ilast_swash_key,10, U8) PERLVAR(Ilast_swash_tmps, U8 *) PERLVAR(Ilast_swash_slen, STRLEN) -/* perly.c globals */ -PERLVAR(Iyycharp, int *) -PERLVAR(Iyylvalp, YYSTYPE *) +PERLVAR(Iparser, yy_parser *) /* current parser state */ PERLVARI(Iglob_index, int, 0) PERLVAR(Isrand_called, bool) diff --git a/parser.h b/parser.h new file mode 100644 index 0000000000..51bcf88ccf --- /dev/null +++ b/parser.h @@ -0,0 +1,34 @@ +/* parser.h + * + * Copyright (c) 2006 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. + * + * This file defines the layout of the parser object used by the parser + * and lexer (perly.c, toke,c). + */ + +typedef struct { + YYSTYPE val; /* semantic value */ + short state; + AV *comppad; /* value of PL_comppad when this value was created */ +#ifdef DEBUGGING + const char *name; /* token/rule name for -Dpv */ +#endif +} yy_stack_frame; + +typedef struct { + int yychar; /* The lookahead symbol. */ + YYSTYPE yylval; /* value of lookahead symbol, set by yylex() */ + + /* Number of tokens to shift before error messages enabled. */ + int yyerrstatus; + + int stack_size; + int yylen; /* length of active reduction */ + yy_stack_frame *ps; /* current stack frame */ + yy_stack_frame stack[1]; /* will actually be as many as needed */ +} yy_parser; + + @@ -3236,6 +3236,7 @@ typedef struct crypt_data { /* straight from /usr/include/crypt.h */ # define YYTOKENTYPE #endif #include "perly.h" +#include "parser.h" #ifdef PERL_MAD struct nexttoken { @@ -502,6 +502,8 @@ END_EXTERN_C #define PL_padix (*Perl_Ipadix_ptr(aTHX)) #undef PL_padix_floor #define PL_padix_floor (*Perl_Ipadix_floor_ptr(aTHX)) +#undef PL_parser +#define PL_parser (*Perl_Iparser_ptr(aTHX)) #undef PL_patchlevel #define PL_patchlevel (*Perl_Ipatchlevel_ptr(aTHX)) #undef PL_pending_ident @@ -700,10 +702,6 @@ END_EXTERN_C #define PL_widesyscalls (*Perl_Iwidesyscalls_ptr(aTHX)) #undef PL_xmlfp #define PL_xmlfp (*Perl_Ixmlfp_ptr(aTHX)) -#undef PL_yycharp -#define PL_yycharp (*Perl_Iyycharp_ptr(aTHX)) -#undef PL_yylvalp -#define PL_yylvalp (*Perl_Iyylvalp_ptr(aTHX)) #undef PL_Sv #define PL_Sv (*Perl_TSv_ptr(aTHX)) #undef PL_Xpv @@ -34,24 +34,6 @@ typedef unsigned short int yytype_uint16; typedef short int yytype_int16; typedef signed char yysigned_char; -typedef struct { - YYSTYPE val; /* semantic value */ - short state; - AV *comppad; /* value of PL_comppad when this value was created */ -#ifdef DEBUGGING - const char *name; /* token/rule name for -Dpv */ -#endif -} yy_stack_frame; - -typedef struct { - int stack_size; - int reduce_len; /* XXX integrate with yylen ? */ - yy_stack_frame *ps; /* current stack frame */ - yy_stack_frame stack[1]; /* will actually be as many as needed */ -} yy_parser; - - - #ifdef DEBUGGING # define YYDEBUG 1 #else @@ -268,7 +250,7 @@ S_clear_yystack(pTHX_ const void *p) /* free any reducing ops (1st pass) */ - for (i=0; i< parser->reduce_len; i++) { + for (i=0; i< parser->yylen; i++) { if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval && ps[-i].val.opval) { if (ps[-i].comppad != PL_comppad) { @@ -309,33 +291,24 @@ Perl_yyparse (pTHX) #endif { dVAR; - int yychar; /* The lookahead symbol. */ - YYSTYPE yylval; /* The semantic value of the lookahead symbol. */ - int yynerrs; /* Number of syntax errors so far. */ register int yystate; register int yyn; int yyresult; - /* Number of tokens to shift before error messages enabled. */ - int yyerrstatus; /* Lookahead token as an internal (translated) token number. */ - int yytoken = 0; + int yytoken; SV *parser_sv; /* SV whose PVX holds the parser object */ - yy_parser *parser; /* the parser object */ + register yy_parser *parser; /* the parser object */ register yy_stack_frame *ps; /* current parser stack frame */ #define YYPOPSTACK parser->ps = --ps #define YYPUSHSTACK parser->ps = ++ps /* The variables used to return semantic value and location from the - action routines. */ + action routines: ie $$. */ YYSTYPE yyval; - /* When reducing, the number of symbols on the RHS of the reduced - rule. */ - int yylen; - #ifndef PERL_IN_MADLY_C # ifdef PERL_MAD if (PL_madskills) @@ -346,15 +319,12 @@ Perl_yyparse (pTHX) YYDPRINTF ((Perl_debug_log, "Starting parse\n")); ENTER; /* force stack free before we return */ - SAVEVPTR(PL_yycharp); - SAVEVPTR(PL_yylvalp); - PL_yycharp = &yychar; /* so PL_yyerror() can access it */ - PL_yylvalp = &yylval; /* so various functions in toke.c can access it */ + SAVEVPTR(PL_parser); parser_sv = newSV(sizeof(yy_parser) + (YYINITDEPTH-1) * sizeof(yy_stack_frame)); SAVEFREESV(parser_sv); - parser = (yy_parser*) SvPVX(parser_sv); + PL_parser = parser = (yy_parser*) SvPVX(parser_sv); ps = (yy_stack_frame*) &parser->stack[0]; parser->ps = ps; @@ -365,9 +335,8 @@ Perl_yyparse (pTHX) ps->state = 0; - yyerrstatus = 0; - yynerrs = 0; - yychar = YYEMPTY; /* Cause a token to be read. */ + parser->yyerrstatus = 0; + parser->yychar = YYEMPTY; /* Cause a token to be read. */ /*------------------------------------------------------------. | yynewstate -- Push a new state, which is found in yystate. | @@ -383,7 +352,7 @@ Perl_yyparse (pTHX) ps->val.opval->op_latefreed = 0; } - parser->reduce_len = 0; + parser->yylen = 0; { size_t size = ps - &parser->stack[0] + 1; @@ -394,7 +363,8 @@ Perl_yyparse (pTHX) if (size >= parser->stack_size - 1) { /* this will croak on insufficient memory */ parser->stack_size *= 2; - parser = (yy_parser*) SvGROW(parser_sv, sizeof(yy_parser) + PL_parser = parser = + (yy_parser*) SvGROW(parser_sv, sizeof(yy_parser) + (parser->stack_size-1) * sizeof(yy_stack_frame)); /* readdress any pointers into realloced parser object */ @@ -418,28 +388,28 @@ Perl_yyparse (pTHX) /* Not known => get a lookahead token if don't already have one. */ /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */ - if (yychar == YYEMPTY) { + if (parser->yychar == YYEMPTY) { YYDPRINTF ((Perl_debug_log, "Reading a token: ")); #ifdef PERL_IN_MADLY_C - yychar = PL_madskills ? madlex() : yylex(); + parser->yychar = PL_madskills ? madlex() : yylex(); #else - yychar = yylex(); + parser->yychar = yylex(); #endif # ifdef EBCDIC - if (yychar >= 0 && yychar < 255) { - yychar = NATIVE_TO_ASCII(yychar); + if (parser->yychar >= 0 && parser->yychar < 255) { + parser->yychar = NATIVE_TO_ASCII(parser->yychar); } # endif } - if (yychar <= YYEOF) { - yychar = yytoken = YYEOF; + if (parser->yychar <= YYEOF) { + parser->yychar = yytoken = YYEOF; YYDPRINTF ((Perl_debug_log, "Now at end of input.\n")); } else { - yytoken = YYTRANSLATE (yychar); - YYDSYMPRINTF ("Next token is", yytoken, &yylval); + yytoken = YYTRANSLATE (parser->yychar); + YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval); } /* If the proper action on seeing token YYTOKEN is to reduce or to @@ -462,12 +432,12 @@ Perl_yyparse (pTHX) YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken])); /* Discard the token being shifted unless it is eof. */ - if (yychar != YYEOF) - yychar = YYEMPTY; + if (parser->yychar != YYEOF) + parser->yychar = YYEMPTY; YYPUSHSTACK; ps->state = yyn; - ps->val = yylval; + ps->val = parser->yylval; ps->comppad = PL_comppad; #ifdef DEBUGGING ps->name = (const char *)(yytname[yytoken]); @@ -475,8 +445,8 @@ Perl_yyparse (pTHX) /* Count tokens shifted since error; after three, turn off error status. */ - if (yyerrstatus) - yyerrstatus--; + if (parser->yyerrstatus) + parser->yyerrstatus--; goto yynewstate; @@ -496,7 +466,7 @@ Perl_yyparse (pTHX) `-----------------------------*/ yyreduce: /* yyn is the number of a rule to reduce with. */ - yylen = yyr2[yyn]; + parser->yylen = yyr2[yyn]; /* If YYLEN is nonzero, implement the default value of the action: "$$ = $1". @@ -506,14 +476,11 @@ Perl_yyparse (pTHX) users should not rely upon it. Assigning to YYVAL unconditionally makes the parser a bit smaller, and it avoids a GCC warning that YYVAL may be used uninitialized. */ - yyval = ps[1-yylen].val; + yyval = ps[1-parser->yylen].val; YY_STACK_PRINT(parser); YY_REDUCE_PRINT (yyn); - /* if we croak during a reduce, this many tokens need special clean up */ - parser->reduce_len = yylen; - switch (yyn) { @@ -548,7 +515,7 @@ Perl_yyparse (pTHX) * freed; the rest need the flag resetting */ { int i; - for (i=0; i< yylen; i++) { + for (i=0; i< parser->yylen; i++) { if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval && ps[-i].val.opval) { @@ -559,7 +526,7 @@ Perl_yyparse (pTHX) } } - parser->ps = ps -= (yylen-1); + parser->ps = ps -= (parser->yylen-1); /* Now shift the result of the reduction. Determine what state that goes to, based on the state we popped back to and the rule @@ -588,18 +555,17 @@ Perl_yyparse (pTHX) `------------------------------------*/ yyerrlab: /* If not already recovering from an error, report this error. */ - if (!yyerrstatus) { - ++yynerrs; + if (!parser->yyerrstatus) { yyerror ("syntax error"); } - if (yyerrstatus == 3) { + if (parser->yyerrstatus == 3) { /* If just tried and failed to reuse lookahead token after an error, discard it. */ /* Return failure if at end of input. */ - if (yychar == YYEOF) { + if (parser->yychar == YYEOF) { /* Pop the error token. */ YYPOPSTACK; /* Pop the rest of the stack. */ @@ -620,8 +586,8 @@ Perl_yyparse (pTHX) YYABORT; } - YYDSYMPRINTF ("Error: discarding", yytoken, &yylval); - yychar = YYEMPTY; + YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval); + parser->yychar = YYEMPTY; } @@ -634,7 +600,7 @@ Perl_yyparse (pTHX) | yyerrlab1 -- error raised explicitly by an action. | `----------------------------------------------------*/ yyerrlab1: - yyerrstatus = 3; /* Each real token shifted decrements this. */ + parser->yyerrstatus = 3; /* Each real token shifted decrements this. */ for (;;) { yyn = yypact[yystate]; @@ -673,7 +639,7 @@ Perl_yyparse (pTHX) YYPUSHSTACK; ps->state = yyn; - ps->val = yylval; + ps->val = parser->yylval; ps->comppad = PL_comppad; #ifdef DEBUGGING ps->name ="<err>"; diff --git a/pod/perlapi.pod b/pod/perlapi.pod index 3ea050e943..5cdc152387 100644 --- a/pod/perlapi.pod +++ b/pod/perlapi.pod @@ -4631,6 +4631,8 @@ Found in file sv.h X<SvUTF8> Returns a boolean indicating whether the SV contains UTF-8 encoded data. +Call this after SvPV() in case any call to string overloading updates the +internal flag. bool SvUTF8(SV* sv) diff --git a/pod/perlintern.pod b/pod/perlintern.pod index 5c901cd47d..785a36a3f6 100644 --- a/pod/perlintern.pod +++ b/pod/perlintern.pod @@ -621,7 +621,7 @@ in PL_op->op_targ), wasting a name SV for them doesn't make sense. The SVs in the names AV have their PV being the name of the variable. NV+1..IV inclusive is a range of cop_seq numbers for which the name is valid. For typed lexicals name SV is SVt_PVMG and SvSTASH points at the -type. For C<our> lexicals, the type is also SVt_PVGV, with the MAGIC slot +type. For C<our> lexicals, the type is also SVt_PVMG, with the OURSTASH slot pointing at the stash of the associated global (so that duplicate C<our> declarations in the same package can be detected). SvCUR is sometimes hijacked to store the generation number during compilation. @@ -23,8 +23,7 @@ #define PERL_IN_TOKE_C #include "perl.h" -#define yychar (*PL_yycharp) -#define yylval (*PL_yylvalp) +#define yylval (PL_parser->yylval) static const char ident_too_long[] = "Identifier too long"; static const char commaless_variable_list[] = "comma-less variable list"; @@ -12381,6 +12380,7 @@ Perl_yyerror(pTHX_ const char *s) const char *context = NULL; int contlen = -1; SV *msg; + int yychar = PL_parser->yychar; if (!yychar || (yychar == ';' && !PL_rsfp)) where = "at EOF"; |