perly.c

   1 /*    perly.c
   2  *
   3  *    Copyright (c) 2004 Larry Wall
   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 #included
  11  *    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
  22
  23 /* allow stack size to grow effectively without limit */
  24 #define YYMAXDEPTH 10000000
  25
  26 #include "EXTERN.h"
  27 #define PERL_IN_PERLY_C
  28 #include "perl.h"
  29
  30 typedef signed char yysigned_char;
  31
  32 #ifdef DEBUGGING
  33 #  define YYDEBUG 1
  34 #else
  35 #  define YYDEBUG 0
  36 #endif
  37
  38 /* contains all the parser state tables; auto-generated from perly.y */
  39 #include "perly.tab"
  40
  41 # define YYSIZE_T size_t
  42
  43 #define yyerrok         (yyerrstatus = 0)
  44 #define yyclearin       (yychar = YYEMPTY)
  45 #define YYEMPTY         (-2)
  46 #define YYEOF           0
  47
  48 #define YYACCEPT        goto yyacceptlab
  49 #define YYABORT         goto yyabortlab
  50 #define YYERROR         goto yyerrlab1
  51
  52
  53 /* Like YYERROR except do call yyerror.  This remains here temporarily
  54    to ease the transition to the new meaning of YYERROR, for GCC.
  55    Once GCC version 2 has supplanted version 1, this can go.  */
  56
  57 #define YYFAIL          goto yyerrlab
  58
  59 #define YYRECOVERING()  (!!yyerrstatus)
  60
  61 #define YYBACKUP(Token, Value)                                  \
  62 do                                                              \
  63     if (yychar == YYEMPTY && yylen == 1) {                      \
  64         yychar = (Token);                                       \
  65         yylval = (Value);                                       \
  66         yytoken = YYTRANSLATE (yychar);                         \
  67         YYPOPSTACK;                                             \
  68         goto yybackup;                                          \
  69     }                                                           \
  70     else {                                                      \
  71         yyerror ("syntax error: cannot back up");               \
  72         YYERROR;                                                \
  73     }                                                           \
  74 while (0)
  75
  76 #define YYTERROR        1
  77 #define YYERRCODE       256
  78
  79 /* YYLEX -- calling `yylex' with the right arguments.  */
  80
  81 # define YYLEX yylex_r (&yylval, &yychar)
  82
  83 /* Enable debugging if requested.  */
  84 #if DEBUGGING
  85
  86 #  define yydebug (DEBUG_p_TEST)
  87
  88 #  define YYFPRINTF PerlIO_printf
  89
  90 #  define YYDPRINTF(Args)                       \
  91 do {                                            \
  92     if (yydebug)                                \
  93         YYFPRINTF Args;                         \
  94 } while (0)
  95
  96 #  define YYDSYMPRINT(Args)                     \
  97 do {                                            \
  98     if (yydebug)                                \
  99         yysymprint Args;                        \
 100 } while (0)
 101
 102 #  define YYDSYMPRINTF(Title, Token, Value, Location)           \
 103 do {                                                            \
 104     if (yydebug) {                                              \
 105         YYFPRINTF (Perl_debug_log, "%s ", Title);               \
 106         yysymprint (aTHX_ Perl_debug_log,  Token, Value);               \
 107         YYFPRINTF (Perl_debug_log, "\n");                       \
 108     }                                                           \
 109 } while (0)
 110
 111 /*--------------------------------.
 112 | Print this symbol on YYOUTPUT.  |
 113 `--------------------------------*/
 114
 115 static void
 116 yysymprint (pTHX_ PerlIO *yyoutput, int yytype, YYSTYPE *yyvaluep)
 117 {
 118     /* Pacify ``unused variable'' warnings.  */
 119     (void) yyvaluep;
 120
 121     if (yytype < YYNTOKENS) {
 122         YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
 123 #   ifdef YYPRINT
 124         YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
 125 #   endif
 126     }
 127     else
 128         YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
 129
 130     switch (yytype) {
 131         default:
 132             break;
 133     }
 134     YYFPRINTF (yyoutput, ")");
 135 }
 136
 137
 138 /*------------------------------------------------------------------.
 139 | yy_stack_print -- Print the state stack from its BOTTOM up to its |
 140 | TOP (cinluded).                                                   |
 141 `------------------------------------------------------------------*/
 142
 143 static void
 144 yy_stack_print (pTHX_ short *bottom, short *top)
 145 {
 146     YYFPRINTF (Perl_debug_log, "Stack now");
 147     for (/* Nothing. */; bottom <= top; ++bottom)
 148         YYFPRINTF (Perl_debug_log, " %d", *bottom);
 149     YYFPRINTF (Perl_debug_log, "\n");
 150 }
 151
 152 #  define YY_STACK_PRINT(Bottom, Top)                           \
 153 do {                                                            \
 154     if (yydebug)                                                \
 155         yy_stack_print (aTHX_ (Bottom), (Top));                 \
 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     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 YYDSYMPRINT(Args)
 185 #  define YYDSYMPRINTF(Title, Token, Value, Location)
 186 #  define YY_STACK_PRINT(Bottom, Top)
 187 #  define YY_REDUCE_PRINT(Rule)
 188 #endif /* !DEBUGGING */
 189
 190
 191 /* YYINITDEPTH -- initial size of the parser's stacks.  */
 192 #ifndef YYINITDEPTH
 193 # define YYINITDEPTH 200
 194 #endif
 195
 196
 197 #if YYERROR_VERBOSE
 198 #  ifndef yystrlen
 199 #    if defined (__GLIBC__) && defined (_STRING_H)
 200 #      define yystrlen strlen
 201 #    else
 202 /* Return the length of YYSTR.  */
 203 static YYSIZE_T
 204 yystrlen (const char *yystr)
 205 {
 206     register const char *yys = yystr;
 207
 208     while (*yys++ != '\0')
 209         continue;
 210
 211     return yys - yystr - 1;
 212 }
 213 #    endif
 214 #  endif
 215
 216 #  ifndef yystpcpy
 217 #    if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE)
 218 #      define yystpcpy stpcpy
 219 #    else
 220 /* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
 221    YYDEST.  */
 222 static char *
 223 yystpcpy (pTHX_ char *yydest, const char *yysrc)
 224 {
 225     register char *yyd = yydest;
 226     register const char *yys = yysrc;
 227
 228     while ((*yyd++ = *yys++) != '\0')
 229         continue;
 230
 231     return yyd - 1;
 232 }
 233 #    endif
 234 #  endif
 235
 236 #endif /* !YYERROR_VERBOSE */
 237
 238
 239 /*-----------------------------------------------.
 240 | Release the memory associated to this symbol.  |
 241 `-----------------------------------------------*/
 242
 243 static void
 244 yydestruct (int yytype, YYSTYPE *yyvaluep)
 245 {
 246     /* Pacify ``unused variable'' warnings.  */
 247     (void) yyvaluep;
 248
 249     switch (yytype) {
 250         default:
 251             break;
 252     }
 253 }
 254
 255
 256
 257
 258 /*----------.
 259 | yyparse.  |
 260 `----------*/
 261
 262 int
 263 Perl_yyparse (pTHX)
 264 {
 265     int yychar; /* The lookahead symbol.  */
 266     YYSTYPE yylval; /* The semantic value of the lookahead symbol.  */
 267     int yynerrs; /* Number of syntax errors so far.  */
 268     register int yystate;
 269     register int yyn;
 270     int yyresult;
 271
 272     /* Number of tokens to shift before error messages enabled.  */
 273     int yyerrstatus;
 274     /* Lookahead token as an internal (translated) token number.  */
 275     int yytoken = 0;
 276
 277     /* two stacks and their tools:
 278           `yyss': related to states,
 279           `yyvs': related to semantic values,
 280
 281           Refer to the stacks thru separate pointers, to allow yyoverflow
 282           to reallocate them elsewhere.  */
 283
 284     /* The state stack.  */
 285     short *yyss;
 286     register short *yyssp;
 287
 288     /* The semantic value stack.  */
 289     YYSTYPE *yyvs;
 290     register YYSTYPE *yyvsp;
 291
 292     /* for ease of re-allocation and automatic freeing, have two SVs whose
 293       * SvPVX points to the stacks */
 294     SV *yyss_sv, *yyvs_sv;
 295
 296 #define YYPOPSTACK   (yyvsp--, yyssp--)
 297
 298     YYSIZE_T yystacksize = YYINITDEPTH;
 299
 300     /* The variables used to return semantic value and location from the
 301           action routines.  */
 302     YYSTYPE yyval;
 303
 304
 305     /* When reducing, the number of symbols on the RHS of the reduced
 306           rule.  */
 307     int yylen;
 308
 309     YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
 310
 311     yyss_sv = NEWSV(73, YYINITDEPTH * sizeof(short));
 312     yyvs_sv = NEWSV(73, YYINITDEPTH * sizeof(YYSTYPE));
 313 #ifdef USE_ITHREADS
 314     /* XXX is this needed anymore? DAPM 13-Feb-04;
 315      * if not, delete the correspinding LEAVE too */
 316     ENTER;                      /* force stack free before we return */
 317 #endif
 318     SAVEFREESV(yyss_sv);
 319     SAVEFREESV(yyvs_sv);
 320     yyss = (short *) SvPVX(yyss_sv);
 321     yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 322
 323     yystate = 0;
 324     yyerrstatus = 0;
 325     yynerrs = 0;
 326     yychar = YYEMPTY;           /* Cause a token to be read.  */
 327
 328     /* Initialize stack pointers.
 329           Waste one element of value and location stack
 330           so that they stay on the same level as the state stack.
 331           The wasted elements are never initialized.  */
 332
 333     yyssp = yyss;
 334     yyvsp = yyvs;
 335
 336     goto yysetstate;
 337
 338 /*------------------------------------------------------------.
 339 | yynewstate -- Push a new state, which is found in yystate.  |
 340 `------------------------------------------------------------*/
 341   yynewstate:
 342     /* In all cases, when you get here, the value and location stacks
 343           have just been pushed. so pushing a state here evens the stacks.
 344           */
 345     yyssp++;
 346
 347   yysetstate:
 348     *yyssp = yystate;
 349
 350     if (yyss + yystacksize - 1 <= yyssp) {
 351          /* Get the current used size of the three stacks, in elements.  */
 352          YYSIZE_T yysize = yyssp - yyss + 1;
 353
 354          /* Extend the stack our own way.  */
 355          if (YYMAXDEPTH <= yystacksize)
 356                goto yyoverflowlab;
 357          yystacksize *= 2;
 358          if (YYMAXDEPTH < yystacksize)
 359                yystacksize = YYMAXDEPTH;
 360
 361          SvGROW(yyss_sv, yystacksize * sizeof(short));
 362          SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
 363          yyss = (short *) SvPVX(yyss_sv);
 364          yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
 365          if (!yyss || ! yyvs)
 366                goto yyoverflowlab;
 367
 368          yyssp = yyss + yysize - 1;
 369          yyvsp = yyvs + yysize - 1;
 370
 371
 372          YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
 373                                    (unsigned long int) yystacksize));
 374
 375          if (yyss + yystacksize - 1 <= yyssp)
 376                YYABORT;
 377     }
 378
 379     YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
 380
 381     goto yybackup;
 382
 383   /*-----------.
 384   | yybackup.  |
 385   `-----------*/
 386   yybackup:
 387
 388 /* Do appropriate processing given the current state.  */
 389 /* Read a lookahead token if we need one and don't already have one.  */
 390 /* yyresume: */
 391
 392     /* First try to decide what to do without reference to lookahead token.  */
 393
 394     yyn = yypact[yystate];
 395     if (yyn == YYPACT_NINF)
 396         goto yydefault;
 397
 398     /* Not known => get a lookahead token if don't already have one.  */
 399
 400     /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol.  */
 401     if (yychar == YYEMPTY) {
 402         YYDPRINTF ((Perl_debug_log, "Reading a token: "));
 403         yychar = YYLEX;
 404     }
 405
 406     if (yychar <= YYEOF) {
 407         yychar = yytoken = YYEOF;
 408         YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
 409     }
 410     else {
 411         yytoken = YYTRANSLATE (yychar);
 412         YYDSYMPRINTF ("Next token is", yytoken, &yylval, &yylloc);
 413     }
 414
 415     /* If the proper action on seeing token YYTOKEN is to reduce or to
 416           detect an error, take that action.  */
 417     yyn += yytoken;
 418     if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
 419         goto yydefault;
 420     yyn = yytable[yyn];
 421     if (yyn <= 0) {
 422         if (yyn == 0 || yyn == YYTABLE_NINF)
 423             goto yyerrlab;
 424         yyn = -yyn;
 425         goto yyreduce;
 426     }
 427
 428     if (yyn == YYFINAL)
 429         YYACCEPT;
 430
 431     /* Shift the lookahead token.  */
 432     YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
 433
 434     /* Discard the token being shifted unless it is eof.  */
 435     if (yychar != YYEOF)
 436         yychar = YYEMPTY;
 437
 438     *++yyvsp = yylval;
 439
 440
 441     /* Count tokens shifted since error; after three, turn off error
 442           status.  */
 443     if (yyerrstatus)
 444         yyerrstatus--;
 445
 446     yystate = yyn;
 447     goto yynewstate;
 448
 449
 450   /*-----------------------------------------------------------.
 451   | yydefault -- do the default action for the current state.  |
 452   `-----------------------------------------------------------*/
 453   yydefault:
 454     yyn = yydefact[yystate];
 455     if (yyn == 0)
 456         goto yyerrlab;
 457     goto yyreduce;
 458
 459
 460   /*-----------------------------.
 461   | yyreduce -- Do a reduction.  |
 462   `-----------------------------*/
 463   yyreduce:
 464     /* yyn is the number of a rule to reduce with.  */
 465     yylen = yyr2[yyn];
 466
 467     /* If YYLEN is nonzero, implement the default value of the action:
 468       `$$ = $1'.
 469
 470       Otherwise, the following line sets YYVAL to garbage.
 471       This behavior is undocumented and Bison
 472       users should not rely upon it.  Assigning to YYVAL
 473       unconditionally makes the parser a bit smaller, and it avoids a
 474       GCC warning that YYVAL may be used uninitialized.  */
 475     yyval = yyvsp[1-yylen];
 476
 477
 478     YY_REDUCE_PRINT (yyn);
 479     switch (yyn) {
 480
 481 /* contains all the rule actions; auto-generated from perly.y */
 482
 483 #define dep() deprecate("\"do\" to call subroutines")
 484 #include "perly.act"
 485
 486     }
 487
 488     yyvsp -= yylen;
 489     yyssp -= yylen;
 490
 491     YY_STACK_PRINT (yyss, yyssp);
 492
 493     *++yyvsp = yyval;
 494
 495
 496     /* Now `shift' the result of the reduction.  Determine what state
 497           that goes to, based on the state we popped back to and the rule
 498           number reduced by.  */
 499
 500     yyn = yyr1[yyn];
 501
 502     yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
 503     if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
 504         yystate = yytable[yystate];
 505     else
 506         yystate = yydefgoto[yyn - YYNTOKENS];
 507
 508     goto yynewstate;
 509
 510
 511   /*------------------------------------.
 512   | yyerrlab -- here on detecting error |
 513   `------------------------------------*/
 514   yyerrlab:
 515     /* If not already recovering from an error, report this error.  */
 516     if (!yyerrstatus) {
 517         ++yynerrs;
 518 #if YYERROR_VERBOSE
 519         yyn = yypact[yystate];
 520
 521         if (YYPACT_NINF < yyn && yyn < YYLAST) {
 522             YYSIZE_T yysize = 0;
 523             int yytype = YYTRANSLATE (yychar);
 524             char *yymsg;
 525             int yyx, yycount;
 526
 527             yycount = 0;
 528             /* Start YYX at -YYN if negative to avoid negative indexes in
 529                   YYCHECK.  */
 530             for (yyx = yyn < 0 ? -yyn : 0;
 531                       yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
 532                 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
 533                     yysize += yystrlen (yytname[yyx]) + 15, yycount++;
 534             yysize += yystrlen ("syntax error, unexpected ") + 1;
 535             yysize += yystrlen (yytname[yytype]);
 536             New(yymsg, yysize, char *);
 537             if (yymsg != 0) {
 538                 char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
 539                 yyp = yystpcpy (yyp, yytname[yytype]);
 540
 541                 if (yycount < 5) {
 542                     yycount = 0;
 543                     for (yyx = yyn < 0 ? -yyn : 0;
 544                               yyx < (int) (sizeof (yytname) / sizeof (char *));
 545                               yyx++)
 546                     {
 547                         if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
 548                             const char *yyq = ! yycount ?
 549                                                     ", expecting " : " or ";
 550                             yyp = yystpcpy (yyp, yyq);
 551                             yyp = yystpcpy (yyp, yytname[yyx]);
 552                             yycount++;
 553                         }
 554                     }
 555                 }
 556                 yyerror (yymsg);
 557                 YYSTACK_FREE (yymsg);
 558             }
 559             else
 560                 yyerror ("syntax error; also virtual memory exhausted");
 561         }
 562         else
 563 #endif /* YYERROR_VERBOSE */
 564             yyerror ("syntax error");
 565     }
 566
 567
 568     if (yyerrstatus == 3) {
 569         /* If just tried and failed to reuse lookahead token after an
 570               error, discard it.  */
 571
 572         /* Return failure if at end of input.  */
 573         if (yychar == YYEOF) {
 574             /* Pop the error token.  */
 575             YYPOPSTACK;
 576             /* Pop the rest of the stack.  */
 577             while (yyss < yyssp) {
 578                 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
 579                 yydestruct (yystos[*yyssp], yyvsp);
 580                 YYPOPSTACK;
 581             }
 582             YYABORT;
 583         }
 584
 585         YYDSYMPRINTF ("Error: discarding", yytoken, &yylval, &yylloc);
 586         yydestruct (yytoken, &yylval);
 587         yychar = YYEMPTY;
 588
 589     }
 590
 591     /* Else will try to reuse lookahead token after shifting the error
 592           token.  */
 593     goto yyerrlab1;
 594
 595
 596   /*----------------------------------------------------.
 597   | yyerrlab1 -- error raised explicitly by an action.  |
 598   `----------------------------------------------------*/
 599   yyerrlab1:
 600     yyerrstatus = 3;    /* Each real token shifted decrements this.  */
 601
 602     for (;;) {
 603         yyn = yypact[yystate];
 604         if (yyn != YYPACT_NINF) {
 605             yyn += YYTERROR;
 606             if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
 607                 yyn = yytable[yyn];
 608                 if (0 < yyn)
 609                     break;
 610             }
 611         }
 612
 613         /* Pop the current state because it cannot handle the error token.  */
 614         if (yyssp == yyss)
 615             YYABORT;
 616
 617         YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp, yylsp);
 618         yydestruct (yystos[yystate], yyvsp);
 619         yyvsp--;
 620         yystate = *--yyssp;
 621
 622         YY_STACK_PRINT (yyss, yyssp);
 623     }
 624
 625     if (yyn == YYFINAL)
 626         YYACCEPT;
 627
 628     YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
 629
 630     *++yyvsp = yylval;
 631
 632     yystate = yyn;
 633     goto yynewstate;
 634
 635
 636   /*-------------------------------------.
 637   | yyacceptlab -- YYACCEPT comes here.  |
 638   `-------------------------------------*/
 639   yyacceptlab:
 640     yyresult = 0;
 641     goto yyreturn;
 642
 643   /*-----------------------------------.
 644   | yyabortlab -- YYABORT comes here.  |
 645   `-----------------------------------*/
 646   yyabortlab:
 647     yyresult = 1;
 648     goto yyreturn;
 649
 650   /*----------------------------------------------.
 651   | yyoverflowlab -- parser overflow comes here.  |
 652   `----------------------------------------------*/
 653   yyoverflowlab:
 654     yyerror ("parser stack overflow");
 655     yyresult = 2;
 656     /* Fall through.  */
 657
 658   yyreturn:
 659
 660 #ifdef USE_ITHREADS
 661         LEAVE;                  /* force stack free before we return */
 662 #endif
 663
 664     return yyresult;
 665 }