X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/12fbd33b4c244f0a97c39c9f6411b444814dbc56..8d84f763ec53af119912243b7f699da317bdde34:/perly.c

diff --git a/perly.c b/perly.c
index 2e8da75..41978fa 100644
--- a/perly.c
+++ b/perly.c
@@ -1,14 +1,15 @@
 /*    perly.c
  *
- *    Copyright (c) 2004 Larry Wall
+ *    Copyright (c) 2004, 2005, 2006, 2007, 2008,
+ *    2009, 2010, 2011 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.
  * 
  *    Note that this file was originally generated as an output from
  *    GNU bison version 1.875, but now the code is statically maintained
- *    and edited; the bits that are dependent on perly.y are now #included
- *    from the files perly.tab and perly.act.
+ *    and edited; the bits that are dependent on perly.y are now
+ *    #included from the files perly.tab and perly.act.
  *
  *    Here is an important copyright statement from the original, generated
  *    file:
@@ -17,65 +18,53 @@
  *	Bison output file, you may use that output file without
  *	restriction.  This special exception was added by the Free
  *	Software Foundation in version 1.24 of Bison.
+ *
  */
 
-
-/* allow stack size to grow effectively without limit */
-#define YYMAXDEPTH 10000000
-
 #include "EXTERN.h"
 #define PERL_IN_PERLY_C
 #include "perl.h"
+#include "feature.h"
+#include "keywords.h"
 
+typedef unsigned char yytype_uint8;
+typedef signed char yytype_int8;
+typedef unsigned short int yytype_uint16;
+typedef short int yytype_int16;
 typedef signed char yysigned_char;
 
+/* YYINITDEPTH -- initial size of the parser's stacks.  */
+#define YYINITDEPTH 200
+
+#ifdef YYDEBUG
+#  undef YYDEBUG
+#endif
 #ifdef DEBUGGING
 #  define YYDEBUG 1
 #else
 #  define YYDEBUG 0
 #endif
 
+#ifndef YY_NULL
+# define YY_NULL 0
+#endif
+
+#ifndef YY_NULLPTR
+# define YY_NULLPTR NULL
+#endif
+
 /* contains all the parser state tables; auto-generated from perly.y */
 #include "perly.tab"
 
 # define YYSIZE_T size_t
 
-#define yyerrok		(yyerrstatus = 0)
-#define yyclearin	(yychar = YYEMPTY)
-#define YYEMPTY		(-2)
 #define YYEOF		0
+#define YYTERROR	1
 
 #define YYACCEPT	goto yyacceptlab
 #define YYABORT		goto yyabortlab
 #define YYERROR		goto yyerrlab1
 
-
-/* Like YYERROR except do call yyerror.  This remains here temporarily
-   to ease the transition to the new meaning of YYERROR, for GCC.
-   Once GCC version 2 has supplanted version 1, this can go.  */
-
-#define YYFAIL		goto yyerrlab
-
-#define YYRECOVERING()  (!!yyerrstatus)
-
-#define YYBACKUP(Token, Value)					\
-do								\
-    if (yychar == YYEMPTY && yylen == 1) {			\
-	yychar = (Token);					\
-	yylval = (Value);					\
-	yytoken = YYTRANSLATE (yychar);				\
-	YYPOPSTACK;						\
-	goto yybackup;						\
-    }								\
-    else {							\
-	yyerror ("syntax error: cannot back up");		\
-	YYERROR;						\
-    }								\
-while (0)
-
-#define YYTERROR	1
-#define YYERRCODE	256
-
 /* Enable debugging if requested.  */
 #ifdef DEBUGGING
 
@@ -89,12 +78,6 @@ do {						\
 	YYFPRINTF Args;				\
 } while (0)
 
