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                     : "(NULL)"
 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, 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
 291     if (!y->yyss)
 292         return;
 293     YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
 294     y->yyvsp -= y->yylen; /* ignore the tokens that have just been reduced */
 295     y->yyssp -= y->yylen;
 296     y->yypsp -= y->yylen;
 297     while (y->yyssp > y->yyss) {
 298         if (yy_type_tab[yystos[*y->yyssp]] == toketype_opval) {
 299             if (*y->yypsp != PL_comppad) {
 300                 PAD_RESTORE_LOCAL(*y->yypsp);
 301             }
 302             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 303             op_free(y->yyvsp->opval);
 304         }
 305         y->yyvsp--;
 306         y->yyssp--;
 307         y->yypsp--;
 308     }
 309 }
 310
 311
 312
 313 /*----------.
 314 | yyparse.  |
 315 `----------*/
 316
 317 int
 318 #ifdef PERL_IN_MADLY_C
 319 Perl_madparse (pTHX)
 320 #else
 321 Perl_yyparse (pTHX)
 322 #endif
 323 {
 324     dVAR;
 325     int yychar; /* The lookahead symbol.  */
 326     YYSTYPE yylval; /* The semantic value of the lookahead symbol.  */
 327     int yynerrs; /* Number of syntax errors so far.  */
 328     register int yystate;
 329     register int yyn;
 330     int yyresult;
 331
 332     /* Number of tokens to shift before error messages enabled.  */
 333     int yyerrstatus;
 334     /* Lookahead token as an internal (translated) token number.  */
 335     int yytoken = 0;
 336
 337     /* three stacks and their tools:
 338           yyss: related to states,
 339           yyvs: related to semantic values,
 340           yyps: current value of PL_comppad for each state
 341
 342
 343           Refer to the stacks thru separate pointers, to allow yyoverflow
 344           to reallocate them elsewhere.  */
 345
 346     /* The state stack.  */
 347     short *yyss;
 348     register short *yyssp;
 349
 350     /* The semantic value stack.  */
 351     YYSTYPE *yyvs;
 352     register YYSTYPE *yyvsp;
 353
 354     AV **yyps;
 355     AV **yypsp;
 356
 357     /* for ease of re-allocation and automatic freeing, have three SVs whose
 358       * SvPVX points to the stacks */
 359     SV *yyss_sv, *yyvs_sv, *yyps_sv;
 360     SV *ss_save_sv;
 361     yystack_positions *ss_save;
 362
 363
 364 #ifdef DEBUGGING
 365     /* maintain also a stack of token/rule names for debugging with -Dpv */
 366     const char **yyns, **yynsp;
 367     SV *yyns_sv;
 368 #  define YYPOPSTACK   (yyvsp--, yyssp--, yypsp--, yynsp--)
 369 #else
 370 #  define YYPOPSTACK   (yyvsp--, yyssp--, yypsp--)
 371 #endif
 372
 373
 374     YYSIZE_T yystacksize = YYINITDEPTH;
 375
 376     /* The variables used to return semantic value and location from the
 377           action routines.  */
 378     YYSTYPE yyval;
 379
 380
 381     /* When reducing, the number of symbols on the RHS of the reduced
 382           rule.  */
 383     int yylen;
 384
 385 #ifndef PERL_IN_MADLY_C
 386 #  ifdef PERL_MAD
 387     if (PL_madskills)
 388         return madparse();
 389 #  endif
 390 #endif
 391
 392     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
 393
 394     ENTER;                      /* force stack free before we return */
 395     SAVEVPTR(PL_yycharp);
 396     SAVEVPTR(PL_yylvalp);
 397     PL_yycharp = &yychar; /* so PL_yyerror() can access it */
 398     PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
 399
 400     yyss_sv = newSV(YYINITDEPTH * sizeof(short));
 401     yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
 402     yyps_sv = newSV(YYINITDEPTH * sizeof(AV*));
 403     ss_save_sv = newSV(sizeof(yystack_positions));
 404     SAVEFREESV(yyss_sv);
 405     SAVEFREESV(yyvs_sv);
 406     SAVEFREESV(yyps_sv);
 407     SAVEFREESV(ss_save_sv);
 408     yyss = (short *) SvPVX(yyss_sv);
 409     yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 410     yyps = (AV **) SvPVX(yyps_sv);
 411     ss_save = (yystack_positions *) SvPVX(ss_save_sv);
 412
 413     ss_save->yyss = NULL; /* disarm stack cleanup */
 414     /* cleanup the parse stack on premature exit */
 415     SAVEDESTRUCTOR_X(S_clear_yystack, (void*) ss_save);
 416
 417     /* note that elements zero of yyvs and yyns are not used */
 418     yyssp = yyss;
 419     yyvsp = yyvs;
 420     yypsp = yyps;
 421 #ifdef DEBUGGING
 422     yyns_sv = newSV(YYINITDEPTH * sizeof(char *));
 423     SAVEFREESV(yyns_sv);
 424     /* XXX This seems strange to cast char * to char ** */
 425     yyns = (const char **) SvPVX(yyns_sv);
 426     yynsp = yyns;
 427 #endif
 428
 429     yystate = 0;
 430     yyerrstatus = 0;
 431     yynerrs = 0;
 432     yychar = YYEMPTY;           /* Cause a token to be read.  */
 433
 434     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 435
 436     goto yysetstate;
 437
 438 /*------------------------------------------------------------.
 439 | yynewstate -- Push a new state, which is found in yystate.  |
 440 `------------------------------------------------------------*/
 441   yynewstate:
 442     /* In all cases, when you get here, the value and location stacks
 443           have just been pushed. so pushing a state here evens the stacks.
 444           */
 445     yyssp++;
 446
 447   yysetstate:
 448     *yyssp = yystate;
 449
 450     if (yyss + yystacksize - 1 <= yyssp) {
 451          /* Get the current used size of the three stacks, in elements.  */
 452          const YYSIZE_T yysize = yyssp - yyss + 1;
 453
 454          /* Extend the stack our own way.  */
 455          if (YYMAXDEPTH <= yystacksize)
 456                goto yyoverflowlab;
 457          yystacksize *= 2;
 458          if (YYMAXDEPTH < yystacksize)
 459                yystacksize = YYMAXDEPTH;
 460
 461          SvGROW(yyss_sv, yystacksize * sizeof(short));
 462          SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
 463          SvGROW(yyps_sv, yystacksize * sizeof(AV*));
 464          yyss = (short *) SvPVX(yyss_sv);
 465          yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 466          yyps = (AV **) SvPVX(yyps_sv);
 467 #ifdef DEBUGGING
 468          SvGROW(yyns_sv, yystacksize * sizeof(char *));
 469          /* XXX This seems strange to cast char * to char ** */
 470          yyns = (const char **) SvPVX(yyns_sv);
 471          if (! yyns)
 472                goto yyoverflowlab;
 473          yynsp = yyns + yysize - 1;
 474 #endif
 475          if (!yyss || ! yyvs || ! yyps)
 476                goto yyoverflowlab;
 477
 478          yyssp = yyss + yysize - 1;
 479          yyvsp = yyvs + yysize - 1;
 480          yypsp = yyps + yysize - 1;
 481
 482
 483          YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
 484                                    (unsigned long int) yystacksize));
 485
 486          if (yyss + yystacksize - 1 <= yyssp)
 487                YYABORT;
 488     }
 489
 490     goto yybackup;
 491
 492   /*-----------.
 493   | yybackup.  |
 494   `-----------*/
 495   yybackup:
 496
 497 /* Do appropriate processing given the current state.  */
 498 /* Read a lookahead token if we need one and don't already have one.  */
 499 /* yyresume: */
 500
 501     /* First try to decide what to do without reference to lookahead token.  */
 502
 503     yyn = yypact[yystate];
 504     if (yyn == YYPACT_NINF)
 505         goto yydefault;
 506
 507     /* Not known => get a lookahead token if don't already have one.  */
 508
 509     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
 510     if (yychar == YYEMPTY) {
 511         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
 512 #ifdef PERL_IN_MADLY_C
 513         yychar = PL_madskills ? madlex() : yylex();
 514 #else
 515         yychar = yylex();
 516 #endif
 517
 518 #  ifdef EBCDIC
 519         if (yychar >= 0 && yychar < 255) {
 520             yychar = NATIVE_TO_ASCII(yychar);
 521         }
 522 #  endif
 523     }
 524
 525     if (yychar <= YYEOF) {
 526         yychar = yytoken = YYEOF;
 527         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
 528     }
 529     else {
 530         yytoken = YYTRANSLATE (yychar);
 531         YYDSYMPRINTF ("Next token is", yytoken, &yylval);
 532     }
 533
 534     /* If the proper action on seeing token YYTOKEN is to reduce or to
 535           detect an error, take that action.  */
 536     yyn += yytoken;
 537     if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
 538         goto yydefault;
 539     yyn = yytable[yyn];
 540     if (yyn <= 0) {
 541         if (yyn == 0 || yyn == YYTABLE_NINF)
 542             goto yyerrlab;
 543         yyn = -yyn;
 544         goto yyreduce;
 545     }
 546
 547     if (yyn == YYFINAL)
 548         YYACCEPT;
 549
 550     /* Shift the lookahead token.  */
 551     YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
 552
 553     /* Discard the token being shifted unless it is eof.  */
 554     if (yychar != YYEOF)
 555         yychar = YYEMPTY;
 556
 557     *++yyvsp = yylval;
 558     *++yypsp = PL_comppad;
 559 #ifdef DEBUGGING
 560     *++yynsp = (const char *)(yytname[yytoken]);
 561 #endif
 562
 563
 564     /* Count tokens shifted since error; after three, turn off error
 565           status.  */
 566     if (yyerrstatus)
 567         yyerrstatus--;
 568
 569     yystate = yyn;
 570     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 571
 572     goto yynewstate;
 573
 574
 575   /*-----------------------------------------------------------.
 576   | yydefault -- do the default action for the current state.  |
 577   `-----------------------------------------------------------*/
 578   yydefault:
 579     yyn = yydefact[yystate];
 580     if (yyn == 0)
 581         goto yyerrlab;
 582     goto yyreduce;
 583
 584
 585   /*-----------------------------.
 586   | yyreduce -- Do a reduction.  |
 587   `-----------------------------*/
 588   yyreduce:
 589     /* yyn is the number of a rule to reduce with.  */
 590     yylen = yyr2[yyn];
 591
 592     /* If YYLEN is nonzero, implement the default value of the action:
 593       "$$ = $1".
 594
 595       Otherwise, the following line sets YYVAL to garbage.
 596       This behavior is undocumented and Bison
 597       users should not rely upon it.  Assigning to YYVAL
 598       unconditionally makes the parser a bit smaller, and it avoids a
 599       GCC warning that YYVAL may be used uninitialized.  */
 600     yyval = yyvsp[1-yylen];
 601
 602
 603     YY_REDUCE_PRINT (yyn);
 604
 605     /* running external code may trigger a die (eg 'use nosuchmodule'):
 606      * record the current stack state so that an unwind will
 607      * free all the pesky OPs lounging around on the parse stack */
 608     ss_save->yyss = yyss;
 609     ss_save->yyssp = yyssp;
 610     ss_save->yyvsp = yyvsp;
 611     ss_save->yypsp = yypsp;
 612     ss_save->yylen = yylen;
 613
 614     switch (yyn) {
 615
 616
 617 #define dep() deprecate("\"do\" to call subroutines")
 618
 619 #ifdef PERL_IN_MADLY_C
 620 #  define IVAL(i) (i)->tk_lval.ival
 621 #  define PVAL(p) (p)->tk_lval.pval
 622 #  define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
 623 #  define TOKEN_FREE(a) token_free(a)
 624 #  define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
 625 #  define IF_MAD(a,b) (a)
 626 #  define DO_MAD(a) a
 627 #  define MAD
 628 #else
 629 #  define IVAL(i) (i)
 630 #  define PVAL(p) (p)
 631 #  define TOKEN_GETMAD(a,b,c)
 632 #  define TOKEN_FREE(a)
 633 #  define OP_GETMAD(a,b,c)
 634 #  define IF_MAD(a,b) (b)
 635 #  define DO_MAD(a)
 636 #  undef MAD
 637 #endif
 638
 639 /* contains all the rule actions; auto-generated from perly.y */
 640 #include "perly.act"
 641
 642     }
 643
 644     yyvsp -= yylen;
 645     yyssp -= yylen;
 646     yypsp -= yylen;
 647 #ifdef DEBUGGING
 648     yynsp -= yylen;
 649 #endif
 650
 651
 652     *++yyvsp = yyval;
 653     *++yypsp = PL_comppad;
 654
 655 #ifdef DEBUGGING
 656     *++yynsp = (const char *)(yytname [yyr1[yyn]]);
 657 #endif
 658
 659     /* Now shift the result of the reduction.  Determine what state
 660           that goes to, based on the state we popped back to and the rule
 661           number reduced by.  */
 662
 663     yyn = yyr1[yyn];
 664
 665     yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
 666     if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
 667         yystate = yytable[yystate];
 668     else
 669         yystate = yydefgoto[yyn - YYNTOKENS];
 670
 671     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 672
 673 #ifdef DEBUGGING
 674     /* tmp push yystate for stack print; this is normally pushed later in
 675      * yynewstate */
 676     yyssp++;
 677     *yyssp = yystate;
 678     YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
 679     yyssp--;
 680 #endif
 681
 682     goto yynewstate;
 683
 684
 685   /*------------------------------------.
 686   | yyerrlab -- here on detecting error |
 687   `------------------------------------*/
 688   yyerrlab:
 689     /* If not already recovering from an error, report this error.  */
 690     if (!yyerrstatus) {
 691         ++yynerrs;
 692 #if YYERROR_VERBOSE
 693         yyn = yypact[yystate];
 694
 695         if (YYPACT_NINF < yyn && yyn < YYLAST) {
 696             YYSIZE_T yysize = 0;
 697             const int yytype = YYTRANSLATE (yychar);
 698             char *yymsg;
 699             int yyx, yycount;
 700
 701             yycount = 0;
 702             /* Start YYX at -YYN if negative to avoid negative indexes in
 703                   YYCHECK.  */
 704             for (yyx = yyn < 0 ? -yyn : 0;
 705                       yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
 706                 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
 707                     yysize += yystrlen (yytname[yyx]) + 15, yycount++;
 708             yysize += yystrlen ("syntax error, unexpected ") + 1;
 709             yysize += yystrlen (yytname[yytype]);
 710             Newx(yymsg, yysize, char *);
 711             if (yymsg != 0) {
 712                 const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
 713                 yyp = yystpcpy (yyp, yytname[yytype]);
 714
 715                 if (yycount < 5) {
 716                     yycount = 0;
 717                     for (yyx = yyn < 0 ? -yyn : 0;
 718                               yyx < (int) (sizeof (yytname) / sizeof (char *));
 719                               yyx++)
 720                     {
 721                         if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
 722                             const char *yyq = ! yycount ?
 723                                                     ", expecting " : " or ";
 724                             yyp = yystpcpy (yyp, yyq);
 725                             yyp = yystpcpy (yyp, yytname[yyx]);
 726                             yycount++;
 727                         }
 728                     }
 729                 }
 730                 yyerror (yymsg);
 731                 YYSTACK_FREE (yymsg);
 732             }
 733             else
 734                 yyerror ("syntax error; also virtual memory exhausted");
 735         }
 736         else
 737 #endif /* YYERROR_VERBOSE */
 738             yyerror ("syntax error");
 739     }
 740
 741
 742     if (yyerrstatus == 3) {
 743         /* If just tried and failed to reuse lookahead token after an
 744               error, discard it.  */
 745
 746         /* Return failure if at end of input.  */
 747         if (yychar == YYEOF) {
 748             /* Pop the error token.  */
 749             YYPOPSTACK;
 750             /* Pop the rest of the stack.  */
 751             while (yyss < yyssp) {
 752                 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
 753                 if (yy_type_tab[yystos[*yyssp]] == toketype_opval) {
 754                     YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 755                     if (*yypsp != PL_comppad) {
 756                         PAD_RESTORE_LOCAL(*yypsp);
 757                     }
 758                     op_free(yyvsp->opval);
 759                 }
 760                 YYPOPSTACK;
 761             }
 762             YYABORT;
 763         }
 764
 765         YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
 766         yychar = YYEMPTY;
 767
 768     }
 769
 770     /* Else will try to reuse lookahead token after shifting the error
 771           token.  */
 772     goto yyerrlab1;
 773
 774
 775   /*----------------------------------------------------.
 776   | yyerrlab1 -- error raised explicitly by an action.  |
 777   `----------------------------------------------------*/
 778   yyerrlab1:
 779     yyerrstatus = 3;    /* Each real token shifted decrements this.  */
 780
 781     for (;;) {
 782         yyn = yypact[yystate];
 783         if (yyn != YYPACT_NINF) {
 784             yyn += YYTERROR;
 785             if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
 786                 yyn = yytable[yyn];
 787                 if (0 < yyn)
 788                     break;
 789             }
 790         }
 791
 792         /* Pop the current state because it cannot handle the error token.  */
 793         if (yyssp == yyss)
 794             YYABORT;
 795
 796         YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
 797         if (yy_type_tab[yystos[*yyssp]] == toketype_opval) {
 798             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 799             if (*yypsp != PL_comppad) {
 800                 PAD_RESTORE_LOCAL(*yypsp);
 801             }
 802             op_free(yyvsp->opval);
 803         }
 804         yyvsp--;
 805         yypsp--;
 806 #ifdef DEBUGGING
 807         yynsp--;
 808 #endif
 809         yystate = *--yyssp;
 810
 811         YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
 812     }
 813
 814     if (yyn == YYFINAL)
 815         YYACCEPT;
 816
 817     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
 818
 819     *++yyvsp = yylval;
 820     *++yypsp = PL_comppad;
 821 #ifdef DEBUGGING
 822     *++yynsp ="<err>";
 823 #endif
 824
 825     yystate = yyn;
 826     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 827
 828     goto yynewstate;
 829
 830
 831   /*-------------------------------------.
 832   | yyacceptlab -- YYACCEPT comes here.  |
 833   `-------------------------------------*/
 834   yyacceptlab:
 835     yyresult = 0;
 836     goto yyreturn;
 837
 838   /*-----------------------------------.
 839   | yyabortlab -- YYABORT comes here.  |
 840   `-----------------------------------*/
 841   yyabortlab:
 842     yyresult = 1;
 843     goto yyreturn;
 844
 845   /*----------------------------------------------.
 846   | yyoverflowlab -- parser overflow comes here.  |
 847   `----------------------------------------------*/
 848   yyoverflowlab:
 849     yyerror ("parser stack overflow");
 850     yyresult = 2;
 851     /* Fall through.  */
 852
 853   yyreturn:
 854
 855     ss_save->yyss = NULL;       /* disarm parse stack cleanup */
 856     LEAVE;                      /* force stack free before we return */
 857
 858     return yyresult;
 859 }
 860
 861 /*
 862  * Local variables:
 863  * c-indentation-style: bsd
 864  * c-basic-offset: 4
 865  * indent-tabs-mode: t
 866  * End:
 867  *
 868  * ex: set ts=8 sts=4 sw=4 noet:
 869  */