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 YYEMPTY         (-2)
  54 #define YYEOF           0
  55 #define YYTERROR        1
  56
  57 #define YYACCEPT        goto yyacceptlab
  58 #define YYABORT         goto yyabortlab
  59 #define YYERROR         goto yyerrlab1
  60
  61 /* Enable debugging if requested.  */
  62 #ifdef DEBUGGING
  63
  64 #  define yydebug (DEBUG_p_TEST)
  65
  66 #  define YYFPRINTF PerlIO_printf
  67
  68 #  define YYDPRINTF(Args)                       \
  69 do {                                            \
  70     if (yydebug)                                \
  71         YYFPRINTF Args;                         \
  72 } while (0)
  73
  74 #  define YYDSYMPRINTF(Title, Token, Value)                     \
  75 do {                                                            \
  76     if (yydebug) {                                              \
  77         YYFPRINTF (Perl_debug_log, "%s ", Title);               \
  78         yysymprint (aTHX_ Perl_debug_log,  Token, Value);       \
  79         YYFPRINTF (Perl_debug_log, "\n");                       \
  80     }                                                           \
  81 } while (0)
  82
  83 /*--------------------------------.
  84 | Print this symbol on YYOUTPUT.  |
  85 `--------------------------------*/
  86
  87 static void
  88 yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
  89 {
  90     if (yytype < YYNTOKENS) {
  91         YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
  92 #   ifdef YYPRINT
  93         YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
  94 #   else
  95         YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
  96 #   endif
  97     }
  98     else
  99         YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
 100
 101     YYFPRINTF (yyoutput, ")");
 102 }
 103
 104
 105 /*  yy_stack_print()
 106  *  print the top 8 items on the parse stack.  The args have the same
 107  *  meanings as the local vars in yyparse() of the same name */
 108
 109 static void
 110 yy_stack_print (pTHX_ const short *yyss, const short *yyssp, const YYSTYPE *yyvs, const char**yyns)
 111 {
 112     int i;
 113     int start = 1;
 114     int count = (int)(yyssp - yyss);
 115
 116     if (count > 8) {
 117         start = count - 8 + 1;
 118         count = 8;
 119     }
 120
 121     PerlIO_printf(Perl_debug_log, "\nindex:");
 122     for (i=0; i < count; i++)
 123         PerlIO_printf(Perl_debug_log, " %8d", start+i);
 124     PerlIO_printf(Perl_debug_log, "\nstate:");
 125     for (i=0; i < count; i++)
 126         PerlIO_printf(Perl_debug_log, " %8d", yyss[start+i]);
 127     PerlIO_printf(Perl_debug_log, "\ntoken:");
 128     for (i=0; i < count; i++)
 129         PerlIO_printf(Perl_debug_log, " %8.8s", yyns[start+i]);
 130     PerlIO_printf(Perl_debug_log, "\nvalue:");
 131     for (i=0; i < count; i++) {
 132         switch (yy_type_tab[yystos[yyss[start+i]]]) {
 133         case toketype_opval:
 134             PerlIO_printf(Perl_debug_log, " %8.8s",
 135                   yyvs[start+i].opval
 136                     ? PL_op_name[yyvs[start+i].opval->op_type]
 137                     : "(Nullop)"
 138             );
 139             break;
 140 #ifndef PERL_IN_MADLY_C
 141         case toketype_p_tkval:
 142             PerlIO_printf(Perl_debug_log, " %8.8s",
 143                   yyvs[start+i].pval ? yyvs[start+i].pval : "(NULL)");
 144             break;
 145
 146         case toketype_i_tkval:
 147 #endif
 148         case toketype_ival:
 149             PerlIO_printf(Perl_debug_log, " %8"IVdf, (IV)yyvs[start+i].ival);
 150             break;
 151         default:
 152             PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)yyvs[start+i].ival);
 153         }
 154     }
 155     PerlIO_printf(Perl_debug_log, "\n\n");
 156 }
 157
 158 #  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)               \
 159 do {                                                            \
 160     if (yydebug && DEBUG_v_TEST)                                \
 161         yy_stack_print (aTHX_ (yyss), (yyssp), (yyvs), (yyns)); \
 162 } while (0)
 163
 164
 165 /*------------------------------------------------.
 166 | Report that the YYRULE is going to be reduced.  |
 167 `------------------------------------------------*/
 168
 169 static void
 170 yy_reduce_print (pTHX_ int yyrule)
 171 {
 172     int yyi;
 173     const unsigned int yylineno = yyrline[yyrule];
 174     YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
 175                           yyrule - 1, yylineno);
 176     /* Print the symbols being reduced, and their result.  */
 177     for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
 178         YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
 179     YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
 180 }
 181
 182 #  define YY_REDUCE_PRINT(Rule)         \
 183 do {                                    \
 184     if (yydebug)                        \
 185         yy_reduce_print (aTHX_ Rule);           \
 186 } while (0)
 187
 188 #else /* !DEBUGGING */
 189 #  define YYDPRINTF(Args)
 190 #  define YYDSYMPRINTF(Title, Token, Value)
 191 #  define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)
 192 #  define YY_REDUCE_PRINT(Rule)
 193 #endif /* !DEBUGGING */
 194
 195
 196 /* YYINITDEPTH -- initial size of the parser's stacks.  */
 197 #define YYINITDEPTH 200
 198
 199 /* a snapshot of the current stack position variables for use by
 200  * S_clear_yystack */
 201
 202 typedef struct {
 203     short *yyss;
 204     short *yyssp;
 205     YYSTYPE *yyvsp;
 206     AV **yypsp;
 207     int yylen;
 208 } yystack_positions;
 209
 210 /* called during cleanup (via SAVEDESTRUCTOR_X) to free any items on the
 211  * parse stack, thus avoiding leaks if we die  */
 212
 213 static void
 214 S_clear_yystack(pTHX_ const void *p)
 215 {
 216     yystack_positions *y = (yystack_positions*) p;
 217     int i;
 218
 219     if (!y->yyss)
 220         return;
 221     YYDPRINTF ((Perl_debug_log, "clearing the parse stack\n"));
 222
 223     /* Freeing ops on the stack, and the op_latefree/op_latefreed flags:
 224      *
 225      * When we pop tokens off the stack during error recovery, or when
 226      * we pop all the tokens off the stack after a die during a shift or
 227      * reduce (ie Perl_croak somewhere in yylex(), or in one of the
 228      * newFOO() functions, then its possible that some of these tokens are
 229      * of type opval, pointing to an OP. All these ops are orphans; each is
 230      * its own miniature subtree that has not yet been attached to a
 231      * larger tree. In this case, we shoould clearly free the op (making
 232      * sure, for each op we free thyat we have PL_comppad pointing to the
 233      * right place for freeing any SVs attached to the op in threaded
 234      * builds.
 235      *
 236      * However, there is a particular problem if we die in newFOO called
 237      * by a reducing action; e.g.
 238      *
 239      *    foo : bar baz boz
 240      *        { $$ = newFOO($1,$2,$3) }
 241      *
 242      * where
 243      *  OP *newFOO { .... croak .... }
 244      *
 245      * In this case, when we come to clean bar baz and boz off the stack,
 246      * we don't know whether newFOO() has already:
 247      *    * freed them
 248      *    * left them as it
 249      *    * attached them to part of a larger tree
 250      *
 251      * To get round this problem, we set the flag op_latefree on every op
 252      * that gets pushed onto the parser stack. If op_free() sees this
 253      * flag, it clears the op and frees any children,, but *doesn't* free
 254      * the op itself; instead it sets the op_latefreed flag. This means
 255      * that we can safely call op_free() multiple times on each stack op.
 256      * So, when clearing the stack, we first, for each op that was being
 257      * reduced, call op_free with op_latefree=1. This ensures that all ops
 258      * hanging off these op are freed, but the reducing ops themselces are
 259      * just undefed. Then we set op_latefreed=0 on *all* ops on the stack
 260      * and free them. A little though should convince you that this
 261      * two-part approach to the reducing ops should handle all three cases
 262      * above safely.
 263      */
 264
 265     /* free any reducing ops (1st pass) */
 266
 267     for (i=0; i< y->yylen; i++) {
 268         if (yy_type_tab[yystos[y->yyssp[-i]]] == toketype_opval
 269             && y->yyvsp[-i].opval) {
 270             if (y->yypsp[-i] != PL_comppad) {
 271                 PAD_RESTORE_LOCAL(y->yypsp[-i]);
 272             }
 273             op_free(y->yyvsp[-i].opval);
 274         }
 275     }
 276
 277     /* now free whole the stack, including the just-reduced ops */
 278
 279     while (y->yyssp > y->yyss) {
 280         if (yy_type_tab[yystos[*y->yyssp]] == toketype_opval
 281             && y->yyvsp->opval)
 282         {
 283             if (*y->yypsp != PL_comppad) {
 284                 PAD_RESTORE_LOCAL(*y->yypsp);
 285             }
 286             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 287             y->yyvsp->opval->op_latefree  = 0;
 288             op_free(y->yyvsp->opval);
 289         }
 290         y->yyvsp--;
 291         y->yyssp--;
 292         y->yypsp--;
 293     }
 294 }
 295
 296
 297
 298 /*----------.
 299 | yyparse.  |
 300 `----------*/
 301
 302 int
 303 #ifdef PERL_IN_MADLY_C
 304 Perl_madparse (pTHX)
 305 #else
 306 Perl_yyparse (pTHX)
 307 #endif
 308 {
 309     dVAR;
 310     int yychar; /* The lookahead symbol.  */
 311     YYSTYPE yylval; /* The semantic value of the lookahead symbol.  */
 312     int yynerrs; /* Number of syntax errors so far.  */
 313     register int yystate;
 314     register int yyn;
 315     int yyresult;
 316
 317     /* Number of tokens to shift before error messages enabled.  */
 318     int yyerrstatus;
 319     /* Lookahead token as an internal (translated) token number.  */
 320     int yytoken = 0;
 321
 322     /* three stacks and their tools:
 323           yyss: related to states,
 324           yyvs: related to semantic values,
 325           yyps: current value of PL_comppad for each state
 326
 327
 328           Refer to the stacks thru separate pointers, to allow yyoverflow
 329           to reallocate them elsewhere.  */
 330
 331     /* The state stack.  */
 332     short *yyss;
 333     register short *yyssp;
 334
 335     /* The semantic value stack.  */
 336     YYSTYPE *yyvs;
 337     register YYSTYPE *yyvsp;
 338
 339     AV **yyps;
 340     AV **yypsp;
 341
 342     /* for ease of re-allocation and automatic freeing, have three SVs whose
 343       * SvPVX points to the stacks */
 344     SV *yyss_sv, *yyvs_sv, *yyps_sv;
 345     SV *ss_save_sv;
 346     yystack_positions *ss_save;
 347
 348
 349 #ifdef DEBUGGING
 350     /* maintain also a stack of token/rule names for debugging with -Dpv */
 351     const char **yyns, **yynsp;
 352     SV *yyns_sv;
 353 #  define YYPOPSTACK   (yyvsp--, yyssp--, yypsp--, yynsp--)
 354 #else
 355 #  define YYPOPSTACK   (yyvsp--, yyssp--, yypsp--)
 356 #endif
 357
 358
 359     YYSIZE_T yystacksize = YYINITDEPTH;
 360
 361     /* The variables used to return semantic value and location from the
 362           action routines.  */
 363     YYSTYPE yyval;
 364
 365
 366     /* When reducing, the number of symbols on the RHS of the reduced
 367           rule.  */
 368     int yylen;
 369
 370 #ifndef PERL_IN_MADLY_C
 371 #  ifdef PERL_MAD
 372     if (PL_madskills)
 373         return madparse();
 374 #  endif
 375 #endif
 376
 377     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
 378
 379     ENTER;                      /* force stack free before we return */
 380     SAVEVPTR(PL_yycharp);
 381     SAVEVPTR(PL_yylvalp);
 382     PL_yycharp = &yychar; /* so PL_yyerror() can access it */
 383     PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
 384
 385     yyss_sv = newSV(YYINITDEPTH * sizeof(short));
 386     yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
 387     yyps_sv = newSV(YYINITDEPTH * sizeof(AV*));
 388     ss_save_sv = newSV(sizeof(yystack_positions));
 389     SAVEFREESV(yyss_sv);
 390     SAVEFREESV(yyvs_sv);
 391     SAVEFREESV(yyps_sv);
 392     SAVEFREESV(ss_save_sv);
 393     yyss = (short *) SvPVX(yyss_sv);
 394     yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 395     yyps = (AV **) SvPVX(yyps_sv);
 396     ss_save = (yystack_positions *) SvPVX(ss_save_sv);
 397
 398     ss_save->yyss = NULL; /* disarm stack cleanup */
 399     /* cleanup the parse stack on premature exit */
 400     SAVEDESTRUCTOR_X(S_clear_yystack, (void*) ss_save);
 401
 402     /* note that elements zero of yyvs and yyns are not used */
 403     yyssp = yyss;
 404     yyvsp = yyvs;
 405     yypsp = yyps;
 406 #ifdef DEBUGGING
 407     yyns_sv = newSV(YYINITDEPTH * sizeof(char *));
 408     SAVEFREESV(yyns_sv);
 409     /* XXX This seems strange to cast char * to char ** */
 410     yyns = (const char **) SvPVX(yyns_sv);
 411     yynsp = yyns;
 412 #endif
 413
 414     *yyssp = 0;
 415     yyvsp->ival = 0;
 416     yyerrstatus = 0;
 417     yynerrs = 0;
 418     yychar = YYEMPTY;           /* Cause a token to be read.  */
 419
 420 /*------------------------------------------------------------.
 421 | yynewstate -- Push a new state, which is found in yystate.  |
 422 `------------------------------------------------------------*/
 423   yynewstate:
 424
 425     yystate = *yyssp;
 426
 427     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 428
 429     if (yy_type_tab[yystos[yystate]] == toketype_opval && yyvsp->opval) {
 430         yyvsp->opval->op_latefree  = 1;
 431         yyvsp->opval->op_latefreed = 0;
 432     }
 433
 434     ss_save->yyss = yyss;
 435     ss_save->yyssp = yyssp;
 436     ss_save->yyvsp = yyvsp;
 437     ss_save->yypsp = yypsp;
 438     ss_save->yylen = 0;
 439
 440     if (yyss + yystacksize - 1 <= yyssp) {
 441          /* Get the current used size of the three stacks, in elements.  */
 442          const YYSIZE_T yysize = yyssp - yyss + 1;
 443
 444          /* Extend the stack our own way.  */
 445          if (YYMAXDEPTH <= yystacksize)
 446                goto yyoverflowlab;
 447          yystacksize *= 2;
 448          if (YYMAXDEPTH < yystacksize)
 449                yystacksize = YYMAXDEPTH;
 450
 451          SvGROW(yyss_sv, yystacksize * sizeof(short));
 452          SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
 453          SvGROW(yyps_sv, yystacksize * sizeof(AV*));
 454          yyss = (short *) SvPVX(yyss_sv);
 455          yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 456          yyps = (AV **) SvPVX(yyps_sv);
 457 #ifdef DEBUGGING
 458          SvGROW(yyns_sv, yystacksize * sizeof(char *));
 459          /* XXX This seems strange to cast char * to char ** */
 460          yyns = (const char **) SvPVX(yyns_sv);
 461          if (! yyns)
 462                goto yyoverflowlab;
 463          yynsp = yyns + yysize - 1;
 464 #endif
 465          if (!yyss || ! yyvs || ! yyps)
 466                goto yyoverflowlab;
 467
 468          yyssp = yyss + yysize - 1;
 469          yyvsp = yyvs + yysize - 1;
 470          yypsp = yyps + yysize - 1;
 471
 472
 473          YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
 474                                    (unsigned long int) yystacksize));
 475
 476          if (yyss + yystacksize - 1 <= yyssp)
 477                YYABORT;
 478
 479         ss_save->yyss = yyss;
 480         ss_save->yyssp = yyssp;
 481         ss_save->yyvsp = yyvsp;
 482         ss_save->yypsp = yypsp;
 483         ss_save->yylen = 0;
 484     }
 485
 486 /* Do appropriate processing given the current state.  */
 487 /* Read a lookahead token if we need one and don't already have one.  */
 488 /* yyresume: */
 489
 490     /* First try to decide what to do without reference to lookahead token.  */
 491
 492     yyn = yypact[yystate];
 493     if (yyn == YYPACT_NINF)
 494         goto yydefault;
 495
 496     /* Not known => get a lookahead token if don't already have one.  */
 497
 498     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
 499     if (yychar == YYEMPTY) {
 500         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
 501 #ifdef PERL_IN_MADLY_C
 502         yychar = PL_madskills ? madlex() : yylex();
 503 #else
 504         yychar = yylex();
 505 #endif
 506
 507 #  ifdef EBCDIC
 508         if (yychar >= 0 && yychar < 255) {
 509             yychar = NATIVE_TO_ASCII(yychar);
 510         }
 511 #  endif
 512     }
 513
 514     if (yychar <= YYEOF) {
 515         yychar = yytoken = YYEOF;
 516         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
 517     }
 518     else {
 519         yytoken = YYTRANSLATE (yychar);
 520         YYDSYMPRINTF ("Next token is", yytoken, &yylval);
 521     }
 522
 523     /* If the proper action on seeing token YYTOKEN is to reduce or to
 524           detect an error, take that action.  */
 525     yyn += yytoken;
 526     if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
 527         goto yydefault;
 528     yyn = yytable[yyn];
 529     if (yyn <= 0) {
 530         if (yyn == 0 || yyn == YYTABLE_NINF)
 531             goto yyerrlab;
 532         yyn = -yyn;
 533         goto yyreduce;
 534     }
 535
 536     if (yyn == YYFINAL)
 537         YYACCEPT;
 538
 539     /* Shift the lookahead token.  */
 540     YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
 541
 542     /* Discard the token being shifted unless it is eof.  */
 543     if (yychar != YYEOF)
 544         yychar = YYEMPTY;
 545
 546     *++yyssp = yyn;
 547     *++yyvsp = yylval;
 548     *++yypsp = PL_comppad;
 549 #ifdef DEBUGGING
 550     *++yynsp = (const char *)(yytname[yytoken]);
 551 #endif
 552
 553
 554     /* Count tokens shifted since error; after three, turn off error
 555           status.  */
 556     if (yyerrstatus)
 557         yyerrstatus--;
 558
 559     goto yynewstate;
 560
 561
 562   /*-----------------------------------------------------------.
 563   | yydefault -- do the default action for the current state.  |
 564   `-----------------------------------------------------------*/
 565   yydefault:
 566     yyn = yydefact[yystate];
 567     if (yyn == 0)
 568         goto yyerrlab;
 569     goto yyreduce;
 570
 571
 572   /*-----------------------------.
 573   | yyreduce -- Do a reduction.  |
 574   `-----------------------------*/
 575   yyreduce:
 576     /* yyn is the number of a rule to reduce with.  */
 577     yylen = yyr2[yyn];
 578
 579     /* If YYLEN is nonzero, implement the default value of the action:
 580       "$$ = $1".
 581
 582       Otherwise, the following line sets YYVAL to garbage.
 583       This behavior is undocumented and Bison
 584       users should not rely upon it.  Assigning to YYVAL
 585       unconditionally makes the parser a bit smaller, and it avoids a
 586       GCC warning that YYVAL may be used uninitialized.  */
 587     yyval = yyvsp[1-yylen];
 588
 589     YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
 590     YY_REDUCE_PRINT (yyn);
 591
 592     /* running external code may trigger a die (eg 'use nosuchmodule'):
 593      * record the current stack state so that an unwind will
 594      * free all the pesky OPs lounging around on the parse stack */
 595     ss_save->yyss = yyss;
 596     ss_save->yyssp = yyssp;
 597     ss_save->yyvsp = yyvsp;
 598     ss_save->yypsp = yypsp;
 599     ss_save->yylen = yylen;
 600
 601     switch (yyn) {
 602
 603
 604 #define dep() deprecate("\"do\" to call subroutines")
 605
 606 #ifdef PERL_IN_MADLY_C
 607 #  define IVAL(i) (i)->tk_lval.ival
 608 #  define PVAL(p) (p)->tk_lval.pval
 609 #  define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
 610 #  define TOKEN_FREE(a) token_free(a)
 611 #  define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
 612 #  define IF_MAD(a,b) (a)
 613 #  define DO_MAD(a) a
 614 #  define MAD
 615 #else
 616 #  define IVAL(i) (i)
 617 #  define PVAL(p) (p)
 618 #  define TOKEN_GETMAD(a,b,c)
 619 #  define TOKEN_FREE(a)
 620 #  define OP_GETMAD(a,b,c)
 621 #  define IF_MAD(a,b) (b)
 622 #  define DO_MAD(a)
 623 #  undef MAD
 624 #endif
 625
 626 /* contains all the rule actions; auto-generated from perly.y */
 627 #include "perly.act"
 628
 629     }
 630
 631     /* any just-reduced ops with the op_latefreed flag cleared need to be
 632      * freed; the rest need the flag resetting */
 633     {
 634         int i;
 635         for (i=0; i< yylen; i++) {
 636             if (yy_type_tab[yystos[yyssp[-i]]] == toketype_opval
 637                 && yyvsp[-i].opval)
 638             {
 639                 yyvsp[-i].opval->op_latefree = 0;
 640                 if (yyvsp[-i].opval->op_latefreed)
 641                     op_free(yyvsp[-i].opval);
 642             }
 643         }
 644     }
 645
 646     yyvsp -= yylen;
 647     yyssp -= yylen;
 648     yypsp -= yylen;
 649 #ifdef DEBUGGING
 650     yynsp -= yylen;
 651 #endif
 652
 653     /* Now shift the result of the reduction.  Determine what state
 654           that goes to, based on the state we popped back to and the rule
 655           number reduced by.  */
 656
 657     *++yyvsp = yyval;
 658     *++yypsp = PL_comppad;
 659 #ifdef DEBUGGING
 660     *++yynsp = (const char *)(yytname [yyr1[yyn]]);
 661 #endif
 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     *++yyssp = yystate;
 671
 672     goto yynewstate;
 673
 674
 675   /*------------------------------------.
 676   | yyerrlab -- here on detecting error |
 677   `------------------------------------*/
 678   yyerrlab:
 679     /* If not already recovering from an error, report this error.  */
 680     if (!yyerrstatus) {
 681         ++yynerrs;
 682         yyerror ("syntax error");
 683     }
 684
 685
 686     if (yyerrstatus == 3) {
 687         /* If just tried and failed to reuse lookahead token after an
 688               error, discard it.  */
 689
 690         /* Return failure if at end of input.  */
 691         if (yychar == YYEOF) {
 692             /* Pop the error token.  */
 693             YYPOPSTACK;
 694             /* Pop the rest of the stack.  */
 695             while (yyss < yyssp) {
 696                 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
 697                 if (yy_type_tab[yystos[*yyssp]] == toketype_opval
 698                         && yyvsp->opval)
 699                 {
 700                     YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 701                     if (*yypsp != PL_comppad) {
 702                         PAD_RESTORE_LOCAL(*yypsp);
 703                     }
 704                     yyvsp->opval->op_latefree  = 0;
 705                     op_free(yyvsp->opval);
 706                 }
 707                 YYPOPSTACK;
 708             }
 709             YYABORT;
 710         }
 711
 712         YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
 713         yychar = YYEMPTY;
 714
 715     }
 716
 717     /* Else will try to reuse lookahead token after shifting the error
 718           token.  */
 719     goto yyerrlab1;
 720
 721
 722   /*----------------------------------------------------.
 723   | yyerrlab1 -- error raised explicitly by an action.  |
 724   `----------------------------------------------------*/
 725   yyerrlab1:
 726     yyerrstatus = 3;    /* Each real token shifted decrements this.  */
 727
 728     for (;;) {
 729         yyn = yypact[yystate];
 730         if (yyn != YYPACT_NINF) {
 731             yyn += YYTERROR;
 732             if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
 733                 yyn = yytable[yyn];
 734                 if (0 < yyn)
 735                     break;
 736             }
 737         }
 738
 739         /* Pop the current state because it cannot handle the error token.  */
 740         if (yyssp == yyss)
 741             YYABORT;
 742
 743         YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
 744         if (yy_type_tab[yystos[*yyssp]] == toketype_opval && yyvsp->opval) {
 745             YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
 746             if (*yypsp != PL_comppad) {
 747                 PAD_RESTORE_LOCAL(*yypsp);
 748             }
 749             yyvsp->opval->op_latefree  = 0;
 750             op_free(yyvsp->opval);
 751         }
 752         yyvsp--;
 753         yypsp--;
 754 #ifdef DEBUGGING
 755         yynsp--;
 756 #endif
 757         yystate = *--yyssp;
 758
 759         YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
 760     }
 761
 762     if (yyn == YYFINAL)
 763         YYACCEPT;
 764
 765     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
 766
 767     *++yyssp = yyn;
 768     *++yyvsp = yylval;
 769     *++yypsp = PL_comppad;
 770 #ifdef DEBUGGING
 771     *++yynsp ="<err>";
 772 #endif
 773
 774     goto yynewstate;
 775
 776
 777   /*-------------------------------------.
 778   | yyacceptlab -- YYACCEPT comes here.  |
 779   `-------------------------------------*/
 780   yyacceptlab:
 781     yyresult = 0;
 782     goto yyreturn;
 783
 784   /*-----------------------------------.
 785   | yyabortlab -- YYABORT comes here.  |
 786   `-----------------------------------*/
 787   yyabortlab:
 788     yyresult = 1;
 789     goto yyreturn;
 790
 791   /*----------------------------------------------.
 792   | yyoverflowlab -- parser overflow comes here.  |
 793   `----------------------------------------------*/
 794   yyoverflowlab:
 795     yyerror ("parser stack overflow");
 796     yyresult = 2;
 797     /* Fall through.  */
 798
 799   yyreturn:
 800
 801     ss_save->yyss = NULL;       /* disarm parse stack cleanup */
 802     LEAVE;                      /* force stack free before we return */
 803
 804     return yyresult;
 805 }
 806
 807 /*
 808  * Local variables:
 809  * c-indentation-style: bsd
 810  * c-basic-offset: 4
 811  * indent-tabs-mode: t
 812  * End:
 813  *
 814  * ex: set ts=8 sts=4 sw=4 noet:
 815  */