-#  define YYDSYMPRINT(Args)			\
-do {						\
-    if (yydebug)				\
-	yysymprint Args;			\
-} while (0)
-
 #  define YYDSYMPRINTF(Title, Token, Value)			\
 do {								\
     if (yydebug) {						\
@@ -109,65 +92,73 @@ do {								\
 `--------------------------------*/
 
 static void
-yysymprint (pTHX_ PerlIO *yyoutput, int yytype, YYSTYPE *yyvaluep)
+yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
 {
-    /* Pacify ``unused variable'' warnings.  */
-    (void) yyvaluep;
-
+    PERL_UNUSED_CONTEXT;
     if (yytype < YYNTOKENS) {
 	YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
 #   ifdef YYPRINT
 	YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
 #   else
-	YYFPRINTF (yyoutput, "0x%x", yyvaluep->ival);
+	YYFPRINTF (yyoutput, "0x%" UVxf, (UV)yyvaluep->ival);
 #   endif
     }
     else
 	YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
 
-    switch (yytype) {
-	default:
-	    break;
-    }
     YYFPRINTF (yyoutput, ")");
 }
 
 
 /*  yy_stack_print()
- *  print the top 8 items on the parse stack.  The args have the same
- *  meanings as the local vars in yyparse() of the same name */
+ *  print the top 8 items on the parse stack.
+ */
 
 static void
-yy_stack_print (pTHX_ short *yyss, short *yyssp, YYSTYPE *yyvs, char**yyns)
+yy_stack_print (pTHX_ const yy_parser *parser)
 {
-    int i;
-    int start = 1;
-    int count = (int)(yyssp - yyss);
+    const yy_stack_frame *ps, *min;
 
-    if (count > 8) {
-	start = count - 8 + 1;
-	count = 8;
-    }
+    min = parser->ps - 8 + 1;
+    if (min <= parser->stack)
+	min = parser->stack + 1;
 
     PerlIO_printf(Perl_debug_log, "\nindex:");
-    for (i=0; i < count; i++)
-	PerlIO_printf(Perl_debug_log, " %8d", start+i);
+    for (ps = min; ps <= parser->ps; ps++)
+	PerlIO_printf(Perl_debug_log, " %8d", (int)(ps - parser->stack));
+
     PerlIO_printf(Perl_debug_log, "\nstate:");
-    for (i=0, yyss += start; i < count; i++, yyss++)
-	PerlIO_printf(Perl_debug_log, " %8d", *yyss);
+    for (ps = min; ps <= parser->ps; ps++)
+	PerlIO_printf(Perl_debug_log, " %8d", ps->state);
+
     PerlIO_printf(Perl_debug_log, "\ntoken:");
-    for (i=0, yyns += start; i < count; i++, yyns++)
-	PerlIO_printf(Perl_debug_log, " %8.8s", *yyns);
+    for (ps = min; ps <= parser->ps; ps++)
+	PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
+
     PerlIO_printf(Perl_debug_log, "\nvalue:");
-    for (i=0, yyvs += start; i < count; i++, yyvs++)
-	PerlIO_printf(Perl_debug_log, " %8x", yyvs->ival);
+    for (ps = min; ps <= parser->ps; ps++) {
+	switch (yy_type_tab[yystos[ps->state]]) {
+	case toketype_opval:
+	    PerlIO_printf(Perl_debug_log, " %8.8s",
+		  ps->val.opval
+		    ? PL_op_name[ps->val.opval->op_type]
+		    : "(Nullop)"
+	    );
+	    break;
+	case toketype_ival:
+	    PerlIO_printf(Perl_debug_log, " %8" IVdf, (IV)ps->val.ival);
+	    break;
+	default:
+	    PerlIO_printf(Perl_debug_log, " %8" UVxf, (UV)ps->val.ival);
+	}
+    }
     PerlIO_printf(Perl_debug_log, "\n\n");
 }
 
-#  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)		\
-do {								\
-    if (yydebug && DEBUG_v_TEST)				\
-	yy_stack_print (aTHX_ (yyss), (yyssp), (yyvs), (yyns));	\
+#  define YY_STACK_PRINT(parser)	\
+do {					\
+    if (yydebug && DEBUG_v_TEST)	\
+	yy_stack_print (aTHX_ parser);	\
 } while (0)
 
 
@@ -179,12 +170,18 @@ static void
 yy_reduce_print (pTHX_ int yyrule)
 {
     int yyi;
-    unsigned int yylineno = yyrline[yyrule];
+    const unsigned int yylineno = yyrline[yyrule];
     YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
 			  yyrule - 1, yylineno);
     /* Print the symbols being reduced, and their result.  */
+#if PERL_BISON_VERSION >= 30000 /* 3.0+ */
+    for (yyi = 0; yyi < yyr2[yyrule]; yyi++)
+	YYFPRINTF (Perl_debug_log, "%s ",
+            yytname [yystos[(PL_parser->ps)[yyi + 1 - yyr2[yyrule]].state]]);
+#else
     for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
 	YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
+#endif
     YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
 }
 
@@ -196,78 +193,51 @@ do {					\
 
 #else /* !DEBUGGING */
 #  define YYDPRINTF(Args)
-#  define YYDSYMPRINT(Args)
 #  define YYDSYMPRINTF(Title, Token, Value)
-#  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)
+#  define YY_STACK_PRINT(parser)
 #  define YY_REDUCE_PRINT(Rule)
 #endif /* !DEBUGGING */
 
+/* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
+ * parse stack, thus avoiding leaks if we die  */
 
-/* YYINITDEPTH -- initial size of the parser's stacks.  */
-#ifndef	YYINITDEPTH
-# define YYINITDEPTH 200
-#endif
-
-
-#if YYERROR_VERBOSE
-#  ifndef yystrlen
-#    if defined (__GLIBC__) && defined (_STRING_H)
-#      define yystrlen strlen
-#    else
-/* Return the length of YYSTR.  */
-static YYSIZE_T
-yystrlen (const char *yystr)
-{
-    register const char *yys = yystr;
-
-    while (*yys++ != '\0')
-	continue;
-
-    return yys - yystr - 1;
-}
-#    endif
-#  endif
-
-#  ifndef yystpcpy
-#    if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE)
-#      define yystpcpy stpcpy
-#    else
-/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
-   YYDEST.  */
-static char *
-yystpcpy (pTHX_ char *yydest, const char *yysrc)
+static void
+S_clear_yystack(pTHX_  const yy_parser *parser)
 {
-    register char *yyd = yydest;
-    register const char *yys = yysrc;
-
-    while ((*yyd++ = *yys++) != '\0')
-	continue;
-
-    return yyd - 1;
-}
-#    endif
-#  endif
-
-#endif /* !YYERROR_VERBOSE */
+    yy_stack_frame *ps     = parser->ps;
+    int i = 0;
 
+    if (!parser->stack)
+	return;
 
-/*-----------------------------------------------.
-| Release the memory associated to this symbol.  |
-`-----------------------------------------------*/
+    YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
 
-static void
-yydestruct (int yytype, YYSTYPE *yyvaluep)
-{
-    /* Pacify ``unused variable'' warnings.  */
-    (void) yyvaluep;
-
-    switch (yytype) {
-	default:
-	    break;
+    for (i=0; i< parser->yylen; i++) {
+	SvREFCNT_dec(ps[-i].compcv);
+    }
+    ps -= parser->yylen;
+
+    /* now free whole the stack, including the just-reduced ops */
+
+    while (ps > parser->stack) {
+	LEAVE_SCOPE(ps->savestack_ix);
+	if (yy_type_tab[yystos[ps->state]] == toketype_opval
+	    && ps->val.opval)
+	{
+	    if (ps->compcv && (ps->compcv != PL_compcv)) {
+		PL_compcv = ps->compcv;
+		PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
+		PL_comppad_name = PadlistNAMES(CvPADLIST(PL_compcv));
+	    }
+	    YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
+	    op_free(ps->val.opval);
+	}
+	SvREFCNT_dec(ps->compcv);
+	ps--;
     }
-}
-
 
+    Safefree(parser->stack);
+}
 
 
 /*----------.
@@ -275,429 +245,328 @@ yydestruct (int yytype, YYSTYPE *yyvaluep)
 `----------*/
 
 int
-Perl_yyparse (pTHX)
+Perl_yyparse (pTHX_ int gramtype)
 {
-    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;
+    dVAR;
+    int yystate;
+    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;
 
-    /* two stacks and their tools:
-	  `yyss': related to states,
-	  `yyvs': related to semantic values,
-
-	  Refer to the stacks thru separate pointers, to allow yyoverflow
-	  to reallocate them elsewhere.  */
-
-    /* The state stack.  */
-    short *yyss;
-    register short *yyssp;
-
-    /* The semantic value stack.  */
-    YYSTYPE *yyvs;
-    register YYSTYPE *yyvsp;
-
-    /* for ease of re-allocation and automatic freeing, have two SVs whose
-      * SvPVX points to the stacks */
-    SV *yyss_sv, *yyvs_sv;
+    yy_parser *parser;	    /* the parser object */
+    yy_stack_frame  *ps;   /* current parser stack frame */
 
-#ifdef DEBUGGING
-    /* maintain also a stack of token/rule names for debugging with -Dpv */
-    char **yyns, **yynsp;
-    SV *yyns_sv;
-#  define YYPOPSTACK   (yyvsp--, yyssp--, yynsp--)
-#else
-#  define YYPOPSTACK   (yyvsp--, yyssp--)
-#endif
-
-
-    YYSIZE_T yystacksize = YYINITDEPTH;
+#define YYPOPSTACK   parser->ps = --ps
+#define YYPUSHSTACK  parser->ps = ++ps
 
-    /* The variables used to return semantic value and location from the
-	  action routines.  */
+    /* The variable used to return semantic value and location from the
+	  action routines: ie $$.  */
     YYSTYPE yyval;
 
-
-    /* When reducing, the number of symbols on the RHS of the reduced
-	  rule.  */
-    int yylen;
-
     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 */
-
-    yyss_sv = NEWSV(73, YYINITDEPTH * sizeof(short));
-    yyvs_sv = NEWSV(73, YYINITDEPTH * sizeof(YYSTYPE));
-    SAVEFREESV(yyss_sv);
-    SAVEFREESV(yyvs_sv);
-    yyss = (short *) SvPVX(yyss_sv);
-    yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
-    /* note that elements zero of yyvs and yyns are not used */
-    yyssp = yyss;
-    yyvsp = yyvs;
+    parser = PL_parser;
+
+    ENTER;  /* force parser state cleanup/restoration before we return */
+    SAVEPPTR(parser->yylval.pval);
+    SAVEINT(parser->yychar);
+    SAVEINT(parser->yyerrstatus);
+    SAVEINT(parser->yylen);
+    SAVEVPTR(parser->stack);
+    SAVEVPTR(parser->stack_max1);
+    SAVEVPTR(parser->ps);
+
+    /* initialise state for this parse */
+    parser->yychar = gramtype;
+    yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar));
+
+    parser->yyerrstatus = 0;
+    parser->yylen = 0;
+    Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
+    parser->stack_max1 = parser->stack + YYINITDEPTH - 1;
+    ps = parser->ps = parser->stack;
+    ps->state = 0;
+    SAVEDESTRUCTOR_X(S_clear_yystack, parser);
+
+    while (1) {
+        /* main loop: shift some tokens, then reduce when possible */
+
+        while (1) {
+            /* shift a token, or quit when it's possible to reduce */
+
+            yystate = ps->state;
+
+            YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
+
+            parser->yylen = 0;
+
+            /* Grow the stack? We always leave 1 spare slot, in case of a
+             * '' -> 'foo' reduction.
+             * Note that stack_max1 points to the (top-1)th allocated stack
+             * element to make this check faster */
+
+            if (ps >= parser->stack_max1) {
+                Size_t pos = ps - parser->stack;
+                Size_t newsize = 2 * (parser->stack_max1 + 2 - parser->stack);
+                /* this will croak on insufficient memory */
+                Renew(parser->stack, newsize, yy_stack_frame);
+                ps = parser->ps = parser->stack + pos;
+                parser->stack_max1 = parser->stack + newsize - 1;
+
+                YYDPRINTF((Perl_debug_log,
+                                "parser stack size increased to %lu frames\n",
+                                (unsigned long int)newsize));
+            }
+
+            /* Do appropriate processing given the current state. Read a
+             * lookahead token if we need one and don't already have one.
+             * */
+
+            /* First try to decide what to do without reference to
+             * lookahead token. */
+
+            yyn = yypact[yystate];
+            if (yyn == YYPACT_NINF)
+                goto yydefault;
+
+            /* Not known => get a lookahead token if don't already have
+             * one.  YYCHAR is either YYEMPTY or YYEOF or a valid
+             * lookahead symbol. */
+
+            if (parser->yychar == YYEMPTY) {
+                YYDPRINTF ((Perl_debug_log, "Reading a token:\n"));
+                parser->yychar = yylex();
+                assert(parser->yychar >= 0);
+                if (parser->yychar == YYEOF) {
+                    YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
+                }
+                /* perly.tab is shipped based on an ASCII system, so need
+                 * to index it with characters translated to ASCII.
+                 * Although it's not designed for this purpose, we can use
+                 * NATIVE_TO_UNI here.  It returns its argument on ASCII
+                 * platforms, and on EBCDIC translates native to ascii in
+                 * the 0-255 range, leaving every other possible input
+                 * unchanged.  This jibes with yylex() returning some bare
+                 * characters in that range, but all tokens it returns are
+                 * either 0, or above 255.  There could be a problem if NULs
+                 * weren't 0, or were ever returned as raw chars by yylex() */
+                yytoken = YYTRANSLATE(NATIVE_TO_UNI(parser->yychar));
+            }
+
+            /* make sure no-one's changed yychar since the last call to yylex */
+            assert(yytoken == YYTRANSLATE(NATIVE_TO_UNI(parser->yychar)));
+            YYDSYMPRINTF("lookahead token is", yytoken, &parser->yylval);
+
+
+            /* If the proper action on seeing token YYTOKEN is to reduce or to
+             * detect an error, take that action.
+             * Casting yyn to unsigned allows a >=0 test to be included as
+             * part of the  <=YYLAST test for speed */
+            yyn += yytoken;
+            if ((unsigned int)yyn > YYLAST || yycheck[yyn] != yytoken) {
+              yydefault:
+                /* do the default action for the current state. */
+                yyn = yydefact[yystate];
+                if (yyn == 0)
+                    goto yyerrlab;
+                break; /* time to reduce */
+            }
+
+            yyn = yytable[yyn];
+            if (yyn <= 0) {
+                if (yyn == 0 || yyn == YYTABLE_NINF)
+                    goto yyerrlab;
+                yyn = -yyn;
+                break; /* time to reduce */
+            }
+
+            if (yyn == YYFINAL)
+                YYACCEPT;
+
+            /* Shift the lookahead token.  */
+            YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
+
+            /* Discard the token being shifted unless it is eof.  */
+            if (parser->yychar != YYEOF)
+                parser->yychar = YYEMPTY;
+
+            YYPUSHSTACK;
+            ps->state   = yyn;
+            ps->val     = parser->yylval;
+            ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
+            ps->savestack_ix = PL_savestack_ix;
 #ifdef DEBUGGING
-    yyns_sv = NEWSV(73, YYINITDEPTH * sizeof(char *));
-    SAVEFREESV(yyns_sv);
-    yyns = (char **) SvPVX(yyns_sv);
-    yynsp = yyns;
+            ps->name    = (const char *)(yytname[yytoken]);
 #endif
 
-    yystate = 0;
-    yyerrstatus = 0;
-    yynerrs = 0;
-    yychar = YYEMPTY;		/* Cause a token to be read.  */
-
+            /* Count tokens shifted since error; after three, turn off error
+                  status.  */
+            if (parser->yyerrstatus)
+                parser->yyerrstatus--;
 
+        }
 
-    YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
+        /* Do a reduction */
 
-    goto yysetstate;
+        /* yyn is the number of a rule to reduce with.  */
+        parser->yylen = yyr2[yyn];
 
-/*------------------------------------------------------------.
-| yynewstate -- Push a new state, which is found in yystate.  |
-`------------------------------------------------------------*/
-  yynewstate:
-    /* In all cases, when you get here, the value and location stacks
-	  have just been pushed. so pushing a state here evens the stacks.
-	  */
-    yyssp++;
+        /* If YYLEN is nonzero, implement the default value of the action:
+          "$$ = $1".
 
-  yysetstate:
-    *yyssp = yystate;
+          Otherwise, the following line sets YYVAL to garbage.
+          This behavior is undocumented and Bison
+          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-parser->yylen].val;
 
-    if (yyss + yystacksize - 1 <= yyssp) {
-	 /* Get the current used size of the three stacks, in elements.  */
-	 YYSIZE_T yysize = yyssp - yyss + 1;
+        YY_STACK_PRINT(parser);
+        YY_REDUCE_PRINT (yyn);
 
-	 /* Extend the stack our own way.  */
-	 if (YYMAXDEPTH <= yystacksize)
-	       goto yyoverflowlab;
-	 yystacksize *= 2;
-	 if (YYMAXDEPTH < yystacksize)
-	       yystacksize = YYMAXDEPTH;
+        switch (yyn) {
 
-	 SvGROW(yyss_sv, yystacksize * sizeof(short));
-	 SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
-	 yyss = (short *) SvPVX(yyss_sv);
-	 yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
-#ifdef DEBUGGING
-	 SvGROW(yyns_sv, yystacksize * sizeof(char *));
-	 yyns = (char **) SvPVX(yyns_sv);
-	 if (! yyns)
-	       goto yyoverflowlab;
-	 yynsp = yyns + yysize - 1;
-#endif
-	 if (!yyss || ! yyvs)
-	       goto yyoverflowlab;
-
-	 yyssp = yyss + yysize - 1;
-	 yyvsp = yyvs + yysize - 1;
-
-
-	 YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
-				   (unsigned long int) yystacksize));
-
-	 if (yyss + yystacksize - 1 <= yyssp)
-	       YYABORT;
-    }
-
-    goto yybackup;
-
-  /*-----------.
-  | yybackup.  |
-  `-----------*/
-  yybackup:
-
-/* Do appropriate processing given the current state.  */
-/* Read a lookahead token if we need one and don't already have one.  */
-/* yyresume: */
-
-    /* First try to decide what to do without reference to lookahead token.  */
-
-    yyn = yypact[yystate];
-    if (yyn == YYPACT_NINF)
-	goto yydefault;
-
-    /* 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) {
-	YYDPRINTF ((Perl_debug_log, "Reading a token: "));
-	yychar = yylex();
-#  ifdef EBCDIC
-	if (yychar >= 0 && yychar < 255) {
-	    yychar = NATIVE_TO_ASCII(yychar);
-	}
-#  endif
-    }
-
-    if (yychar <= YYEOF) {
-	yychar = yytoken = YYEOF;
-	YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
-    }
-    else {
-	yytoken = YYTRANSLATE (yychar);
-	YYDSYMPRINTF ("Next token is", yytoken, &yylval);
-    }
-
-    /* If the proper action on seeing token YYTOKEN is to reduce or to
-	  detect an error, take that action.  */
-    yyn += yytoken;
-    if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
-	goto yydefault;
-    yyn = yytable[yyn];
-    if (yyn <= 0) {
-	if (yyn == 0 || yyn == YYTABLE_NINF)
-	    goto yyerrlab;
-	yyn = -yyn;
-	goto yyreduce;
-    }
-
-    if (yyn == YYFINAL)
-	YYACCEPT;
-
-    /* Shift the lookahead token.  */
-    YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
-
-    /* Discard the token being shifted unless it is eof.  */
-    if (yychar != YYEOF)
-	yychar = YYEMPTY;
-
-    *++yyvsp = yylval;
-#ifdef DEBUGGING
-    *++yynsp = (char *)(yytname[yytoken]);
-#endif
-
-
-    /* Count tokens shifted since error; after three, turn off error
-	  status.  */
-    if (yyerrstatus)
-	yyerrstatus--;
-
-    yystate = yyn;
-    YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
-
-    goto yynewstate;
-
-
-  /*-----------------------------------------------------------.
-  | yydefault -- do the default action for the current state.  |
-  `-----------------------------------------------------------*/
-  yydefault:
-    yyn = yydefact[yystate];
-    if (yyn == 0)
-	goto yyerrlab;
-    goto yyreduce;
-
-
-  /*-----------------------------.
-  | yyreduce -- Do a reduction.  |
-  `-----------------------------*/
-  yyreduce:
-    /* yyn is the number of a rule to reduce with.  */
-    yylen = yyr2[yyn];
-
-    /* If YYLEN is nonzero, implement the default value of the action:
-      `$$ = $1'.
-
-      Otherwise, the following line sets YYVAL to garbage.
-      This behavior is undocumented and Bison
-      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 = yyvsp[1-yylen];
-
-
-    YY_REDUCE_PRINT (yyn);
-    switch (yyn) {
-
-/* contains all the rule actions; auto-generated from perly.y */
-
-#define dep() deprecate("\"do\" to call subroutines")
+    /* contains all the rule actions; auto-generated from perly.y */
 #include "perly.act"
 
-    }
+        }
 
