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     *yyssp = 0;
 488     yyvsp->ival = 0;
 489     yyerrstatus = 0;
 490     yynerrs = 0;
 491     yychar = YYEMPTY;           /* Cause a token to be read.  */
 492
 493 /*------------------------------------------------------------.
 494 | yynewstate -- Push a new state, which is found in yystate.  |
 495 `------------------------------------------------------------*/
 496   yynewstate:
 497
 498     yystate = *yyssp;
 499
 500     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 501
 502     if (yy_type_tab[yystos[yystate]] == toketype_opval && yyvsp->opval) {
 503         yyvsp->opval->op_latefree  = 1;
 504         yyvsp->opval->op_latefreed = 0;
 505     }
 506
 507     ss_save->yyss = yyss;
 508     ss_save->yyssp = yyssp;
 509     ss_save->yyvsp = yyvsp;
 510     ss_save->yypsp = yypsp;
 511     ss_save->yylen = 0;
 512
 513     if (yyss + yystacksize - 1 <= yyssp) {
 514          /* Get the current used size of the three stacks, in elements.  */
 515          const YYSIZE_T yysize = yyssp - yyss + 1;
 516
 517          /* Extend the stack our own way.  */
 518          if (YYMAXDEPTH <= yystacksize)
 519                goto yyoverflowlab;
 520          yystacksize *= 2;
 521          if (YYMAXDEPTH < yystacksize)
 522                yystacksize = YYMAXDEPTH;
 523
 524          SvGROW(yyss_sv, yystacksize * sizeof(short));
 525          SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
 526          SvGROW(yyps_sv, yystacksize * sizeof(AV*));
 527          yyss = (short *) SvPVX(yyss_sv);
 528          yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 529          yyps = (AV **) SvPVX(yyps_sv);
 530 #ifdef DEBUGGING
 531          SvGROW(yyns_sv, yystacksize * sizeof(char *));
 532          /* XXX This seems strange to cast char * to char ** */
 533          yyns = (const char **) SvPVX(yyns_sv);
 534          if (! yyns)
 535                goto yyoverflowlab;
 536          yynsp = yyns + yysize - 1;
 537 #endif
 538          if (!yyss || ! yyvs || ! yyps)
 539                goto yyoverflowlab;
 540
 541          yyssp = yyss + yysize - 1;
 542          yyvsp = yyvs + yysize - 1;
 543          yypsp = yyps + yysize - 1;
 544
 545
 546          YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
 547                                    (unsigned long int) yystacksize));
 548
 549          if (yyss + yystacksize - 1 <= yyssp)
 550                YYABORT;
 551
 552         ss_save->yyss = yyss;
 553         ss_save->yyssp = yyssp;
 554         ss_save->yyvsp = yyvsp;
 555         ss_save->yypsp = yypsp;
 556         ss_save->yylen = 0;
 557     }
 558
 559     goto yybackup;
 560
 561   /*-----------.
 562   | yybackup.  |
 563   `-----------*/
 564   yybackup:
 565
 566 /* Do appropriate processing given the current state.  */
 567 /* Read a lookahead token if we need one and don't already have one.  */
 568 /* yyresume: */
 569
 570     /* First try to decide what to do without reference to lookahead token.  */
 571
 572     yyn = yypact[yystate];
 573     if (yyn == YYPACT_NINF)
 574         goto yydefault;
 575
 576     /* Not known => get a lookahead token if don't already have one.  */
 577
 578     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
 579     if (yychar == YYEMPTY) {
 580         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
 581 #ifdef PERL_IN_MADLY_C
 582         yychar = PL_madskills ? madlex() : yylex();
 583 #else
 584         yychar = yylex();
 585 #endif
 586
 587 #  ifdef EBCDIC
 588         if (yychar >= 0 && yychar < 255) {
 589             yychar = NATIVE_TO_ASCII(yychar);
 590         }
 591 #  endif
 592     }
 593
 594     if (yychar <= YYEOF) {
 595         yychar = yytoken = YYEOF;
 596         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
 597     }
 598     else {
 599         yytoken = YYTRANSLATE (yychar);
 600         YYDSYMPRINTF ("Next token is", yytoken, &yylval);
 601     }
 602
 603     /* If the proper action on seeing token YYTOKEN is to reduce or to
 604           detect an error, take that action.  */
 605     yyn += yytoken;
 606     if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
 607         goto yydefault;
 608     yyn = yytable[yyn];
 609     if (yyn <= 0) {
 610         if (yyn == 0 || yyn == YYTABLE_NINF)
 611             goto yyerrlab;
 612         yyn = -yyn;
 613         goto yyreduce;
 614     }
 615
 616     if (yyn == YYFINAL)
 617         YYACCEPT;
 618
 619     /* Shift the lookahead token.  */
 620     YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
 621
 622     /* Discard the token being shifted unless it is eof.  */
 623     if (yychar != YYEOF)
 624         yychar = YYEMPTY;
 625
 626     *++yyssp = yyn;
 627     *++yyvsp = yylval;
 628     *++yypsp = PL_comppad;
 629 #ifdef DEBUGGING
 630     *++yynsp = (const char *)(yytname[yytoken]);
 631 #endif
 632
 633
 634     /* Count tokens shifted since error; after three, turn off error
 635           status.  */
 636     if (yyerrstatus)
 637         yyerrstatus--;
 638
 639     goto yynewstate;
 640
 641
 642   /*-----------------------------------------------------------.
 643   | yydefault -- do the default action for the current state.  |
 644   `-----------------------------------------------------------*/
 645   yydefault:
 646     yyn = yydefact[yystate];
 647     if (yyn == 0)
 648         goto yyerrlab;
 649     goto yyreduce;
 650
 651
 652   /*-----------------------------.
 653   | yyreduce -- Do a reduction.  |
 654   `-----------------------------*/
 655   yyreduce:
 656     /* yyn is the number of a rule to reduce with.  */
 657     yylen = yyr2[yyn];
 658
 659     /* If YYLEN is nonzero, implement the default value of the action:
 660       "$$ = $1".
 661
 662       Otherwise, the following line sets YYVAL to garbage.
 663       This behavior is undocumented and Bison
 664       users should not rely upon it.  Assigning to YYVAL
 665       unconditionally makes the parser a bit smaller, and it avoids a
 666       GCC warning that YYVAL may be used uninitialized.  */
 667     yyval = yyvsp[1-yylen];
 668
 669     YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
 670     YY_REDUCE_PRINT (yyn);
 671
 672     /* running external code may trigger a die (eg 'use nosuchmodule'):
 673      * record the current stack state so that an unwind will
 674      * free all the pesky OPs lounging around on the parse stack */
 675     ss_save->yyss = yyss;
 676     ss_save->yyssp = yyssp;
 677     ss_save->yyvsp = yyvsp;
 678     ss_save->yypsp = yypsp;
 679     ss_save->yylen = yylen;
 680
 681     switch (yyn) {
 682
 683
 684 #define dep() deprecate("\"do\" to call subroutines")
 685
 686 #ifdef PERL_IN_MADLY_C
 687 #  define IVAL(i) (i)->tk_lval.ival
 688 #  define PVAL(p) (p)->tk_lval.pval
 689 #  define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
 690 #  define TOKEN_FREE(a) token_free(a)
 691 #  define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
 692 #  define IF_MAD(a,b) (a)
 693 #  define DO_MAD(a) a
 694 #  define MAD
 695 #else
 696 #  define IVAL(i) (i)
 697 #  define PVAL(p) (p)
 698 #  define TOKEN_GETMAD(a,b,c)
 699 #  define TOKEN_FREE(a)
 700 #  define OP_GETMAD(a,b,c)
 701 #  define IF_MAD(a,b) (b)
 702 #  define DO_MAD(a)
 703 #  undef MAD
 704 #endif
 705
 706 /* contains all the rule actions; auto-generated from perly.y */
 707 #include "perly.act"
 708
 709     }
 710
 711     /* any just-reduced ops with the op_latefreed flag cleared need to be
 712      * freed; the rest need the flag resetting */
 713     {
 714         int i;
 715         for (i=0; i< yylen; i++) {
 716             if (yy_type_tab[yystos[yyssp[-i]]] == toketype_opval
 717                 && yyvsp[-i].opval)
 718             {
 719                 yyvsp[-i].opval->op_latefree = 0;
 720                 if (yyvsp[-i].opval->op_latefreed)
 721                     op_free(yyvsp[-i].opval);
 722             }
 723         }
 724     }
 725
 726     yyvsp -= yylen;
 727     yyssp -= yylen;
 728     yypsp -= yylen;
 729 #ifdef DEBUGGING
 730     yynsp -= yylen;
 731 #endif
 732
 733     /* Now shift the result of the reduction.  Determine what state
 734           that goes to, based on the state we popped back to and the rule
 735           number reduced by.  */
 736
 737     *++yyvsp = yyval;
 738     *++yypsp = PL_comppad;
 739 #ifdef DEBUGGING
 740     *++yynsp = (const char *)(yytname [yyr1[yyn]]);
 741 #endif
 742
 743     yyn = yyr1[yyn];
 744
 745     yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
 746     if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
 747         yystate = yytable[yystate];
 748     else
 749         yystate = yydefgoto[yyn - YYNTOKENS];
 750     *++yyssp = yystate;
 751
 752     goto yynewstate;
 753
 754
 755   /*------------------------------------.
 756   | yyerrlab -- here on detecting error |
 757   `------------------------------------*/
 758   yyerrlab:
 759     /* If not already recovering from an error, report this error.  */
 760     if (!yyerrstatus) {
 761         ++yynerrs;
 762 #if YYERROR_VERBOSE
 763         yyn = yypact[yystate];
 764
 765         if (YYPACT_NINF < yyn && yyn < YYLAST) {
 766             YYSIZE_T yysize = 0;
 767             const int yytype = YYTRANSLATE (yychar);
 768             char *yymsg;
 769             int yyx, yycount;
 770
 771             yycount = 0;
 772             /* Start YYX at -YYN if negative to avoid negative indexes in
 773                   YYCHECK.  */
 774             for (yyx = yyn < 0 ? -yyn : 0;
 775                       yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
 776                 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
 777                     yysize += yystrlen (yytname[yyx]) + 15, yycount++;
 778             yysize += yystrlen ("syntax error, unexpected ") + 1;
 779             yysize += yystrlen (yytname[yytype]);
 780             Newx(yymsg, yysize, char *);
 781             if (yymsg != 0) {
 782                 const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
 783                 yyp = yystpcpy (yyp, yytname[yytype]);
 784
 785                 if (yycount < 5) {
 786                     yycount = 0;
 787                     for (yyx = yyn < 0 ? -yyn : 0;
 788                               yyx < (int) (sizeof (yytname) / sizeof (char *));
 789                               yyx++)
 790                     {
 791                         if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
 792                             const char *yyq = ! yycount ?
 793                                                     ", expecting " : " or ";
 794                             yyp = yystpcpy (yyp, yyq);
 795                             yyp = yystpcpy (yyp, yytname[yyx]);
 796                             yycount++;
 797                         }
 798                     }
 799                 }
 800                 yyerror (yymsg);
 801                 YYSTACK_FREE (yymsg);
 802             }
 803             else
 804                 yyerror ("syntax error; also virtual memory exhausted");
 805         }
 806         else
 807 #endif /* YYERROR_VERBOSE */
 808             yyerror ("syntax error");
 809     }
 810
 811
 812     if (yyerrstatus == 3) {
 813         /* If just tried and failed to reuse lookahead token after an
 814               error, discard it.  */
 815
 816         /* Return failure if at end of input.  */
 817         if (yychar == YYEOF) {
 818             /* Pop the error token.  */
 819             YYPOPSTACK;
 820             /* Pop the rest of the stack.  */
 821             while (yyss < yyssp) {
 822                 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
 823                 if (yy_type_tab[yystos[*yyssp]] == toketype_opval
 824                         && yyvsp->opval)
 825                 {
 826                     YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 827                     if (*yypsp != PL_comppad) {
 828                         PAD_RESTORE_LOCAL(*yypsp);
 829                     }
 830                     yyvsp->opval->op_latefree  = 0;
 831                     op_free(yyvsp->opval);
 832                 }
 833                 YYPOPSTACK;
 834             }
 835             YYABORT;
 836         }
 837
 838         YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
 839         yychar = YYEMPTY;
 840
 841     }
 842
 843     /* Else will try to reuse lookahead token after shifting the error
 844           token.  */
 845     goto yyerrlab1;
 846
 847
 848   /*----------------------------------------------------.
 849   | yyerrlab1 -- error raised explicitly by an action.  |
 850   `----------------------------------------------------*/
 851   yyerrlab1:
 852     yyerrstatus = 3;    /* Each real token shifted decrements this.  */
 853
 854     for (;;) {
 855         yyn = yypact[yystate];
 856         if (yyn != YYPACT_NINF) {
 857             yyn += YYTERROR;
 858             if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
 859                 yyn = yytable[yyn];
 860                 if (0 < yyn)
 861                     break;
 862             }
 863         }
 864
 865         /* Pop the current state because it cannot handle the error token.  */
 866         if (yyssp == yyss)
 867             YYABORT;
 868
 869         YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
 870         if (yy_type_tab[yystos[*yyssp]] == toketype_opval && yyvsp->opval) {
 871             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 872             if (*yypsp != PL_comppad) {
 873                 PAD_RESTORE_LOCAL(*yypsp);
 874             }
 875             yyvsp->opval->op_latefree  = 0;
 876             op_free(yyvsp->opval);
 877         }
 878         yyvsp--;
 879         yypsp--;
 880 #ifdef DEBUGGING
 881         yynsp--;
 882 #endif
 883         yystate = *--yyssp;
 884
 885         YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
 886     }
 887
 888     if (yyn == YYFINAL)
 889         YYACCEPT;
 890
 891     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
 892
 893     *++yyssp = yyn;
 894     *++yyvsp = yylval;
 895     *++yypsp = PL_comppad;
 896 #ifdef DEBUGGING
 897     *++yynsp ="<err>";
 898 #endif
 899
 900     goto yynewstate;
 901
 902
 903   /*-------------------------------------.
 904   | yyacceptlab -- YYACCEPT comes here.  |
 905   `-------------------------------------*/
 906   yyacceptlab:
 907     yyresult = 0;
 908     goto yyreturn;
 909
 910   /*-----------------------------------.
 911   | yyabortlab -- YYABORT comes here.  |
 912   `-----------------------------------*/
 913   yyabortlab:
 914     yyresult = 1;
 915     goto yyreturn;
 916
 917   /*----------------------------------------------.
 918   | yyoverflowlab -- parser overflow comes here.  |
 919   `----------------------------------------------*/
 920   yyoverflowlab:
 921     yyerror ("parser stack overflow");
 922     yyresult = 2;
 923     /* Fall through.  */
 924
 925   yyreturn:
 926
 927     ss_save->yyss = NULL;       /* disarm parse stack cleanup */
 928     LEAVE;                      /* force stack free before we return */
 929
 930     return yyresult;
 931 }
 932
 933 /*
 934  * Local variables:
 935  * c-indentation-style: bsd
 936  * c-basic-offset: 4
 937  * indent-tabs-mode: t
 938  * End:
 939  *
 940  * ex: set ts=8 sts=4 sw=4 noet:
 941  */