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)
 111         min = parser->stack + 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);
 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 /* YYINITDEPTH -- initial size of the parser's stacks.  */
 191 #define YYINITDEPTH 200
 192
 193 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
 194  * parse stack, thus avoiding leaks if we die  */
 195
 196 static void
 197 S_clear_yystack(pTHX_  const yy_parser *parser)
 198 {
 199     yy_stack_frame *ps     = parser->ps;
 200     int i;
 201
 202     if (ps == parser->stack)
 203         return;
 204
 205     YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
 206
 207     /* Freeing ops on the stack, and the op_latefree / op_latefreed /
 208      * op_attached flags:
 209      *
 210      * When we pop tokens off the stack during error recovery, or when
 211      * we pop all the tokens off the stack after a die during a shift or
 212      * reduce (i.e. Perl_croak somewhere in yylex() or in one of the
 213      * newFOO() functions), then it's possible that some of these tokens are
 214      * of type opval, pointing to an OP. All these ops are orphans; each is
 215      * its own miniature subtree that has not yet been attached to a
 216      * larger tree. In this case, we should clearly free the op (making
 217      * sure, for each op we free that we have PL_comppad pointing to the
 218      * right place for freeing any SVs attached to the op in threaded
 219      * builds.
 220      *
 221      * However, there is a particular problem if we die in newFOO() called
 222      * by a reducing action; e.g.
 223      *
 224      *    foo : bar baz boz
 225      *        { $$ = newFOO($1,$2,$3) }
 226      *
 227      * where
 228      *  OP *newFOO { ....; if (...) croak; .... }
 229      *
 230      * In this case, when we come to clean bar baz and boz off the stack,
 231      * we don't know whether newFOO() has already:
 232      *    * freed them
 233      *    * left them as is
 234      *    * attached them to part of a larger tree
 235      *    * attached them to PL_compcv
 236      *    * attached them to PL_compcv then freed it (as in BEGIN {die } )
 237      *
 238      * To get round this problem, we set the flag op_latefree on every op
 239      * that gets pushed onto the parser stack. If op_free() sees this
 240      * flag, it clears the op and frees any children,, but *doesn't* free
 241      * the op itself; instead it sets the op_latefreed flag. This means
 242      * that we can safely call op_free() multiple times on each stack op.
 243      * So, when clearing the stack, we first, for each op that was being
 244      * reduced, call op_free with op_latefree=1. This ensures that all ops
 245      * hanging off these op are freed, but the reducing ops themselces are
 246      * just undefed. Then we set op_latefreed=0 on *all* ops on the stack
 247      * and free them. A little thought should convince you that this
 248      * two-part approach to the reducing ops should handle the first three
 249      * cases above safely.
 250      *
 251      * In the case of attaching to PL_compcv (currently just newATTRSUB
 252      * does this), then  we set the op_attached flag on the op that has
 253      * been so attached, then avoid doing the final op_free during
 254      * cleanup, on the assumption that it will happen (or has already
 255      * happened) when PL_compcv is freed.
 256      *
 257      * Note this is fairly fragile mechanism. A more robust approach
 258      * would be to use two of these flag bits as 2-bit reference count
 259      * field for each op, indicating whether it is pointed to from:
 260      *   * a parent op
 261      *   * the parser stack
 262      *   * a CV
 263      * but this would involve reworking all code (core and external) that
 264      * manipulate op trees.
 265      */
 266
 267     /* clear any reducing ops (1st pass) */
 268
 269     for (i=0; i< parser->yylen; i++) {
 270         if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
 271             && ps[-i].val.opval) {
 272             if ( ! (ps[-i].val.opval->op_attached
 273                     && !ps[-i].val.opval->op_latefreed))
 274             {
 275                 if (ps[-i].comppad != PL_comppad) {
 276                     PAD_RESTORE_LOCAL(ps[-i].comppad);
 277                 }
 278                 op_free(ps[-i].val.opval);
 279             }
 280         }
 281     }
 282
 283     /* now free whole the stack, including the just-reduced ops */
 284
 285     while (ps > parser->stack) {
 286         if (yy_type_tab[yystos[ps->state]] == toketype_opval
 287             && ps->val.opval)
 288         {
 289             if (ps->comppad != PL_comppad) {
 290                 PAD_RESTORE_LOCAL(ps->comppad);
 291             }
 292             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 293             ps->val.opval->op_latefree  = 0;
 294             if (!(ps->val.opval->op_attached && !ps->val.opval->op_latefreed))
 295                 op_free(ps->val.opval);
 296         }
 297         ps--;
 298     }
 299 }
 300
 301 /* delete a parser object */
 302
 303 static void
 304 S_parser_free(pTHX_  const yy_parser *parser)
 305 {
 306     S_clear_yystack(aTHX_ parser);
 307     Safefree(parser->stack);
 308     PL_parser = parser->old_parser;
 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 variables 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     Newx(parser, 1, yy_parser);
 351     parser->old_parser = PL_parser;
 352     PL_parser = parser;
 353
 354     Newx(ps, YYINITDEPTH, yy_stack_frame);
 355     parser->stack = ps;
 356     parser->ps = ps;
 357     parser->stack_size = YYINITDEPTH;
 358
 359     ENTER;  /* force parser free before we return */
 360     SAVEDESTRUCTOR_X(S_parser_free, (void*) parser);
 361
 362
 363     ps->state = 0;
 364     parser->yyerrstatus = 0;
 365     parser->yychar = YYEMPTY;           /* Cause a token to be read.  */
 366
 367 /*------------------------------------------------------------.
 368 | yynewstate -- Push a new state, which is found in yystate.  |
 369 `------------------------------------------------------------*/
 370   yynewstate:
 371
 372     yystate = ps->state;
 373
 374     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 375
 376     if (yy_type_tab[yystos[yystate]] == toketype_opval && ps->val.opval) {
 377         ps->val.opval->op_latefree  = 1;
 378         ps->val.opval->op_latefreed = 0;
 379     }
 380
 381     parser->yylen = 0;
 382
 383     {
 384         size_t size = ps - parser->stack + 1;
 385
 386         /* grow the stack? We always leave 1 spare slot,
 387          * in case of a '' -> 'foo' reduction */
 388
 389         if (size >= parser->stack_size - 1) {
 390             /* this will croak on insufficient memory */
 391             parser->stack_size *= 2;
 392             Renew(parser->stack, parser->stack_size, yy_stack_frame);
 393             ps = parser->ps = parser->stack + size -1;
 394
 395             YYDPRINTF((Perl_debug_log,
 396                             "parser stack size increased to %lu frames\n",
 397                             (unsigned long int)parser->stack_size));
 398         }
 399     }
 400
 401 /* Do appropriate processing given the current state.  */
 402 /* Read a lookahead token if we need one and don't already have one.  */
 403
 404     /* First try to decide what to do without reference to lookahead token.  */
 405
 406     yyn = yypact[yystate];
 407     if (yyn == YYPACT_NINF)
 408         goto yydefault;
 409
 410     /* Not known => get a lookahead token if don't already have one.  */
 411
 412     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
 413     if (parser->yychar == YYEMPTY) {
 414         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
 415 #ifdef PERL_IN_MADLY_C
 416         parser->yychar = PL_madskills ? madlex() : yylex();
 417 #else
 418         parser->yychar = yylex();
 419 #endif
 420
 421 #  ifdef EBCDIC
 422         if (parser->yychar >= 0 && parser->yychar < 255) {
 423             parser->yychar = NATIVE_TO_ASCII(parser->yychar);
 424         }
 425 #  endif
 426     }
 427
 428     if (parser->yychar <= YYEOF) {
 429         parser->yychar = yytoken = YYEOF;
 430         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
 431     }
 432     else {
 433         yytoken = YYTRANSLATE (parser->yychar);
 434         YYDSYMPRINTF ("Next token is", yytoken, &parser->yylval);
 435     }
 436
 437     /* If the proper action on seeing token YYTOKEN is to reduce or to
 438           detect an error, take that action.  */
 439     yyn += yytoken;
 440     if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
 441         goto yydefault;
 442     yyn = yytable[yyn];
 443     if (yyn <= 0) {
 444         if (yyn == 0 || yyn == YYTABLE_NINF)
 445             goto yyerrlab;
 446         yyn = -yyn;
 447         goto yyreduce;
 448     }
 449
 450     if (yyn == YYFINAL)
 451         YYACCEPT;
 452
 453     /* Shift the lookahead token.  */
 454     YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
 455
 456     /* Discard the token being shifted unless it is eof.  */
 457     if (parser->yychar != YYEOF)
 458         parser->yychar = YYEMPTY;
 459
 460     YYPUSHSTACK;
 461     ps->state   = yyn;
 462     ps->val     = parser->yylval;
 463     ps->comppad = PL_comppad;
 464 #ifdef DEBUGGING
 465     ps->name    = (const char *)(yytname[yytoken]);
 466 #endif
 467
 468     /* Count tokens shifted since error; after three, turn off error
 469           status.  */
 470     if (parser->yyerrstatus)
 471         parser->yyerrstatus--;
 472
 473     goto yynewstate;
 474
 475
 476   /*-----------------------------------------------------------.
 477   | yydefault -- do the default action for the current state.  |
 478   `-----------------------------------------------------------*/
 479   yydefault:
 480     yyn = yydefact[yystate];
 481     if (yyn == 0)
 482         goto yyerrlab;
 483     goto yyreduce;
 484
 485
 486   /*-----------------------------.
 487   | yyreduce -- Do a reduction.  |
 488   `-----------------------------*/
 489   yyreduce:
 490     /* yyn is the number of a rule to reduce with.  */
 491     parser->yylen = yyr2[yyn];
 492
 493     /* If YYLEN is nonzero, implement the default value of the action:
 494       "$$ = $1".
 495
 496       Otherwise, the following line sets YYVAL to garbage.
 497       This behavior is undocumented and Bison
 498       users should not rely upon it.  Assigning to YYVAL
 499       unconditionally makes the parser a bit smaller, and it avoids a
 500       GCC warning that YYVAL may be used uninitialized.  */
 501     yyval = ps[1-parser->yylen].val;
 502
 503     YY_STACK_PRINT(parser);
 504     YY_REDUCE_PRINT (yyn);
 505
 506     switch (yyn) {
 507
 508
 509 #define dep() deprecate("\"do\" to call subroutines")
 510
 511 #ifdef PERL_IN_MADLY_C
 512 #  define IVAL(i) (i)->tk_lval.ival
 513 #  define PVAL(p) (p)->tk_lval.pval
 514 #  define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
 515 #  define TOKEN_FREE(a) token_free(a)
 516 #  define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
 517 #  define IF_MAD(a,b) (a)
 518 #  define DO_MAD(a) a
 519 #  define MAD
 520 #else
 521 #  define IVAL(i) (i)
 522 #  define PVAL(p) (p)
 523 #  define TOKEN_GETMAD(a,b,c)
 524 #  define TOKEN_FREE(a)
 525 #  define OP_GETMAD(a,b,c)
 526 #  define IF_MAD(a,b) (b)
 527 #  define DO_MAD(a)
 528 #  undef MAD
 529 #endif
 530
 531 /* contains all the rule actions; auto-generated from perly.y */
 532 #include "perly.act"
 533
 534     }
 535
 536     /* any just-reduced ops with the op_latefreed flag cleared need to be
 537      * freed; the rest need the flag resetting */
 538     {
 539         int i;
 540         for (i=0; i< parser->yylen; i++) {
 541             if (yy_type_tab[yystos[ps[-i].state]] == toketype_opval
 542                 && ps[-i].val.opval)
 543             {
 544                 ps[-i].val.opval->op_latefree = 0;
 545                 if (ps[-i].val.opval->op_latefreed)
 546                     op_free(ps[-i].val.opval);
 547             }
 548         }
 549     }
 550
 551     parser->ps = ps -= (parser->yylen-1);
 552
 553     /* Now shift the result of the reduction.  Determine what state
 554           that goes to, based on the state we popped back to and the rule
 555           number reduced by.  */
 556
 557     ps->val     = yyval;
 558     ps->comppad = PL_comppad;
 559 #ifdef DEBUGGING
 560     ps->name    = (const char *)(yytname [yyr1[yyn]]);
 561 #endif
 562
 563     yyn = yyr1[yyn];
 564
 565     yystate = yypgoto[yyn - YYNTOKENS] + ps[-1].state;
 566     if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == ps[-1].state)
 567         yystate = yytable[yystate];
 568     else
 569         yystate = yydefgoto[yyn - YYNTOKENS];
 570     ps->state = yystate;
 571
 572     goto yynewstate;
 573
 574
 575   /*------------------------------------.
 576   | yyerrlab -- here on detecting error |
 577   `------------------------------------*/
 578   yyerrlab:
 579     /* If not already recovering from an error, report this error.  */
 580     if (!parser->yyerrstatus) {
 581         yyerror ("syntax error");
 582     }
 583
 584
 585     if (parser->yyerrstatus == 3) {
 586         /* If just tried and failed to reuse lookahead token after an
 587               error, discard it.  */
 588
 589         /* Return failure if at end of input.  */
 590         if (parser->yychar == YYEOF) {
 591             /* Pop the error token.  */
 592             YYPOPSTACK;
 593             /* Pop the rest of the stack.  */
 594             while (ps > parser->stack) {
 595                 YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
 596                 if (yy_type_tab[yystos[ps->state]] == toketype_opval
 597                         && ps->val.opval)
 598                 {
 599                     YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 600                     if (ps->comppad != PL_comppad) {
 601                         PAD_RESTORE_LOCAL(ps->comppad);
 602                     }
 603                     ps->val.opval->op_latefree  = 0;
 604                     op_free(ps->val.opval);
 605                 }
 606                 YYPOPSTACK;
 607             }
 608             YYABORT;
 609         }
 610
 611         YYDSYMPRINTF ("Error: discarding", yytoken, &parser->yylval);
 612         parser->yychar = YYEMPTY;
 613
 614     }
 615
 616     /* Else will try to reuse lookahead token after shifting the error
 617           token.  */
 618     goto yyerrlab1;
 619
 620
 621   /*----------------------------------------------------.
 622   | yyerrlab1 -- error raised explicitly by an action.  |
 623   `----------------------------------------------------*/
 624   yyerrlab1:
 625     parser->yyerrstatus = 3;    /* Each real token shifted decrements this.  */
 626
 627     for (;;) {
 628         yyn = yypact[yystate];
 629         if (yyn != YYPACT_NINF) {
 630             yyn += YYTERROR;
 631             if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
 632                 yyn = yytable[yyn];
 633                 if (0 < yyn)
 634                     break;
 635             }
 636         }
 637
 638         /* Pop the current state because it cannot handle the error token.  */
 639         if (ps == parser->stack)
 640             YYABORT;
 641
 642         YYDSYMPRINTF ("Error: popping", yystos[ps->state], &ps->val);
 643         if (yy_type_tab[yystos[ps->state]] == toketype_opval && ps->val.opval) {
 644             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 645             if (ps->comppad != PL_comppad) {
 646                 PAD_RESTORE_LOCAL(ps->comppad);
 647             }
 648             ps->val.opval->op_latefree  = 0;
 649             op_free(ps->val.opval);
 650         }
 651         YYPOPSTACK;
 652         yystate = ps->state;
 653
 654         YY_STACK_PRINT(parser);
 655     }
 656
 657     if (yyn == YYFINAL)
 658         YYACCEPT;
 659
 660     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
 661
 662     YYPUSHSTACK;
 663     ps->state   = yyn;
 664     ps->val     = parser->yylval;
 665     ps->comppad = PL_comppad;
 666 #ifdef DEBUGGING
 667     ps->name    ="<err>";
 668 #endif
 669
 670     goto yynewstate;
 671
 672
 673   /*-------------------------------------.
 674   | yyacceptlab -- YYACCEPT comes here.  |
 675   `-------------------------------------*/
 676   yyacceptlab:
 677     yyresult = 0;
 678     parser->ps = parser->stack; /* disable cleanup */
 679     goto yyreturn;
 680
 681   /*-----------------------------------.
 682   | yyabortlab -- YYABORT comes here.  |
 683   `-----------------------------------*/
 684   yyabortlab:
 685     yyresult = 1;
 686     goto yyreturn;
 687
 688   yyreturn:
 689     LEAVE;                      /* force parser free before we return */
 690     return yyresult;
 691 }
 692
 693 /*
 694  * Local variables:
 695  * c-indentation-style: bsd
 696  * c-basic-offset: 4
 697  * indent-tabs-mode: t
 698  * End:
 699  *
 700  * ex: set ts=8 sts=4 sw=4 noet:
 701  */