-    yyvsp -= yylen;
-    yyssp -= yylen;
-#ifdef DEBUGGING
-    yynsp -= yylen;
-#endif
-
-
-    *++yyvsp = yyval;
-#ifdef DEBUGGING
-    *++yynsp = (char *)(yytname [yyr1[yyn]]);
-#endif
-
-    /* Now `shift' the result of the reduction.  Determine what state
-	  that goes to, based on the state we popped back to and the rule
-	  number reduced by.  */
+        {
+            int i;
+            for (i=0; i< parser->yylen; i++) {
+                SvREFCNT_dec(ps[-i].compcv);
+            }
+        }
 
-    yyn = yyr1[yyn];
+        parser->ps = ps -= (parser->yylen-1);
 
-    yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
-    if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
-	yystate = yytable[yystate];
-    else
-	yystate = yydefgoto[yyn - YYNTOKENS];
-
-    YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
+        /* Now shift the result of the reduction.  Determine what state
+              that goes to, based on the state we popped back to and the rule
+              number reduced by.  */
 
+        ps->val     = yyval;
+        ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
+        ps->savestack_ix = PL_savestack_ix;
 #ifdef DEBUGGING
-    /* tmp push yystate for stack print; this is normally pushed later in
-     * yynewstate */
-    yyssp++;
-    *yyssp = yystate;
-    YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
-    yyssp--;
+        ps->name    = (const char *)(yytname [yyr1[yyn]]);
 #endif
 
