This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
move parser state into new parser object, PL_parser
authorDave Mitchell <davem@fdisolutions.com>
Mon, 18 Dec 2006 00:24:01 +0000 (00:24 +0000)
committerDave Mitchell <davem@fdisolutions.com>
Mon, 18 Dec 2006 00:24:01 +0000 (00:24 +0000)
p4raw-id: //depot/perl@29570

MANIFEST
embedvar.h
intrpvar.h
parser.h [new file with mode: 0644]
perl.h
perlapi.h
perly.c
pod/perlapi.pod
pod/perlintern.pod
toke.c

index 0a57c58..36d440c 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -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
index 96ff9ee..189d4b6 100644 (file)
 #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)
 #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 */
 
 #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
 #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
index 8c94284..7fd8670 100644 (file)
@@ -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 (file)
index 0000000..51bcf88
--- /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;
+    
+
diff --git a/perl.h b/perl.h
index 12be192..1742d61 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -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 {
index 230d09f..2547323 100644 (file)
--- a/perlapi.h
+++ b/perlapi.h
@@ -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
diff --git a/perly.c b/perly.c
index 1aaa228..ad01d38 100644 (file)
--- a/perly.c
+++ b/perly.c
@@ -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>";
index 3ea050e..5cdc152 100644 (file)
@@ -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)
 
index 5c901cd..785a36a 100644 (file)
@@ -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.
diff --git a/toke.c b/toke.c
index 0bbc1d9..32edd1d 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -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";