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 #include "EXTERN.h"
  28 #define PERL_IN_PERLY_C
  29 #include "perl.h"
  30
  31 typedef unsigned char yytype_uint8;
  32 typedef signed char yytype_int8;
  33 typedef unsigned short int yytype_uint16;
  34 typedef short int yytype_int16;
  35 typedef signed char yysigned_char;
  36
  37 #ifdef DEBUGGING
  38 #  define YYDEBUG 1
  39 #else
  40 #  define YYDEBUG 0
  41 #endif
  42
  43 /* contains all the parser state tables; auto-generated from perly.y */
  44 #include "perly.tab"
  45
  46 # define YYSIZE_T size_t
  47
  48 #define YYEMPTY         (-2)
  49 #define YYEOF           0
  50 #define YYTERROR        1
  51
  52 #define YYACCEPT        goto yyacceptlab
  53 #define YYABORT         goto yyabortlab
  54 #define YYERROR         goto yyerrlab1
  55
  56 /* Enable debugging if requested.  */
  57 #ifdef DEBUGGING
  58
  59 #  define yydebug (DEBUG_p_TEST)
  60
  61 #  define YYFPRINTF PerlIO_printf
  62
  63 #  define YYDPRINTF(Args)                       \
  64 do {                                            \
  65     if (yydebug)                                \
  66         YYFPRINTF Args;                         \
  67 } while (0)
  68
  69 #  define YYDSYMPRINTF(Title, Token, Value)                     \
  70 do {                                                            \
  71     if (yydebug) {                                              \
  72         YYFPRINTF (Perl_debug_log, "%s ", Title);               \
  73         yysymprint (aTHX_ Perl_debug_log,  Token, Value);       \
  74         YYFPRINTF (Perl_debug_log, "\n");                       \
  75     }                                                           \
  76 } while (0)
  77
  78 /*--------------------------------.
  79 | Print this symbol on YYOUTPUT.  |
  80 `--------------------------------*/
  81
  82 static void
  83 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
  84 {
  85     if (yytype < YYNTOKENS) {
  86         YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
  87 #   ifdef YYPRINT
  88         YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
  89 #   else
  90         YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
  91 #   endif
  92     }
  93     else
  94         YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
  95
  96     YYFPRINTF (yyoutput, ")");
  97 }
  98
  99
 100 /*  yy_stack_print()
 101  *  print the top 8 items on the parse stack.
 102  */
 103
 104 static void
 105 yy_stack_print (pTHX_ const yy_parser *parser)
 106 {
 107     const yy_stack_frame *ps, *min;
 108
 109     min = parser->ps - 8 + 1;
 110     if (min <= &parser->stack[0])
 111         min = &parser->stack[0] + 1;
 112
 113     PerlIO_printf(Perl_debug_log, "\nindex:");
 114     for (ps = min; ps <= parser->ps; ps++)
 115         PerlIO_printf(Perl_debug_log, " %8d", ps - &parser->stack[0]);
 116
 117     PerlIO_printf(Perl_debug_log, "\nstate:");
 118     for (ps = min; ps <= parser->ps; ps++)
 119         PerlIO_printf(Perl_debug_log, " %8d", ps->state);
 120
 121     PerlIO_printf(Perl_debug_log, "\ntoken:");
 122     for (ps = min; ps <= parser->ps; ps++)
 123         PerlIO_printf(Perl_debug_log, " %8.8s", ps->name);
 124
 125     PerlIO_printf(Perl_debug_log, "\nvalue:");
 126     for (ps = min; ps <= parser->ps; ps++) {
 127         switch (yy_type_tab[yystos[ps->state]]) {
 128         case toketype_opval:
 129             PerlIO_printf(Perl_debug_log, " %8.8s",
 130                   ps->val.opval
 131                     ? PL_op_name[ps->val.opval->op_type]
 132                     : "(Nullop)"
 133             );
 134             break;
 135 #ifndef PERL_IN_MADLY_C
 136         case toketype_p_tkval:
 137             PerlIO_printf(Perl_debug_log, " %8.8s",
 138                   ps->val.pval ? ps->val.pval : "(NULL)");
 139             break;
 140
 141         case toketype_i_tkval:
 142 #endif
 143         case toketype_ival:
 144             PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)ps->val.ival);
 145             break;
 146         default:
 147             PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)ps->val.ival);
 148         }
 149     }
 150     PerlIO_printf(Perl_debug_log, "\n\n");
 151 }
 152
 153 #  define YY_STACK_PRINT(parser)        \
 154 do {                                    \
 155     if (yydebug && DEBUG_v_TEST)        \
 156         yy_stack_print (aTHX_ parser);  \
 157 } while (0)
 158
 159
 160 /*------------------------------------------------.
 161 | Report that the YYRULE is going to be reduced.  |
 162 `------------------------------------------------*/
 163
 164 static void
 165 yy_reduce_print (pTHX_ int yyrule)
 166 {
 167     int yyi;
 168     const unsigned int yylineno = yyrline[yyrule];
 169     YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
 170                           yyrule - 1, yylineno);
 171     /* Print the symbols being reduced, and their result.  */
 172     for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
 173         YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
 174     YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
 175 }
 176
 177 #  define YY_REDUCE_PRINT(Rule)         \
 178 do {                                    \
 179     if (yydebug)                        \
 180         yy_reduce_print (aTHX_ Rule);           \
 181 } while (0)
 182
 183 #else /* !DEBUGGING */
 184 #  define YYDPRINTF(Args)
 185 #  define YYDSYMPRINTF(Title, Token, Value)
 186 #  define YY_STACK_PRINT(parser)
 187 #  define YY_REDUCE_PRINT(Rule)
 188 #endif /* !DEBUGGING */
 189
 190
 191 /* YYINITDEPTH -- initial size of the parser's stacks.  */
 192 #define YYINITDEPTH 200
 193
 194 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
 195  * parse stack, thus avoiding leaks if we die  */
 196
 197 static void
 198 S_clear_yystack(pTHX_ const void *p)
 199 {
 200     yy_parser      *parser = (yy_parser*) SvPVX((SV*)p);
 201     yy_stack_frame *ps     = parser->ps;
 202     int i;
 203
 204     if (ps == &parser->stack[0])
 205         return;
 206
 207     YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
 208
 209     /* Freeing ops on the stack, and the op_latefree / op_latefreed /
 210      * op_attached flags:
 211      *
 212      * When we pop tokens off the stack during error recovery, or when
 213      * we pop all the tokens off the stack after a die during a shift or
 214      * reduce (i.e. Perl_croak somewhere in yylex() or in one of the
 215      * newFOO() functions), then it's possible that some of these tokens are
 216      * of type opval, pointing to an OP. All these ops are orphans; each is
 217      * its own miniature subtree that has not yet been attached to a
 218      * larger tree. In this case, we should clearly free the op (making
 219      * sure, for each op we free that we have PL_comppad pointing to the
 220      * right place for freeing any SVs attached to the op in threaded
 221      * builds.
 222      *
 223      * However, there is a particular problem if we die in newFOO() called
 224      * by a reducing action; e.g.
 225      *
 226      *    foo : bar baz boz
 227      *        { $$ = newFOO($1,$2,$3) }
 228      *
 229      * where
 230      *  OP *newFOO { ....; if (...) croak; .... }
 231      *
 232      * In this case, when we come to clean bar baz and boz off the stack,
 233      * we don't know whether newFOO() has already:
 234      *    * freed them
 235      *    * left them as is
 236      *    * attached them to part of a larger tree
 237      *    * attached them to PL_compcv
 238      *    * attached them to PL_compcv then freed it (as in BEGIN {die } )
 239      *
 240      * To get round this problem, we set the flag op_latefree on every op
 241      * that gets pushed onto the parser stack. If op_free() sees this
 242      * flag, it clears the op and frees any children,, but *doesn't* free
 243      * the op itself; instead it sets the op_latefreed flag. This means
 244      * that we can safely call op_free() multiple times on each stack op.
 245      * So, when clearing the stack, we first, for each op that was being
 246      * reduced, call op_free with op_latefree=1. This ensures that all ops
 247      * hanging off these op are freed, but the reducing ops themselces are
 248      * just undefed. Then we set op_latefreed=0 on *all* ops on the stack
 249      * and free them. A little thought should convince you that this
 250      * two-part approach to the reducing ops should handle the first three
 251      * cases above safely.
 252      *
 253      * In the case of attaching to PL_compcv (currently just newATTRSUB
 254      * does this), then  we set the op_attached flag on the op that has
 255      * been so attached, then avoid doing the final op_free during
 256      * cleanup, on the assumption that it will happen (or has already
 257      * happened) when PL_compcv is freed.
 258      *
 259      * Note this is fairly fragile mechanism. A more robust approach
 260      * would be to use two of these flag bits as 2-bit reference count
 261      * field for each op, indicating whether it is pointed to from:
 262      *   * a parent op
 263      *   * the parser stack
 264      *   * a CV
 265      * but this would involve reworking all code (core and external) that
 266      * manipulate op trees.
 267      */
 268
 269     /* clear any reducing ops (1st pass) */
 270
 271     for (i=0; i< parser->yylen; i++) {
 272         if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
 273             && ps[-i].val.opval) {
 274             if ( ! (ps[-i].val.opval->op_attached
 275                     && !ps[-i].val.opval->op_latefreed))
 276             {
 277                 if (ps[-i].comppad != PL_comppad) {
 278                     PAD_RESTORE_LOCAL(ps[-i].comppad);
 279                 }
 280                 op_free(ps[-i].val.opval);
 281             }
 282         }
 283     }
 284
 285     /* now free whole the stack, including the just-reduced ops */
 286
 287     while (ps > &parser->stack[0]) {
 288         if (yy_type_tab[yystos[ps->state]] == toketype_opval
 289             && ps->val.opval)
 290         {
 291             if (ps->comppad != PL_comppad) {
 292                 PAD_RESTORE_LOCAL(ps->comppad);
 293             }
 294             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 295             ps->val.opval->op_latefree  = 0;
 296             if (!(ps->val.opval->op_attached && !ps->val.opval->op_latefreed))
 297                 op_free(ps->val.opval);
 298         }
 299         ps--;
 300     }
 301 }
 302
 303
 304
 305 /*----------.
 306 | yyparse.  |
 307 `----------*/
 308
 309 int
 310 #ifdef PERL_IN_MADLY_C
 311 Perl_madparse (pTHX)
 312 #else
 313 Perl_yyparse (pTHX)
 314 #endif
 315 {
 316     dVAR;
 317     register int yystate;
 318     register int yyn;
 319     int yyresult;
 320
 321     /* Lookahead token as an internal (translated) token number.  */
 322     int yytoken;
 323
 324     SV *parser_sv;                  /* SV whose PVX holds the parser object */
 325     register yy_parser *parser;     /* the parser object */
 326     register yy_stack_frame  *ps;   /* current parser stack frame */
 327
 328 #define YYPOPSTACK   parser->ps = --ps
 329 #define YYPUSHSTACK  parser->ps = ++ps
 330
 331     /* The variables used to return semantic value and location from the
 332           action routines: ie $$.  */
 333     YYSTYPE yyval;
 334
 335 #ifndef PERL_IN_MADLY_C
 336 #  ifdef PERL_MAD
 337     if (PL_madskills)
 338         return madparse();
 339 #  endif
 340 #endif
 341
 342     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
 343
 344     ENTER;                      /* force stack free before we return */
 345     SAVEVPTR(PL_parser);
 346
 347     parser_sv = newSV(sizeof(yy_parser)
 348                         + (YYINITDEPTH-1) * sizeof(yy_stack_frame));
 349     SAVEFREESV(parser_sv);
 350     PL_parser = parser = (yy_parser*)  SvPVX(parser_sv);
 351     ps = (yy_stack_frame*) &parser->stack[0];
 352     parser->ps = ps;
 353
 354     parser->stack_size = YYINITDEPTH;
 355
 356     /* cleanup the parse stack on premature exit */
 357     SAVEDESTRUCTOR_X(S_clear_yystack, (void*) parser_sv);
 358
 359
 360     ps->state = 0;
 361     parser->yyerrstatus = 0;
 362     parser->yychar = YYEMPTY;           /* Cause a token to be read.  */
 363
 364 /*------------------------------------------------------------.
 365 | yynewstate -- Push a new state, which is found in yystate.  |
 366 `------------------------------------------------------------*/
 367   yynewstate:
 368
 369     yystate = ps->state;
 370
 371     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 372
 373     if (yy_type_tab[yystos[yystate]] == toketype_opval && ps->val.opval) {
 374         ps->val.opval->op_latefree  = 1;
 375         ps->val.opval->op_latefreed = 0;
 376     }
 377
 378     parser->yylen = 0;
 379
 380     {
 381         size_t size = ps - &parser->stack[0] + 1;
 382
 383         /* grow the stack? We always leave 1 spare slot,
 384          * in case of a '' -> 'foo' reduction */
 385
 386         if (size >= parser->stack_size - 1) {
 387             /* this will croak on insufficient memory */
 388             parser->stack_size *= 2;
 389             PL_parser = parser =
 390                         (yy_parser*) SvGROW(parser_sv, sizeof(yy_parser)
 391                             + (parser->stack_size-1) * sizeof(yy_stack_frame));
 392
 393             /* readdress any pointers into realloced parser object */
 394             ps = parser->ps = &parser->stack[0] + size -1;
 395
 396             YYDPRINTF((Perl_debug_log,
 397                             "parser stack size increased to %lu frames\n",
 398                             (unsigned long int)parser->stack_size));
 399         }
 400     }
 401
 402 /* Do appropriate processing given the current state.  */
 403 /* Read a lookahead token if we need one and don't already have one.  */
 404
 405     /* First try to decide what to do without reference to lookahead token.  */
 406
 407     yyn = yypact[yystate];
 408     if (yyn == YYPACT_NINF)
 409         goto yydefault;
 410
 411     /* Not known => get a lookahead token if don't already have one.  */
 412
 413     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
 414     if (parser->yychar == YYEMPTY) {
 415         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
 416 #ifdef PERL_IN_MADLY_C
 417         parser->yychar = PL_madskills ? madlex() : yylex();
 418 #else
 419         parser->yychar = yylex();
 420 #endif
 421
 422 #  ifdef EBCDIC
 423         if (parser->yychar >= 0 && parser->yychar < 255) {
 424             parser->yychar = NATIVE_TO_ASCII(parser->yychar);
 425         }
 426 #  endif
 427     }
 428
 429     if (parser->yychar <= YYEOF) {
 430         parser->yychar = yytoken = YYEOF;
 431         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
 432     }
 433     else {
 434         yytoken = YYTRANSLATE (parser->yychar);
 435         YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
 436     }
 437
 438     /* If the proper action on seeing token YYTOKEN is to reduce or to
 439           detect an error, take that action.  */
 440     yyn += yytoken;
 441     if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
 442         goto yydefault;
 443     yyn = yytable[yyn];
 444     if (yyn <= 0) {
 445         if (yyn == 0 || yyn == YYTABLE_NINF)
 446             goto yyerrlab;
 447         yyn = -yyn;
 448         goto yyreduce;
 449     }
 450
 451     if (yyn == YYFINAL)
 452         YYACCEPT;
 453
 454     /* Shift the lookahead token.  */
 455     YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
 456
 457     /* Discard the token being shifted unless it is eof.  */
 458     if (parser->yychar != YYEOF)
 459         parser->yychar = YYEMPTY;
 460
 461     YYPUSHSTACK;
 462     ps->state   = yyn;
 463     ps->val     = parser->yylval;
 464     ps->comppad = PL_comppad;
 465 #ifdef DEBUGGING
 466     ps->name    = (const char *)(yytname[yytoken]);
 467 #endif
 468
 469     /* Count tokens shifted since error; after three, turn off error
 470           status.  */
 471     if (parser->yyerrstatus)
 472         parser->yyerrstatus--;
 473
 474     goto yynewstate;
 475
 476
 477   /*-----------------------------------------------------------.
 478   | yydefault -- do the default action for the current state.  |
 479   `-----------------------------------------------------------*/
 480   yydefault:
 481     yyn = yydefact[yystate];
 482     if (yyn == 0)
 483         goto yyerrlab;
 484     goto yyreduce;
 485
 486
 487   /*-----------------------------.
 488   | yyreduce -- Do a reduction.  |
 489   `-----------------------------*/
 490   yyreduce:
 491     /* yyn is the number of a rule to reduce with.  */
 492     parser->yylen = yyr2[yyn];
 493
 494     /* If YYLEN is nonzero, implement the default value of the action:
 495       "$$ = $1".
 496
 497       Otherwise, the following line sets YYVAL to garbage.
 498       This behavior is undocumented and Bison
 499       users should not rely upon it.  Assigning to YYVAL
 500       unconditionally makes the parser a bit smaller, and it avoids a
 501       GCC warning that YYVAL may be used uninitialized.  */
 502     yyval = ps[1-parser->yylen].val;
 503
 504     YY_STACK_PRINT(parser);
 505     YY_REDUCE_PRINT (yyn);
 506
 507     switch (yyn) {
 508
 509
 510 #define dep() deprecate("\"do\" to call subroutines")
 511
 512 #ifdef PERL_IN_MADLY_C
 513 #  define IVAL(i) (i)->tk_lval.ival
 514 #  define PVAL(p) (p)->tk_lval.pval
 515 #  define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
 516 #  define TOKEN_FREE(a) token_free(a)
 517 #  define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
 518 #  define IF_MAD(a,b) (a)
 519 #  define DO_MAD(a) a
 520 #  define MAD
 521 #else
 522 #  define IVAL(i) (i)
 523 #  define PVAL(p) (p)
 524 #  define TOKEN_GETMAD(a,b,c)
 525 #  define TOKEN_FREE(a)
 526 #  define OP_GETMAD(a,b,c)
 527 #  define IF_MAD(a,b) (b)
 528 #  define DO_MAD(a)
 529 #  undef MAD
 530 #endif
 531
 532 /* contains all the rule actions; auto-generated from perly.y */
 533 #include "perly.act"
 534
 535     }
 536
 537     /* any just-reduced ops with the op_latefreed flag cleared need to be
 538      * freed; the rest need the flag resetting */
 539     {
 540         int i;
 541         for (i=0; i< parser->yylen; i++) {
 542             if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
 543                 && ps[-i].val.opval)
 544             {
 545                 ps[-i].val.opval->op_latefree = 0;
 546                 if (ps[-i].val.opval->op_latefreed)
 547                     op_free(ps[-i].val.opval);
 548             }
 549         }
 550     }
 551
 552     parser->ps = ps -= (parser->yylen-1);
 553
 554     /* Now shift the result of the reduction.  Determine what state
 555           that goes to, based on the state we popped back to and the rule
 556           number reduced by.  */
 557
 558     ps->val     = yyval;
 559     ps->comppad = PL_comppad;
 560 #ifdef DEBUGGING
 561     ps->name    = (const char *)(yytname [yyr1[yyn]]);
 562 #endif
 563
 564     yyn = yyr1[yyn];
 565
 566     yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
 567     if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
 568         yystate = yytable[yystate];
 569     else
 570         yystate = yydefgoto[yyn - YYNTOKENS];
 571     ps->state = yystate;
 572
 573     goto yynewstate;
 574
 575
 576   /*------------------------------------.
 577   | yyerrlab -- here on detecting error |
 578   `------------------------------------*/
 579   yyerrlab:
 580     /* If not already recovering from an error, report this error.  */
 581     if (!parser->yyerrstatus) {
 582         yyerror ("syntax error");
 583     }
 584
 585
 586     if (parser->yyerrstatus == 3) {
 587         /* If just tried and failed to reuse lookahead token after an
 588               error, discard it.  */
 589
 590         /* Return failure if at end of input.  */
 591         if (parser->yychar == YYEOF) {
 592             /* Pop the error token.  */
 593             YYPOPSTACK;
 594             /* Pop the rest of the stack.  */
 595             while (ps > &parser->stack[0]) {
 596                 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
 597                 if (yy_type_tab[yystos[ps->state]] == toketype_opval
 598                         && ps->val.opval)
 599                 {
 600                     YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 601                     if (ps->comppad != PL_comppad) {
 602                         PAD_RESTORE_LOCAL(ps->comppad);
 603                     }
 604                     ps->val.opval->op_latefree  = 0;
 605                     op_free(ps->val.opval);
 606                 }
 607                 YYPOPSTACK;
 608             }
 609             YYABORT;
 610         }
 611
 612         YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
 613         parser->yychar = YYEMPTY;
 614
 615     }
 616
 617     /* Else will try to reuse lookahead token after shifting the error
 618           token.  */
 619     goto yyerrlab1;
 620
 621
 622   /*----------------------------------------------------.
 623   | yyerrlab1 -- error raised explicitly by an action.  |
 624   `----------------------------------------------------*/
 625   yyerrlab1:
 626     parser->yyerrstatus = 3;    /* Each real token shifted decrements this.  */
 627
 628     for (;;) {
 629         yyn = yypact[yystate];
 630         if (yyn != YYPACT_NINF) {
 631             yyn += YYTERROR;
 632             if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
 633                 yyn = yytable[yyn];
 634                 if (0 < yyn)
 635                     break;
 636             }
 637         }
 638
 639         /* Pop the current state because it cannot handle the error token.  */
 640         if (ps == &parser->stack[0])
 641             YYABORT;
 642
 643         YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
 644         if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
 645             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 646             if (ps->comppad != PL_comppad) {
 647                 PAD_RESTORE_LOCAL(ps->comppad);
 648             }
 649             ps->val.opval->op_latefree  = 0;
 650             op_free(ps->val.opval);
 651         }
 652         YYPOPSTACK;
 653         yystate = ps->state;
 654
 655         YY_STACK_PRINT(parser);
 656     }
 657
 658     if (yyn == YYFINAL)
 659         YYACCEPT;
 660
 661     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
 662
 663     YYPUSHSTACK;
 664     ps->state   = yyn;
 665     ps->val     = parser->yylval;
 666     ps->comppad = PL_comppad;
 667 #ifdef DEBUGGING
 668     ps->name    ="<err>";
 669 #endif
 670
 671     goto yynewstate;
 672
 673
 674   /*-------------------------------------.
 675   | yyacceptlab -- YYACCEPT comes here.  |
 676   `-------------------------------------*/
 677   yyacceptlab:
 678     yyresult = 0;
 679     parser->ps = &parser->stack[0]; /* disable cleanup */
 680     goto yyreturn;
 681
 682   /*-----------------------------------.
 683   | yyabortlab -- YYABORT comes here.  |
 684   `-----------------------------------*/
 685   yyabortlab:
 686     yyresult = 1;
 687     goto yyreturn;
 688
 689   yyreturn:
 690     LEAVE;                      /* force stack free before we return */
 691     return yyresult;
 692 }
 693
 694 /*
 695  * Local variables:
 696  * c-indentation-style: bsd
 697  * c-basic-offset: 4
 698  * indent-tabs-mode: t
 699  * End:
 700  *
 701  * ex: set ts=8 sts=4 sw=4 noet:
 702  */