-    goto yynewstate;
-
-
-  /*------------------------------------.
-  | yyerrlab -- here on detecting error |
-  `------------------------------------*/
-  yyerrlab:
-    /* If not already recovering from an error, report this error.  */
-    if (!yyerrstatus) {
-	++yynerrs;
-#if YYERROR_VERBOSE
-	yyn = yypact[yystate];
-
-	if (YYPACT_NINF < yyn && yyn < YYLAST) {
-	    YYSIZE_T yysize = 0;
-	    int yytype = YYTRANSLATE (yychar);
-	    char *yymsg;
-	    int yyx, yycount;
-
-	    yycount = 0;
-	    /* Start YYX at -YYN if negative to avoid negative indexes in
-		  YYCHECK.  */
-	    for (yyx = yyn < 0 ? -yyn : 0;
-		      yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
-		if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
-		    yysize += yystrlen (yytname[yyx]) + 15, yycount++;
-	    yysize += yystrlen ("syntax error, unexpected ") + 1;
-	    yysize += yystrlen (yytname[yytype]);
-	    New(yymsg, yysize, char *);
-	    if (yymsg != 0) {
-		char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
-		yyp = yystpcpy (yyp, yytname[yytype]);
-
-		if (yycount < 5) {
-		    yycount = 0;
-		    for (yyx = yyn < 0 ? -yyn : 0;
-			      yyx < (int) (sizeof (yytname) / sizeof (char *));
-			      yyx++)
-		    {
-			if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
-			    const char *yyq = ! yycount ?
-						    ", expecting " : " or ";
-			    yyp = yystpcpy (yyp, yyq);
-			    yyp = yystpcpy (yyp, yytname[yyx]);
-			    yycount++;
-			}
-		    }
-		}
-		yyerror (yymsg);
-		YYSTACK_FREE (yymsg);
-	    }
-	    else
-		yyerror ("syntax error; also virtual memory exhausted");
-	}
-	else
-#endif /* YYERROR_VERBOSE */
-	    yyerror ("syntax error");
-    }
-
-
-    if (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) {
-	    /* Pop the error token.  */
-	    YYPOPSTACK;
-	    /* Pop the rest of the stack.  */
-	    while (yyss < yyssp) {
-		YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
-		yydestruct (yystos[*yyssp], yyvsp);
-		YYPOPSTACK;
-	    }
-	    YYABORT;
-	}
-
-	YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
-	yydestruct (yytoken, &yylval);
-	yychar = YYEMPTY;
-
-    }
-
-    /* Else will try to reuse lookahead token after shifting the error
-	  token.  */
-    goto yyerrlab1;
-
-
-  /*----------------------------------------------------.
-  | yyerrlab1 -- error raised explicitly by an action.  |
-  `----------------------------------------------------*/
-  yyerrlab1:
-    yyerrstatus = 3;	/* Each real token shifted decrements this.  */
-
-    for (;;) {
-	yyn = yypact[yystate];
-	if (yyn != YYPACT_NINF) {
-	    yyn += YYTERROR;
-	    if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
-		yyn = yytable[yyn];
-		if (0 < yyn)
-		    break;
-	    }
-	}
-
-	/* Pop the current state because it cannot handle the error token.  */
-	if (yyssp == yyss)
-	    YYABORT;
-
-	YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
-	yydestruct (yystos[yystate], yyvsp);
-	yyvsp--;
+        yyn = yyr1[yyn];
+
+        yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
+        if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
+            yystate = yytable[yystate];
+        else
+            yystate = yydefgoto[yyn - YYNTOKENS];
+        ps->state = yystate;
+
+        continue;
+
+
+      /*------------------------------------.
+      | yyerrlab -- here on detecting error |
+      `------------------------------------*/
+      yyerrlab:
+        /* If not already recovering from an error, report this error.  */
+        if (!parser->yyerrstatus) {
+            yyerror ("syntax error");
+        }
+
+
+        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 (parser->yychar == YYEOF) {
+                /* Pop the error token.  */
+                SvREFCNT_dec(ps->compcv);
+                YYPOPSTACK;
+                /* Pop the rest of the stack.  */
+                while (ps > parser->stack) {
+                    YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
+                    LEAVE_SCOPE(ps->savestack_ix);
+                    if (yy_type_tab[yystos[ps->state]] == toketype_opval
+                            && ps->val.opval)
+                    {
+                        YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
+                        if (ps->compcv != PL_compcv) {
+                            PL_compcv = ps->compcv;
+                            PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
+                        }
+                        op_free(ps->val.opval);
+                    }
+                    SvREFCNT_dec(ps->compcv);
+                    YYPOPSTACK;
+                }
+                YYABORT;
+            }
+
+            YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
+            parser->yychar = YYEMPTY;
+
+        }
+
+        /* Else will try to reuse lookahead token after shifting the error
+              token.  */
+        goto yyerrlab1;
+
+
+      /*----------------------------------------------------.
+      | yyerrlab1 -- error raised explicitly by an action.  |
+      `----------------------------------------------------*/
+      yyerrlab1:
+        parser->yyerrstatus = 3;	/* Each real token shifted decrements this.  */
+
+        for (;;) {
+            yyn = yypact[yystate];
+            if (yyn != YYPACT_NINF) {
+                yyn += YYTERROR;
+                if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
+                    yyn = yytable[yyn];
+                    if (0 < yyn)
+                        break;
+                }
+            }
+
+            /* Pop the current state because it cannot handle the error token.  */
+            if (ps == parser->stack)
+                YYABORT;
+
+            YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
+            LEAVE_SCOPE(ps->savestack_ix);
+            if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
+                YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
+                if (ps->compcv != PL_compcv) {
+                    PL_compcv = ps->compcv;
+                    PAD_SET_CUR_NOSAVE(CvPADLIST(PL_compcv), 1);
+                }
+                op_free(ps->val.opval);
+            }
+            SvREFCNT_dec(ps->compcv);
+            YYPOPSTACK;
+            yystate = ps->state;
+
+            YY_STACK_PRINT(parser);
+        }
+
+        if (yyn == YYFINAL)
+            YYACCEPT;
+
+        YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
+
+        YYPUSHSTACK;
+        ps->state   = yyn;
+        ps->val     = parser->yylval;
+        ps->compcv  = (CV*)SvREFCNT_inc(PL_compcv);
+        ps->savestack_ix = PL_savestack_ix;
 #ifdef DEBUGGING
