perly.c

   1 /*    perly.c
   2  *
   3  *    Copyright (c) 2004, 2005, 2006 Larry Wall and others
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  *    Note that this file was originally generated as an output from
   9  *    GNU bison version 1.875, but now the code is statically maintained
  10  *    and edited; the bits that are dependent on perly.y are now
  11  *    #included from the files perly.tab and perly.act.
  12  *
  13  *    Here is an important copyright statement from the original, generated
  14  *    file:
  15  *
  16  *      As a special exception, when this file is copied by Bison into a
  17  *      Bison output file, you may use that output file without
  18  *      restriction.  This special exception was added by the Free
  19  *      Software Foundation in version 1.24 of Bison.
  20  *
  21  * Note that this file is also #included in madly.c, to allow compilation
  22  * of a second parser, Perl_madparse, that is identical to Perl_yyparse,
  23  * but which includes extra code for dumping the parse tree.
  24  * This is controlled by the PERL_IN_MADLY_C define.
  25  */
  26
  27
  28
  29 /* allow stack size to grow effectively without limit */
  30 #define YYMAXDEPTH 10000000
  31
  32 #include "EXTERN.h"
  33 #define PERL_IN_PERLY_C
  34 #include "perl.h"
  35
  36 typedef unsigned char yytype_uint8;
  37 typedef signed char yytype_int8;
  38 typedef unsigned short int yytype_uint16;
  39 typedef short int yytype_int16;
  40 typedef signed char yysigned_char;
  41
  42 #ifdef DEBUGGING
  43 #  define YYDEBUG 1
  44 #else
  45 #  define YYDEBUG 0
  46 #endif
  47
  48 /* contains all the parser state tables; auto-generated from perly.y */
  49 #include "perly.tab"
  50
  51 # define YYSIZE_T size_t
  52
  53 #define yyerrok         (yyerrstatus = 0)
  54 #define yyclearin       (yychar = YYEMPTY)
  55 #define YYEMPTY         (-2)
  56 #define YYEOF           0
  57
  58 #define YYACCEPT        goto yyacceptlab
  59 #define YYABORT         goto yyabortlab
  60 #define YYERROR         goto yyerrlab1
  61
  62
  63 /* Like YYERROR except do call yyerror.  This remains here temporarily
  64    to ease the transition to the new meaning of YYERROR, for GCC.
  65    Once GCC version 2 has supplanted version 1, this can go.  */
  66
  67 #define YYFAIL          goto yyerrlab
  68
  69 #define YYRECOVERING()  (!!yyerrstatus)
  70
  71 #define YYBACKUP(Token, Value)                                  \
  72 do                                                              \
  73     if (yychar == YYEMPTY && yylen == 1) {                      \
  74         yychar = (Token);                                       \
  75         yylval = (Value);                                       \
  76         yytoken = YYTRANSLATE (yychar);                         \
  77         YYPOPSTACK;                                             \
  78         goto yybackup;                                          \
  79     }                                                           \
  80     else {                                                      \
  81         yyerror ("syntax error: cannot back up");               \
  82         YYERROR;                                                \
  83     }                                                           \
  84 while (0)
  85
  86 #define YYTERROR        1
  87 #define YYERRCODE       256
  88
  89 /* Enable debugging if requested.  */
  90 #ifdef DEBUGGING
  91
  92 #  define yydebug (DEBUG_p_TEST)
  93
  94 #  define YYFPRINTF PerlIO_printf
  95
  96 #  define YYDPRINTF(Args)                       \
  97 do {                                            \
  98     if (yydebug)                                \
  99         YYFPRINTF Args;                         \
 100 } while (0)
 101
 102 #  define YYDSYMPRINTF(Title, Token, Value)                     \
 103 do {                                                            \
 104     if (yydebug) {                                              \
 105         YYFPRINTF (Perl_debug_log, "%s ", Title);               \
 106         yysymprint (aTHX_ Perl_debug_log,  Token, Value);       \
 107         YYFPRINTF (Perl_debug_log, "\n");                       \
 108     }                                                           \
 109 } while (0)
 110
 111 /*--------------------------------.
 112 | Print this symbol on YYOUTPUT.  |
 113 `--------------------------------*/
 114
 115 static void
 116 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
 117 {
 118     if (yytype < YYNTOKENS) {
 119         YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
 120 #   ifdef YYPRINT
 121         YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
 122 #   else
 123         YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
 124 #   endif
 125     }
 126     else
 127         YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
 128
 129     YYFPRINTF (yyoutput, ")");
 130 }
 131
 132
 133 /*  yy_stack_print()
 134  *  print the top 8 items on the parse stack.  The args have the same
 135  *  meanings as the local vars in yyparse() of the same name */
 136
 137 static void
 138 yy_stack_print (pTHX_ const short *yyss, const short *yyssp, const YYSTYPE *yyvs, const char**yyns)
 139 {
 140     int i;
 141     int start = 1;
 142     int count = (int)(yyssp - yyss);
 143
 144     if (count > 8) {
 145         start = count - 8 + 1;
 146         count = 8;
 147     }
 148
 149     PerlIO_printf(Perl_debug_log, "\nindex:");
 150     for (i=0; i < count; i++)
 151         PerlIO_printf(Perl_debug_log, " %8d", start+i);
 152     PerlIO_printf(Perl_debug_log, "\nstate:");
 153     for (i=0; i < count; i++)
 154         PerlIO_printf(Perl_debug_log, " %8d", yyss[start+i]);
 155     PerlIO_printf(Perl_debug_log, "\ntoken:");
 156     for (i=0; i < count; i++)
 157         PerlIO_printf(Perl_debug_log, " %8.8s", yyns[start+i]);
 158     PerlIO_printf(Perl_debug_log, "\nvalue:");
 159     for (i=0; i < count; i++) {
 160         switch (yy_type_tab[yystos[yyss[start+i]]]) {
 161         case toketype_opval:
 162             PerlIO_printf(Perl_debug_log, " %8.8s",
 163                   yyvs[start+i].opval
 164                     ? PL_op_name[yyvs[start+i].opval->op_type]
 165                     : "(Nullop)"
 166             );
 167             break;
 168 #ifndef PERL_IN_MADLY_C
 169         case toketype_p_tkval:
 170             PerlIO_printf(Perl_debug_log, " %8.8s",
 171                   yyvs[start+i].pval ? yyvs[start+i].pval : "(NULL)");
 172             break;
 173
 174         case toketype_i_tkval:
 175 #endif
 176         case toketype_ival:
 177             PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)yyvs[start+i].ival);
 178             break;
 179         default:
 180             PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)yyvs[start+i].ival);
 181         }
 182     }
 183     PerlIO_printf(Perl_debug_log, "\n\n");
 184 }
 185
 186 #  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)               \
 187 do {                                                            \
 188     if (yydebug && DEBUG_v_TEST)                                \
 189         yy_stack_print (aTHX_ (yyss), (yyssp), (yyvs), (yyns)); \
 190 } while (0)
 191
 192
 193 /*------------------------------------------------.
 194 | Report that the YYRULE is going to be reduced.  |
 195 `------------------------------------------------*/
 196
 197 static void
 198 yy_reduce_print (pTHX_ int yyrule)
 199 {
 200     int yyi;
 201     const unsigned int yylineno = yyrline[yyrule];
 202     YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
 203                           yyrule - 1, yylineno);
 204     /* Print the symbols being reduced, and their result.  */
 205     for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
 206         YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
 207     YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
 208 }
 209
 210 #  define YY_REDUCE_PRINT(Rule)         \
 211 do {                                    \
 212     if (yydebug)                        \
 213         yy_reduce_print (aTHX_ Rule);           \
 214 } while (0)
 215
 216 #else /* !DEBUGGING */
 217 #  define YYDPRINTF(Args)
 218 #  define YYDSYMPRINTF(Title, Token, Value)
 219 #  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)
 220 #  define YY_REDUCE_PRINT(Rule)
 221 #endif /* !DEBUGGING */
 222
 223
 224 /* YYINITDEPTH -- initial size of the parser's stacks.  */
 225 #ifndef YYINITDEPTH
 226 # define YYINITDEPTH 200
 227 #endif
 228
 229
 230 #if YYERROR_VERBOSE
 231 #  ifndef yystrlen
 232 #    if defined (__GLIBC__) && defined (_STRING_H)
 233 #      define yystrlen strlen
 234 #    else
 235 /* Return the length of YYSTR.  */
 236 static YYSIZE_T
 237 yystrlen (const char *yystr)
 238 {
 239     register const char *yys = yystr;
 240
 241     while (*yys++ != '\0')
 242         continue;
 243
 244     return yys - yystr - 1;
 245 }
 246 #    endif
 247 #  endif
 248
 249 #  ifndef yystpcpy
 250 #    if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE)
 251 #      define yystpcpy stpcpy
 252 #    else
 253 /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
 254    YYDEST.  */
 255 static char *
 256 yystpcpy (pTHX_ char *yydest, const char *yysrc)
 257 {
 258     register char *yyd = yydest;
 259     register const char *yys = yysrc;
 260
 261     while ((*yyd++ = *yys++) != '\0')
 262         continue;
 263
 264     return yyd - 1;
 265 }
 266 #    endif
 267 #  endif
 268
 269 #endif /* !YYERROR_VERBOSE */
 270
 271
 272 /* a snapshot of the current stack position variables for use by
 273  * S_clear_yystack */
 274
 275 typedef struct {
 276     short *yyss;
 277     short *yyssp;
 278     YYSTYPE *yyvsp;
 279     AV **yypsp;
 280     int yylen;
 281 } yystack_positions;
 282
 283 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
 284  * parse stack, thus avoiding leaks if we die  */
 285
 286 static void
 287 S_clear_yystack(pTHX_ const void *p)
 288 {
 289     yystack_positions *y = (yystack_positions*) p;
 290     int i;
 291
 292     if (!y->yyss)
 293         return;
 294     YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
 295
 296     /* Freeing ops on the stack, and the op_latefree/op_latefreed flags:
 297      *
 298      * When we pop tokens off the stack during error recovery, or when
 299      * we pop all the tokens off the stack after a die during a shift or
 300      * reduce (ie Perl_croak somewhere in yylex(), or in one of the
 301      * newFOO() functions, then its possible that some of these tokens are
 302      * of type opval, pointing to an OP. All these ops are orphans; each is
 303      * its own miniature subtree that has not yet been attached to a
 304      * larger tree. In this case, we shoould clearly free the op (making
 305      * sure, for each op we free thyat we have PL_comppad pointing to the
 306      * right place for freeing any SVs attached to the op in threaded
 307      * builds.
 308      *
 309      * However, there is a particular problem if we die in newFOO called
 310      * by a reducing action; e.g.
 311      *
 312      *    foo : bar baz boz
 313      *        { $$ = newFOO($1,$2,$3) }
 314      *
 315      * where
 316      *  OP *newFOO { .... croak .... }
 317      *
 318      * In this case, when we come to clean bar baz and boz off the stack,
 319      * we don't know whether newFOO() has already:
 320      *    * freed them
 321      *    * left them as it
 322      *    * attached them to part of a larger tree
 323      *
 324      * To get round this problem, we set the flag op_latefree on every op
 325      * that gets pushed onto the parser stack. If op_free() sees this
 326      * flag, it clears the op and frees any children,, but *doesn't* free
 327      * the op itself; instead it sets the op_latefreed flag. This means
 328      * that we can safely call op_free() multiple times on each stack op.
 329      * So, when clearing the stack, we first, for each op that was being
 330      * reduced, call op_free with op_latefree=1. This ensures that all ops
 331      * hanging off these op are freed, but the reducing ops themselces are
 332      * just undefed. Then we set op_latefreed=0 on *all* ops on the stack
 333      * and free them. A little though should convince you that this
 334      * two-part approach to the reducing ops should handle all three cases
 335      * above safely.
 336      */
 337
 338     /* free any reducing ops (1st pass) */
 339
 340     for (i=0; i< y->yylen; i++) {
 341         if (yy_type_tab[yystos[y->yyssp[-i]]] == toketype_opval
 342             && y->yyvsp[-i].opval) {
 343             if (y->yypsp[-i] != PL_comppad) {
 344                 PAD_RESTORE_LOCAL(y->yypsp[-i]);
 345             }
 346             op_free(y->yyvsp[-i].opval);
 347         }
 348     }
 349
 350     /* now free whole the stack, including the just-reduced ops */
 351
 352     while (y->yyssp > y->yyss) {
 353         if (yy_type_tab[yystos[*y->yyssp]] == toketype_opval
 354             && y->yyvsp->opval)
 355         {
 356             if (*y->yypsp != PL_comppad) {
 357                 PAD_RESTORE_LOCAL(*y->yypsp);
 358             }
 359             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 360             y->yyvsp->opval->op_latefree  = 0;
 361             op_free(y->yyvsp->opval);
 362         }
 363         y->yyvsp--;
 364         y->yyssp--;
 365         y->yypsp--;
 366     }
 367 }
 368
 369
 370
 371 /*----------.
 372 | yyparse.  |
 373 `----------*/
 374
 375 int
 376 #ifdef PERL_IN_MADLY_C
 377 Perl_madparse (pTHX)
 378 #else
 379 Perl_yyparse (pTHX)
 380 #endif
 381 {
 382     dVAR;
 383     int yychar; /* The lookahead symbol.  */
 384     YYSTYPE yylval; /* The semantic value of the lookahead symbol.  */
 385     int yynerrs; /* Number of syntax errors so far.  */
 386     register int yystate;
 387     register int yyn;
 388     int yyresult;
 389
 390     /* Number of tokens to shift before error messages enabled.  */
 391     int yyerrstatus;
 392     /* Lookahead token as an internal (translated) token number.  */
 393     int yytoken = 0;
 394
 395     /* three stacks and their tools:
 396           yyss: related to states,
 397           yyvs: related to semantic values,
 398           yyps: current value of PL_comppad for each state
 399
 400
 401           Refer to the stacks thru separate pointers, to allow yyoverflow
 402           to reallocate them elsewhere.  */
 403
 404     /* The state stack.  */
 405     short *yyss;
 406     register short *yyssp;
 407
 408     /* The semantic value stack.  */
 409     YYSTYPE *yyvs;
 410     register YYSTYPE *yyvsp;
 411
 412     AV **yyps;
 413     AV **yypsp;
 414
 415     /* for ease of re-allocation and automatic freeing, have three SVs whose
 416       * SvPVX points to the stacks */
 417     SV *yyss_sv, *yyvs_sv, *yyps_sv;
 418     SV *ss_save_sv;
 419     yystack_positions *ss_save;
 420
 421
 422 #ifdef DEBUGGING
 423     /* maintain also a stack of token/rule names for debugging with -Dpv */
 424     const char **yyns, **yynsp;
 425     SV *yyns_sv;
 426 #  define YYPOPSTACK   (yyvsp--, yyssp--, yypsp--, yynsp--)
 427 #else
 428 #  define YYPOPSTACK   (yyvsp--, yyssp--, yypsp--)
 429 #endif
 430
 431
 432     YYSIZE_T yystacksize = YYINITDEPTH;
 433
 434     /* The variables used to return semantic value and location from the
 435           action routines.  */
 436     YYSTYPE yyval;
 437
 438
 439     /* When reducing, the number of symbols on the RHS of the reduced
 440           rule.  */
 441     int yylen;
 442
 443 #ifndef PERL_IN_MADLY_C
 444 #  ifdef PERL_MAD
 445     if (PL_madskills)
 446         return madparse();
 447 #  endif
 448 #endif
 449
 450     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
 451
 452     ENTER;                      /* force stack free before we return */
 453     SAVEVPTR(PL_yycharp);
 454     SAVEVPTR(PL_yylvalp);
 455     PL_yycharp = &yychar; /* so PL_yyerror() can access it */
 456     PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
 457
 458     yyss_sv = newSV(YYINITDEPTH * sizeof(short));
 459     yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
 460     yyps_sv = newSV(YYINITDEPTH * sizeof(AV*));
 461     ss_save_sv = newSV(sizeof(yystack_positions));
 462     SAVEFREESV(yyss_sv);
 463     SAVEFREESV(yyvs_sv);
 464     SAVEFREESV(yyps_sv);
 465     SAVEFREESV(ss_save_sv);
 466     yyss = (short *) SvPVX(yyss_sv);
 467     yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 468     yyps = (AV **) SvPVX(yyps_sv);
 469     ss_save = (yystack_positions *) SvPVX(ss_save_sv);
 470
 471     ss_save->yyss = NULL; /* disarm stack cleanup */
 472     /* cleanup the parse stack on premature exit */
 473     SAVEDESTRUCTOR_X(S_clear_yystack, (void*) ss_save);
 474
 475     /* note that elements zero of yyvs and yyns are not used */
 476     yyssp = yyss;
 477     yyvsp = yyvs;
 478     yypsp = yyps;
 479 #ifdef DEBUGGING
 480     yyns_sv = newSV(YYINITDEPTH * sizeof(char *));
 481     SAVEFREESV(yyns_sv);
 482     /* XXX This seems strange to cast char * to char ** */
 483     yyns = (const char **) SvPVX(yyns_sv);
 484     yynsp = yyns;
 485 #endif
 486
 487     yystate = 0;
 488     yyerrstatus = 0;
 489     yynerrs = 0;
 490     yychar = YYEMPTY;           /* Cause a token to be read.  */
 491
 492     goto yysetstate;
 493
 494 /*------------------------------------------------------------.
 495 | yynewstate -- Push a new state, which is found in yystate.  |
 496 `------------------------------------------------------------*/
 497   yynewstate:
 498     /* In all cases, when you get here, the value and location stacks
 499           have just been pushed. so pushing a state here evens the stacks.
 500           */
 501     yyssp++;
 502
 503   yysetstate:
 504     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 505     *yyssp = yystate;
 506
 507     if (yy_type_tab[yystos[yystate]] == toketype_opval && yyvsp->opval) {
 508         yyvsp->opval->op_latefree  = 1;
 509         yyvsp->opval->op_latefreed = 0;
 510     }
 511
 512     ss_save->yyss = yyss;
 513     ss_save->yyssp = yyssp;
 514     ss_save->yyvsp = yyvsp;
 515     ss_save->yypsp = yypsp;
 516     ss_save->yylen = 0;
 517
 518     if (yyss + yystacksize - 1 <= yyssp) {
 519          /* Get the current used size of the three stacks, in elements.  */
 520          const YYSIZE_T yysize = yyssp - yyss + 1;
 521
 522          /* Extend the stack our own way.  */
 523          if (YYMAXDEPTH <= yystacksize)
 524                goto yyoverflowlab;
 525          yystacksize *= 2;
 526          if (YYMAXDEPTH < yystacksize)
 527                yystacksize = YYMAXDEPTH;
 528
 529          SvGROW(yyss_sv, yystacksize * sizeof(short));
 530          SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
 531          SvGROW(yyps_sv, yystacksize * sizeof(AV*));
 532          yyss = (short *) SvPVX(yyss_sv);
 533          yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 534          yyps = (AV **) SvPVX(yyps_sv);
 535 #ifdef DEBUGGING
 536          SvGROW(yyns_sv, yystacksize * sizeof(char *));
 537          /* XXX This seems strange to cast char * to char ** */
 538          yyns = (const char **) SvPVX(yyns_sv);
 539          if (! yyns)
 540                goto yyoverflowlab;
 541          yynsp = yyns + yysize - 1;
 542 #endif
 543          if (!yyss || ! yyvs || ! yyps)
 544                goto yyoverflowlab;
 545
 546          yyssp = yyss + yysize - 1;
 547          yyvsp = yyvs + yysize - 1;
 548          yypsp = yyps + yysize - 1;
 549
 550
 551          YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
 552                                    (unsigned long int) yystacksize));
 553
 554          if (yyss + yystacksize - 1 <= yyssp)
 555                YYABORT;
 556
 557         ss_save->yyss = yyss;
 558         ss_save->yyssp = yyssp;
 559         ss_save->yyvsp = yyvsp;
 560         ss_save->yypsp = yypsp;
 561         ss_save->yylen = 0;
 562     }
 563
 564     goto yybackup;
 565
 566   /*-----------.
 567   | yybackup.  |
 568   `-----------*/
 569   yybackup:
 570
 571 /* Do appropriate processing given the current state.  */
 572 /* Read a lookahead token if we need one and don't already have one.  */
 573 /* yyresume: */
 574
 575     /* First try to decide what to do without reference to lookahead token.  */
 576
 577     yyn = yypact[yystate];
 578     if (yyn == YYPACT_NINF)
 579         goto yydefault;
 580
 581     /* Not known => get a lookahead token if don't already have one.  */
 582
 583     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
 584     if (yychar == YYEMPTY) {
 585         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
 586 #ifdef PERL_IN_MADLY_C
 587         yychar = PL_madskills ? madlex() : yylex();
 588 #else
 589         yychar = yylex();
 590 #endif
 591
 592 #  ifdef EBCDIC
 593         if (yychar >= 0 && yychar < 255) {
 594             yychar = NATIVE_TO_ASCII(yychar);
 595         }
 596 #  endif
 597     }
 598
 599     if (yychar <= YYEOF) {
 600         yychar = yytoken = YYEOF;
 601         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
 602     }
 603     else {
 604         yytoken = YYTRANSLATE (yychar);
 605         YYDSYMPRINTF ("Next token is", yytoken, &yylval);
 606     }
 607
 608     /* If the proper action on seeing token YYTOKEN is to reduce or to
 609           detect an error, take that action.  */
 610     yyn += yytoken;
 611     if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
 612         goto yydefault;
 613     yyn = yytable[yyn];
 614     if (yyn <= 0) {
 615         if (yyn == 0 || yyn == YYTABLE_NINF)
 616             goto yyerrlab;
 617         yyn = -yyn;
 618         goto yyreduce;
 619     }
 620
 621     if (yyn == YYFINAL)
 622         YYACCEPT;
 623
 624     /* Shift the lookahead token.  */
 625     YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
 626
 627     /* Discard the token being shifted unless it is eof.  */
 628     if (yychar != YYEOF)
 629         yychar = YYEMPTY;
 630
 631     *++yyvsp = yylval;
 632     *++yypsp = PL_comppad;
 633 #ifdef DEBUGGING
 634     *++yynsp = (const char *)(yytname[yytoken]);
 635 #endif
 636
 637
 638     /* Count tokens shifted since error; after three, turn off error
 639           status.  */
 640     if (yyerrstatus)
 641         yyerrstatus--;
 642
 643     yystate = yyn;
 644
 645     goto yynewstate;
 646
 647
 648   /*-----------------------------------------------------------.
 649   | yydefault -- do the default action for the current state.  |
 650   `-----------------------------------------------------------*/
 651   yydefault:
 652     yyn = yydefact[yystate];
 653     if (yyn == 0)
 654         goto yyerrlab;
 655     goto yyreduce;
 656
 657
 658   /*-----------------------------.
 659   | yyreduce -- Do a reduction.  |
 660   `-----------------------------*/
 661   yyreduce:
 662     /* yyn is the number of a rule to reduce with.  */
 663     yylen = yyr2[yyn];
 664
 665     /* If YYLEN is nonzero, implement the default value of the action:
 666       "$$ = $1".
 667
 668       Otherwise, the following line sets YYVAL to garbage.
 669       This behavior is undocumented and Bison
 670       users should not rely upon it.  Assigning to YYVAL
 671       unconditionally makes the parser a bit smaller, and it avoids a
 672       GCC warning that YYVAL may be used uninitialized.  */
 673     yyval = yyvsp[1-yylen];
 674
 675     YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
 676     YY_REDUCE_PRINT (yyn);
 677
 678     /* running external code may trigger a die (eg 'use nosuchmodule'):
 679      * record the current stack state so that an unwind will
 680      * free all the pesky OPs lounging around on the parse stack */
 681     ss_save->yyss = yyss;
 682     ss_save->yyssp = yyssp;
 683     ss_save->yyvsp = yyvsp;
 684     ss_save->yypsp = yypsp;
 685     ss_save->yylen = yylen;
 686
 687     switch (yyn) {
 688
 689
 690 #define dep() deprecate("\"do\" to call subroutines")
 691
 692 #ifdef PERL_IN_MADLY_C
 693 #  define IVAL(i) (i)->tk_lval.ival
 694 #  define PVAL(p) (p)->tk_lval.pval
 695 #  define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
 696 #  define TOKEN_FREE(a) token_free(a)
 697 #  define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
 698 #  define IF_MAD(a,b) (a)
 699 #  define DO_MAD(a) a
 700 #  define MAD
 701 #else
 702 #  define IVAL(i) (i)
 703 #  define PVAL(p) (p)
 704 #  define TOKEN_GETMAD(a,b,c)
 705 #  define TOKEN_FREE(a)
 706 #  define OP_GETMAD(a,b,c)
 707 #  define IF_MAD(a,b) (b)
 708 #  define DO_MAD(a)
 709 #  undef MAD
 710 #endif
 711
 712 /* contains all the rule actions; auto-generated from perly.y */
 713 #include "perly.act"
 714
 715     }
 716
 717     /* any just-reduced ops with the op_latefreed flag cleared need to be
 718      * freed; the rest need the flag resetting */
 719     {
 720         int i;
 721         for (i=0; i< yylen; i++) {
 722             if (yy_type_tab[yystos[yyssp[-i]]] == toketype_opval
 723                 && yyvsp[-i].opval)
 724             {
 725                 yyvsp[-i].opval->op_latefree = 0;
 726                 if (yyvsp[-i].opval->op_latefreed)
 727                     op_free(yyvsp[-i].opval);
 728             }
 729         }
 730     }
 731
 732     yyvsp -= yylen;
 733     yyssp -= yylen;
 734     yypsp -= yylen;
 735 #ifdef DEBUGGING
 736     yynsp -= yylen;
 737 #endif
 738
 739     *++yyvsp = yyval;
 740     *++yypsp = PL_comppad;
 741 #ifdef DEBUGGING
 742     *++yynsp = (const char *)(yytname [yyr1[yyn]]);
 743 #endif
 744     /* Now shift the result of the reduction.  Determine what state
 745           that goes to, based on the state we popped back to and the rule
 746           number reduced by.  */
 747
 748     yyn = yyr1[yyn];
 749
 750     yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
 751     if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
 752         yystate = yytable[yystate];
 753     else
 754         yystate = yydefgoto[yyn - YYNTOKENS];
 755     goto yynewstate;
 756
 757
 758   /*------------------------------------.
 759   | yyerrlab -- here on detecting error |
 760   `------------------------------------*/
 761   yyerrlab:
 762     /* If not already recovering from an error, report this error.  */
 763     if (!yyerrstatus) {
 764         ++yynerrs;
 765 #if YYERROR_VERBOSE
 766         yyn = yypact[yystate];
 767
 768         if (YYPACT_NINF < yyn && yyn < YYLAST) {
 769             YYSIZE_T yysize = 0;
 770             const int yytype = YYTRANSLATE (yychar);
 771             char *yymsg;
 772             int yyx, yycount;
 773
 774             yycount = 0;
 775             /* Start YYX at -YYN if negative to avoid negative indexes in
 776                   YYCHECK.  */
 777             for (yyx = yyn < 0 ? -yyn : 0;
 778                       yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
 779                 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
 780                     yysize += yystrlen (yytname[yyx]) + 15, yycount++;
 781             yysize += yystrlen ("syntax error, unexpected ") + 1;
 782             yysize += yystrlen (yytname[yytype]);
 783             Newx(yymsg, yysize, char *);
 784             if (yymsg != 0) {
 785                 const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
 786                 yyp = yystpcpy (yyp, yytname[yytype]);
 787
 788                 if (yycount < 5) {
 789                     yycount = 0;
 790                     for (yyx = yyn < 0 ? -yyn : 0;
 791                               yyx < (int) (sizeof (yytname) / sizeof (char *));
 792                               yyx++)
 793                     {
 794                         if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
 795                             const char *yyq = ! yycount ?
 796                                                     ", expecting " : " or ";
 797                             yyp = yystpcpy (yyp, yyq);
 798                             yyp = yystpcpy (yyp, yytname[yyx]);
 799                             yycount++;
 800                         }
 801                     }
 802                 }
 803                 yyerror (yymsg);
 804                 YYSTACK_FREE (yymsg);
 805             }
 806             else
 807                 yyerror ("syntax error; also virtual memory exhausted");
 808         }
 809         else
 810 #endif /* YYERROR_VERBOSE */
 811             yyerror ("syntax error");
 812     }
 813
 814
 815     if (yyerrstatus == 3) {
 816         /* If just tried and failed to reuse lookahead token after an
 817               error, discard it.  */
 818
 819         /* Return failure if at end of input.  */
 820         if (yychar == YYEOF) {
 821             /* Pop the error token.  */
 822             YYPOPSTACK;
 823             /* Pop the rest of the stack.  */
 824             while (yyss < yyssp) {
 825                 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
 826                 if (yy_type_tab[yystos[*yyssp]] == toketype_opval
 827                         && yyvsp->opval)
 828                 {
 829                     YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 830                     if (*yypsp != PL_comppad) {
 831                         PAD_RESTORE_LOCAL(*yypsp);
 832                     }
 833                     yyvsp->opval->op_latefree  = 0;
 834                     op_free(yyvsp->opval);
 835                 }
 836                 YYPOPSTACK;
 837             }
 838             YYABORT;
 839         }
 840
 841         YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
 842         yychar = YYEMPTY;
 843
 844     }
 845
 846     /* Else will try to reuse lookahead token after shifting the error
 847           token.  */
 848     goto yyerrlab1;
 849
 850
 851   /*----------------------------------------------------.
 852   | yyerrlab1 -- error raised explicitly by an action.  |
 853   `----------------------------------------------------*/
 854   yyerrlab1:
 855     yyerrstatus = 3;    /* Each real token shifted decrements this.  */
 856
 857     for (;;) {
 858         yyn = yypact[yystate];
 859         if (yyn != YYPACT_NINF) {
 860             yyn += YYTERROR;
 861             if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
 862                 yyn = yytable[yyn];
 863                 if (0 < yyn)
 864                     break;
 865             }
 866         }
 867
 868         /* Pop the current state because it cannot handle the error token.  */
 869         if (yyssp == yyss)
 870             YYABORT;
 871
 872         YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
 873         if (yy_type_tab[yystos[*yyssp]] == toketype_opval && yyvsp->opval) {
 874             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 875             if (*yypsp != PL_comppad) {
 876                 PAD_RESTORE_LOCAL(*yypsp);
 877             }
 878             yyvsp->opval->op_latefree  = 0;
 879             op_free(yyvsp->opval);
 880         }
 881         yyvsp--;
 882         yypsp--;
 883 #ifdef DEBUGGING
 884         yynsp--;
 885 #endif
 886         yystate = *--yyssp;
 887
 888         YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
 889     }
 890
 891     if (yyn == YYFINAL)
 892         YYACCEPT;
 893
 894     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
 895
 896     *++yyvsp = yylval;
 897     *++yypsp = PL_comppad;
 898 #ifdef DEBUGGING
 899     *++yynsp ="<err>";
 900 #endif
 901
 902     yystate = yyn;
 903
 904     goto yynewstate;
 905
 906
 907   /*-------------------------------------.
 908   | yyacceptlab -- YYACCEPT comes here.  |
 909   `-------------------------------------*/
 910   yyacceptlab:
 911     yyresult = 0;
 912     goto yyreturn;
 913
 914   /*-----------------------------------.
 915   | yyabortlab -- YYABORT comes here.  |
 916   `-----------------------------------*/
 917   yyabortlab:
 918     yyresult = 1;
 919     goto yyreturn;
 920
 921   /*----------------------------------------------.
 922   | yyoverflowlab -- parser overflow comes here.  |
 923   `----------------------------------------------*/
 924   yyoverflowlab:
 925     yyerror ("parser stack overflow");
 926     yyresult = 2;
 927     /* Fall through.  */
 928
 929   yyreturn:
 930
 931     ss_save->yyss = NULL;       /* disarm parse stack cleanup */
 932     LEAVE;                      /* force stack free before we return */
 933
 934     return yyresult;
 935 }
 936
 937 /*
 938  * Local variables:
 939  * c-indentation-style: bsd
 940  * c-basic-offset: 4
 941  * indent-tabs-mode: t
 942  * End:
 943  *
 944  * ex: set ts=8 sts=4 sw=4 noet:
 945  */