perly.c

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