-	yynsp--;
+        ps->name    ="<err>";
 #endif
-	yystate = *--yyssp;
 
-	YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
-    }
-
-    if (yyn == YYFINAL)
-	YYACCEPT;
-
-    YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
-
-    *++yyvsp = yylval;
-#ifdef DEBUGGING
-    *++yynsp ="<err>";
-#endif
-
-    yystate = yyn;
-    YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
-
-    goto yynewstate;
+    } /* main loop */
 
 
   /*-------------------------------------.
@@ -705,6 +574,10 @@ Perl_yyparse (pTHX)
   `-------------------------------------*/
   yyacceptlab:
     yyresult = 0;
+    for (ps=parser->ps; ps > parser->stack; ps--) {
+	SvREFCNT_dec(ps->compcv);
+    }
+    parser->ps = parser->stack; /* disable cleanup */
     goto yyreturn;
 
   /*-----------------------------------.
@@ -714,17 +587,11 @@ Perl_yyparse (pTHX)
     yyresult = 1;
     goto yyreturn;
 
-  /*----------------------------------------------.
-  | yyoverflowlab -- parser overflow comes here.  |
-  `----------------------------------------------*/
-  yyoverflowlab:
-    yyerror ("parser stack overflow");
-    yyresult = 2;
-    /* Fall through.  */
-
   yyreturn:
-
-    LEAVE;			/* force stack free before we return */
-
+    LEAVE;	/* force parser stack cleanup before we return */
     return yyresult;
 }
+
+/*
+ * ex: set ts=8 sts=4 sw=4 et:
+ */