This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Remove code duplication in S_to_utf8_substr() and S_to_byte_substr()
[perl5.git] / perly.c
CommitLineData
0de566d7
DM
1/* perly.c
2 *
54ca4ee7 3 * Copyright (c) 2004, 2005, 2006 Larry Wall and others
0de566d7
DM
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
f05e27e5
DM
10 * and edited; the bits that are dependent on perly.y are now
11 * #included from the files perly.tab and perly.act.
0de566d7
DM
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.
bc463c31
DM
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,
f05e27e5
DM
23 * but which includes extra code for dumping the parse tree.
24 * This is controlled by the PERL_IN_MADLY_C define.
0de566d7
DM
25 */
26
27
3797f23d 28
0de566d7
DM
29/* allow stack size to grow effectively without limit */
30#define YYMAXDEPTH 10000000
31
79072805 32#include "EXTERN.h"
864dbfa3 33#define PERL_IN_PERLY_C
79072805 34#include "perl.h"
09bef843 35
3797f23d
DM
36typedef unsigned char yytype_uint8;
37typedef signed char yytype_int8;
38typedef unsigned short int yytype_uint16;
39typedef short int yytype_int16;
0de566d7
DM
40typedef signed char yysigned_char;
41
42#ifdef DEBUGGING
43# define YYDEBUG 1
93a17b20 44#else
0de566d7 45# define YYDEBUG 0
93a17b20 46#endif
09bef843 47
f05e27e5
DM
48/* contains all the parser state tables; auto-generated from perly.y */
49#include "perly.tab"
0de566d7
DM
50
51# define YYSIZE_T size_t
52
53#define yyerrok (yyerrstatus = 0)
54#define yyclearin (yychar = YYEMPTY)
55#define YYEMPTY (-2)
56#define YYEOF 0
57
58#define YYACCEPT goto yyacceptlab
59#define YYABORT goto yyabortlab
60#define YYERROR goto yyerrlab1
61
62
63/* Like YYERROR except do call yyerror. This remains here temporarily
64 to ease the transition to the new meaning of YYERROR, for GCC.
65 Once GCC version 2 has supplanted version 1, this can go. */
66
67#define YYFAIL goto yyerrlab
68
69#define YYRECOVERING() (!!yyerrstatus)
70
71#define YYBACKUP(Token, Value) \
72do \
73 if (yychar == YYEMPTY && yylen == 1) { \
74 yychar = (Token); \
75 yylval = (Value); \
76 yytoken = YYTRANSLATE (yychar); \
77 YYPOPSTACK; \
78 goto yybackup; \
79 } \
80 else { \
81 yyerror ("syntax error: cannot back up"); \
82 YYERROR; \
83 } \
84while (0)
85
86#define YYTERROR 1
87#define YYERRCODE 256
88
0de566d7 89/* Enable debugging if requested. */
9388183f 90#ifdef DEBUGGING
0de566d7
DM
91
92# define yydebug (DEBUG_p_TEST)
93
94# define YYFPRINTF PerlIO_printf
95
96# define YYDPRINTF(Args) \
97do { \
98 if (yydebug) \
99 YYFPRINTF Args; \
100} while (0)
101
9388183f 102# define YYDSYMPRINTF(Title, Token, Value) \
0de566d7
DM
103do { \
104 if (yydebug) { \
105 YYFPRINTF (Perl_debug_log, "%s ", Title); \
356f4fed 106 yysymprint (aTHX_ Perl_debug_log, Token, Value); \
0de566d7
DM
107 YYFPRINTF (Perl_debug_log, "\n"); \
108 } \
109} while (0)
110
111/*--------------------------------.
112| Print this symbol on YYOUTPUT. |
113`--------------------------------*/
114
115static void
356f4fed 116yysymprint(pTHX_ PerlIO * const yyoutput, int yytype, const YYSTYPE * const yyvaluep)
0de566d7 117{
0de566d7
DM
118 if (yytype < YYNTOKENS) {
119 YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
120# ifdef YYPRINT
121 YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
9388183f 122# else
e4584336 123 YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
0de566d7
DM
124# endif
125 }
126 else
127 YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
128
0de566d7
DM
129 YYFPRINTF (yyoutput, ")");
130}
131
132
9388183f
CB
133/* yy_stack_print()
134 * print the top 8 items on the parse stack. The args have the same
135 * meanings as the local vars in yyparse() of the same name */
0de566d7
DM
136
137static void
df35152e 138yy_stack_print (pTHX_ const short *yyss, const short *yyssp, const YYSTYPE *yyvs, const char**yyns)
0de566d7 139{
9388183f
CB
140 int i;
141 int start = 1;
142 int count = (int)(yyssp - yyss);
143
144 if (count > 8) {
145 start = count - 8 + 1;
146 count = 8;
147 }
148
149 PerlIO_printf(Perl_debug_log, "\nindex:");
150 for (i=0; i < count; i++)
151 PerlIO_printf(Perl_debug_log, " %8d", start+i);
152 PerlIO_printf(Perl_debug_log, "\nstate:");
21612876
DM
153 for (i=0; i < count; i++)
154 PerlIO_printf(Perl_debug_log, " %8d", yyss[start+i]);
9388183f 155 PerlIO_printf(Perl_debug_log, "\ntoken:");
21612876
DM
156 for (i=0; i < count; i++)
157 PerlIO_printf(Perl_debug_log, " %8.8s", yyns[start+i]);
9388183f 158 PerlIO_printf(Perl_debug_log, "\nvalue:");
21612876 159 for (i=0; i < count; i++) {
d5c6462e
DM
160 switch (yy_type_tab[yystos[yyss[start+i]]]) {
161 case toketype_opval:
21612876
DM
162 PerlIO_printf(Perl_debug_log, " %8.8s",
163 yyvs[start+i].opval
164 ? PL_op_name[yyvs[start+i].opval->op_type]
d5c6462e 165 : "(NULL)"
21612876 166 );
d5c6462e
DM
167 break;
168#ifndef PERL_IN_MADLY_C
169 case toketype_p_tkval:
170 PerlIO_printf(Perl_debug_log, " %8.8s",
171 yyvs[start+i].pval ? yyvs[start+i].pval : "(NULL)");
172 break;
173
174 case toketype_i_tkval:
175#endif
176 case toketype_ival:
177 PerlIO_printf(Perl_debug_log, " %8"IVdf, yyvs[start+i].ival);
178 break;
179 default:
21612876 180 PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)yyvs[start+i].ival);
d5c6462e 181 }
21612876 182 }
9388183f 183 PerlIO_printf(Perl_debug_log, "\n\n");
0de566d7
DM
184}
185
9388183f 186# define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns) \
0de566d7 187do { \
9388183f
CB
188 if (yydebug && DEBUG_v_TEST) \
189 yy_stack_print (aTHX_ (yyss), (yyssp), (yyvs), (yyns)); \
0de566d7
DM
190} while (0)
191
09bef843 192
0de566d7
DM
193/*------------------------------------------------.
194| Report that the YYRULE is going to be reduced. |
195`------------------------------------------------*/
196
197static void
198yy_reduce_print (pTHX_ int yyrule)
199{
200 int yyi;
df35152e 201 const unsigned int yylineno = yyrline[yyrule];
0de566d7
DM
202 YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
203 yyrule - 1, yylineno);
204 /* Print the symbols being reduced, and their result. */
205 for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
206 YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
207 YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
208}
209
210# define YY_REDUCE_PRINT(Rule) \
211do { \
212 if (yydebug) \
213 yy_reduce_print (aTHX_ Rule); \
214} while (0)
215
216#else /* !DEBUGGING */
217# define YYDPRINTF(Args)
9388183f
CB
218# define YYDSYMPRINTF(Title, Token, Value)
219# define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)
0de566d7
DM
220# define YY_REDUCE_PRINT(Rule)
221#endif /* !DEBUGGING */
222
223
224/* YYINITDEPTH -- initial size of the parser's stacks. */
225#ifndef YYINITDEPTH
226# define YYINITDEPTH 200
09bef843 227#endif
09bef843 228
0de566d7
DM
229
230#if YYERROR_VERBOSE
231# ifndef yystrlen
232# if defined (__GLIBC__) && defined (_STRING_H)
233# define yystrlen strlen
234# else
235/* Return the length of YYSTR. */
236static YYSIZE_T
237yystrlen (const char *yystr)
238{
239 register const char *yys = yystr;
240
241 while (*yys++ != '\0')
242 continue;
243
244 return yys - yystr - 1;
245}
246# endif
247# endif
248
249# ifndef yystpcpy
250# if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE)
251# define yystpcpy stpcpy
252# else
253/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
254 YYDEST. */
255static char *
256yystpcpy (pTHX_ char *yydest, const char *yysrc)
257{
258 register char *yyd = yydest;
259 register const char *yys = yysrc;
260
261 while ((*yyd++ = *yys++) != '\0')
262 continue;
263
264 return yyd - 1;
265}
266# endif
267# endif
268
269#endif /* !YYERROR_VERBOSE */
270
0de566d7
DM
271/*----------.
272| yyparse. |
273`----------*/
274
79072805 275int
bc463c31
DM
276#ifdef PERL_IN_MADLY_C
277Perl_madparse (pTHX)
278#else
0de566d7 279Perl_yyparse (pTHX)
bc463c31 280#endif
79072805 281{
97aff369 282 dVAR;
0de566d7
DM
283 int yychar; /* The lookahead symbol. */
284 YYSTYPE yylval; /* The semantic value of the lookahead symbol. */
285 int yynerrs; /* Number of syntax errors so far. */
286 register int yystate;
287 register int yyn;
288 int yyresult;
289
290 /* Number of tokens to shift before error messages enabled. */
291 int yyerrstatus;
292 /* Lookahead token as an internal (translated) token number. */
293 int yytoken = 0;
294
295 /* two stacks and their tools:
a0288114
AL
296 yyss: related to states,
297 yyvs: related to semantic values,
0de566d7
DM
298
299 Refer to the stacks thru separate pointers, to allow yyoverflow
300 to reallocate them elsewhere. */
301
302 /* The state stack. */
303 short *yyss;
93a17b20 304 register short *yyssp;
0de566d7
DM
305
306 /* The semantic value stack. */
307 YYSTYPE *yyvs;
93a17b20 308 register YYSTYPE *yyvsp;
a0d0e21e 309
0de566d7
DM
310 /* for ease of re-allocation and automatic freeing, have two SVs whose
311 * SvPVX points to the stacks */
312 SV *yyss_sv, *yyvs_sv;
313
9388183f
CB
314#ifdef DEBUGGING
315 /* maintain also a stack of token/rule names for debugging with -Dpv */
e1ec3a88 316 const char **yyns, **yynsp;
9388183f
CB
317 SV *yyns_sv;
318# define YYPOPSTACK (yyvsp--, yyssp--, yynsp--)
319#else
320# define YYPOPSTACK (yyvsp--, yyssp--)
321#endif
322
0de566d7
DM
323
324 YYSIZE_T yystacksize = YYINITDEPTH;
325
326 /* The variables used to return semantic value and location from the
327 action routines. */
328 YYSTYPE yyval;
329
330
331 /* When reducing, the number of symbols on the RHS of the reduced
332 rule. */
333 int yylen;
334
2af555bf
DM
335 /* keep track of which pad ops are currently using */
336 AV* comppad = PL_comppad;
337
bc463c31
DM
338#ifndef PERL_IN_MADLY_C
339# ifdef PERL_MAD
00e74f14
NC
340 if (PL_madskills)
341 return madparse();
bc463c31 342# endif
81d86705
NC
343#endif
344
0de566d7
DM
345 YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
346
0de566d7 347 ENTER; /* force stack free before we return */
12fbd33b
DM
348 SAVEVPTR(PL_yycharp);
349 SAVEVPTR(PL_yylvalp);
350 PL_yycharp = &yychar; /* so PL_yyerror() can access it */
351 PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
352
561b68a9
SH
353 yyss_sv = newSV(YYINITDEPTH * sizeof(short));
354 yyvs_sv = newSV(YYINITDEPTH * sizeof(YYSTYPE));
0de566d7
DM
355 SAVEFREESV(yyss_sv);
356 SAVEFREESV(yyvs_sv);
357 yyss = (short *) SvPVX(yyss_sv);
358 yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
9388183f
CB
359 /* note that elements zero of yyvs and yyns are not used */
360 yyssp = yyss;
361 yyvsp = yyvs;
362#ifdef DEBUGGING
561b68a9 363 yyns_sv = newSV(YYINITDEPTH * sizeof(char *));
9388183f 364 SAVEFREESV(yyns_sv);
a28509cc 365 /* XXX This seems strange to cast char * to char ** */
94a11853 366 yyns = (const char **) SvPVX(yyns_sv);
9388183f
CB
367 yynsp = yyns;
368#endif
79072805 369
0de566d7
DM
370 yystate = 0;
371 yyerrstatus = 0;
93a17b20 372 yynerrs = 0;
0de566d7
DM
373 yychar = YYEMPTY; /* Cause a token to be read. */
374
9388183f 375 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
0de566d7
DM
376
377 goto yysetstate;
378
379/*------------------------------------------------------------.
380| yynewstate -- Push a new state, which is found in yystate. |
381`------------------------------------------------------------*/
382 yynewstate:
383 /* In all cases, when you get here, the value and location stacks
384 have just been pushed. so pushing a state here evens the stacks.
385 */
386 yyssp++;
387
388 yysetstate:
389 *yyssp = yystate;
390
391 if (yyss + yystacksize - 1 <= yyssp) {
392 /* Get the current used size of the three stacks, in elements. */
df35152e 393 const YYSIZE_T yysize = yyssp - yyss + 1;
0de566d7
DM
394
395 /* Extend the stack our own way. */
396 if (YYMAXDEPTH <= yystacksize)
397 goto yyoverflowlab;
398 yystacksize *= 2;
399 if (YYMAXDEPTH < yystacksize)
400 yystacksize = YYMAXDEPTH;
401
402 SvGROW(yyss_sv, yystacksize * sizeof(short));
403 SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
404 yyss = (short *) SvPVX(yyss_sv);
405 yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
9388183f
CB
406#ifdef DEBUGGING
407 SvGROW(yyns_sv, yystacksize * sizeof(char *));
a28509cc 408 /* XXX This seems strange to cast char * to char ** */
94a11853 409 yyns = (const char **) SvPVX(yyns_sv);
9388183f
CB
410 if (! yyns)
411 goto yyoverflowlab;
412 yynsp = yyns + yysize - 1;
413#endif
0de566d7
DM
414 if (!yyss || ! yyvs)
415 goto yyoverflowlab;
416
417 yyssp = yyss + yysize - 1;
418 yyvsp = yyvs + yysize - 1;
419
420
421 YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
422 (unsigned long int) yystacksize));
423
424 if (yyss + yystacksize - 1 <= yyssp)
425 YYABORT;
93a17b20 426 }
0de566d7 427
0de566d7
DM
428 goto yybackup;
429
430 /*-----------.
431 | yybackup. |
432 `-----------*/
433 yybackup:
434
435/* Do appropriate processing given the current state. */
436/* Read a lookahead token if we need one and don't already have one. */
437/* yyresume: */
438
439 /* First try to decide what to do without reference to lookahead token. */
440
441 yyn = yypact[yystate];
442 if (yyn == YYPACT_NINF)
443 goto yydefault;
444
445 /* Not known => get a lookahead token if don't already have one. */
446
447 /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
448 if (yychar == YYEMPTY) {
449 YYDPRINTF ((Perl_debug_log, "Reading a token: "));
f05e27e5 450#ifdef PERL_IN_MADLY_C
00e74f14 451 yychar = PL_madskills ? madlex() : yylex();
f05e27e5 452#else
12fbd33b 453 yychar = yylex();
81d86705 454#endif
bc463c31 455
12fbd33b
DM
456# ifdef EBCDIC
457 if (yychar >= 0 && yychar < 255) {
458 yychar = NATIVE_TO_ASCII(yychar);
459 }
460# endif
0de566d7
DM
461 }
462
463 if (yychar <= YYEOF) {
464 yychar = yytoken = YYEOF;
465 YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
93a17b20 466 }
0de566d7
DM
467 else {
468 yytoken = YYTRANSLATE (yychar);
9388183f 469 YYDSYMPRINTF ("Next token is", yytoken, &yylval);
93a17b20 470 }
771df094 471
0de566d7
DM
472 /* If the proper action on seeing token YYTOKEN is to reduce or to
473 detect an error, take that action. */
474 yyn += yytoken;
475 if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
476 goto yydefault;
477 yyn = yytable[yyn];
478 if (yyn <= 0) {
479 if (yyn == 0 || yyn == YYTABLE_NINF)
480 goto yyerrlab;
481 yyn = -yyn;
482 goto yyreduce;
483 }
7b57b0ea 484
0de566d7
DM
485 if (yyn == YYFINAL)
486 YYACCEPT;
771df094 487
0de566d7
DM
488 /* Shift the lookahead token. */
489 YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
490
491 /* Discard the token being shifted unless it is eof. */
492 if (yychar != YYEOF)
493 yychar = YYEMPTY;
494
495 *++yyvsp = yylval;
9388183f 496#ifdef DEBUGGING
e1ec3a88 497 *++yynsp = (const char *)(yytname[yytoken]);
9388183f 498#endif
0de566d7
DM
499
500
501 /* Count tokens shifted since error; after three, turn off error
502 status. */
503 if (yyerrstatus)
504 yyerrstatus--;
505
506 yystate = yyn;
9388183f
CB
507 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
508
0de566d7
DM
509 goto yynewstate;
510
511
512 /*-----------------------------------------------------------.
513 | yydefault -- do the default action for the current state. |
514 `-----------------------------------------------------------*/
515 yydefault:
516 yyn = yydefact[yystate];
517 if (yyn == 0)
518 goto yyerrlab;
519 goto yyreduce;
520
521
522 /*-----------------------------.
523 | yyreduce -- Do a reduction. |
524 `-----------------------------*/
525 yyreduce:
526 /* yyn is the number of a rule to reduce with. */
527 yylen = yyr2[yyn];
528
529 /* If YYLEN is nonzero, implement the default value of the action:
a0288114 530 "$$ = $1".
0de566d7
DM
531
532 Otherwise, the following line sets YYVAL to garbage.
533 This behavior is undocumented and Bison
534 users should not rely upon it. Assigning to YYVAL
535 unconditionally makes the parser a bit smaller, and it avoids a
536 GCC warning that YYVAL may be used uninitialized. */
537 yyval = yyvsp[1-yylen];
538
539
540 YY_REDUCE_PRINT (yyn);
541 switch (yyn) {
542
0de566d7
DM
543
544#define dep() deprecate("\"do\" to call subroutines")
f05e27e5 545
bc463c31 546#ifdef PERL_IN_MADLY_C
f05e27e5
DM
547# define IVAL(i) (i)->tk_lval.ival
548# define PVAL(p) (p)->tk_lval.pval
549# define TOKEN_GETMAD(a,b,c) token_getmad((a),(b),(c))
550# define TOKEN_FREE(a) token_free(a)
551# define OP_GETMAD(a,b,c) op_getmad((a),(b),(c))
552# define IF_MAD(a,b) (a)
553# define DO_MAD(a) a
554# define MAD
bc463c31 555#else
f05e27e5
DM
556# define IVAL(i) (i)
557# define PVAL(p) (p)
558# define TOKEN_GETMAD(a,b,c)
559# define TOKEN_FREE(a)
560# define OP_GETMAD(a,b,c)
561# define IF_MAD(a,b) (b)
562# define DO_MAD(a)
563# undef MAD
bc463c31 564#endif
7b57b0ea 565
f05e27e5
DM
566/* contains all the rule actions; auto-generated from perly.y */
567#include "perly.act"
568
93a17b20 569 }
0de566d7
DM
570
571 yyvsp -= yylen;
572 yyssp -= yylen;
9388183f
CB
573#ifdef DEBUGGING
574 yynsp -= yylen;
575#endif
0de566d7 576
0de566d7
DM
577
578 *++yyvsp = yyval;
2af555bf
DM
579 comppad = PL_comppad;
580
9388183f 581#ifdef DEBUGGING
e1ec3a88 582 *++yynsp = (const char *)(yytname [yyr1[yyn]]);
9388183f 583#endif
0de566d7 584
a0288114 585 /* Now shift the result of the reduction. Determine what state
0de566d7
DM
586 that goes to, based on the state we popped back to and the rule
587 number reduced by. */
588
589 yyn = yyr1[yyn];
590
591 yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
592 if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
593 yystate = yytable[yystate];
93a17b20 594 else
0de566d7
DM
595 yystate = yydefgoto[yyn - YYNTOKENS];
596
9388183f
CB
597 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
598
599#ifdef DEBUGGING
600 /* tmp push yystate for stack print; this is normally pushed later in
601 * yynewstate */
602 yyssp++;
603 *yyssp = yystate;
604 YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
605 yyssp--;
606#endif
607
0de566d7
DM
608 goto yynewstate;
609
610
611 /*------------------------------------.
612 | yyerrlab -- here on detecting error |
613 `------------------------------------*/
614 yyerrlab:
615 /* If not already recovering from an error, report this error. */
616 if (!yyerrstatus) {
617 ++yynerrs;
618#if YYERROR_VERBOSE
619 yyn = yypact[yystate];
620
621 if (YYPACT_NINF < yyn && yyn < YYLAST) {
622 YYSIZE_T yysize = 0;
df35152e 623 const int yytype = YYTRANSLATE (yychar);
0de566d7
DM
624 char *yymsg;
625 int yyx, yycount;
626
627 yycount = 0;
628 /* Start YYX at -YYN if negative to avoid negative indexes in
629 YYCHECK. */
630 for (yyx = yyn < 0 ? -yyn : 0;
631 yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
632 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
633 yysize += yystrlen (yytname[yyx]) + 15, yycount++;
634 yysize += yystrlen ("syntax error, unexpected ") + 1;
635 yysize += yystrlen (yytname[yytype]);
4b711db3 636 Newx(yymsg, yysize, char *);
0de566d7 637 if (yymsg != 0) {
df35152e 638 const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
0de566d7
DM
639 yyp = yystpcpy (yyp, yytname[yytype]);
640
641 if (yycount < 5) {
642 yycount = 0;
643 for (yyx = yyn < 0 ? -yyn : 0;
644 yyx < (int) (sizeof (yytname) / sizeof (char *));
645 yyx++)
646 {
647 if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
648 const char *yyq = ! yycount ?
649 ", expecting " : " or ";
650 yyp = yystpcpy (yyp, yyq);
651 yyp = yystpcpy (yyp, yytname[yyx]);
652 yycount++;
653 }
654 }
ecb2f335 655 }
0de566d7
DM
656 yyerror (yymsg);
657 YYSTACK_FREE (yymsg);
658 }
659 else
660 yyerror ("syntax error; also virtual memory exhausted");
661 }
662 else
663#endif /* YYERROR_VERBOSE */
664 yyerror ("syntax error");
93a17b20 665 }
0de566d7
DM
666
667
668 if (yyerrstatus == 3) {
669 /* If just tried and failed to reuse lookahead token after an
670 error, discard it. */
671
672 /* Return failure if at end of input. */
673 if (yychar == YYEOF) {
674 /* Pop the error token. */
675 YYPOPSTACK;
676 /* Pop the rest of the stack. */
2af555bf 677 PAD_RESTORE_LOCAL(comppad);
0de566d7 678 while (yyss < yyssp) {
9388183f 679 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
2af555bf
DM
680 if (yy_type_tab[yystos[*yyssp]] == toketype_padval) {
681 comppad = yyvsp->padval;
682 PAD_RESTORE_LOCAL(comppad);
683 }
684 else if (yy_type_tab[yystos[*yyssp]] == toketype_opval) {
0539ab63
DM
685 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
686 op_free(yyvsp->opval);
687 }
0de566d7
DM
688 YYPOPSTACK;
689 }
690 YYABORT;
691 }
692
9388183f 693 YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
0de566d7
DM
694 yychar = YYEMPTY;
695
93a17b20 696 }
0de566d7
DM
697
698 /* Else will try to reuse lookahead token after shifting the error
699 token. */
700 goto yyerrlab1;
701
702
703 /*----------------------------------------------------.
704 | yyerrlab1 -- error raised explicitly by an action. |
705 `----------------------------------------------------*/
706 yyerrlab1:
707 yyerrstatus = 3; /* Each real token shifted decrements this. */
708
2af555bf 709 PAD_RESTORE_LOCAL(comppad);
0de566d7
DM
710 for (;;) {
711 yyn = yypact[yystate];
712 if (yyn != YYPACT_NINF) {
713 yyn += YYTERROR;
714 if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
715 yyn = yytable[yyn];
716 if (0 < yyn)
717 break;
718 }
719 }
720
721 /* Pop the current state because it cannot handle the error token. */
722 if (yyssp == yyss)
723 YYABORT;
724
9388183f 725 YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
2af555bf
DM
726 if (yy_type_tab[yystos[*yyssp]] == toketype_padval) {
727 comppad = yyvsp->padval;
728 PAD_RESTORE_LOCAL(comppad);
729 }
730 else if (yy_type_tab[yystos[*yyssp]] == toketype_opval) {
0539ab63
DM
731 YYDPRINTF ((Perl_debug_log, "(freeing op)\n"));
732 op_free(yyvsp->opval);
733 }
0de566d7 734 yyvsp--;
9388183f
CB
735#ifdef DEBUGGING
736 yynsp--;
737#endif
0de566d7
DM
738 yystate = *--yyssp;
739
9388183f 740 YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
93a17b20 741 }
0de566d7
DM
742
743 if (yyn == YYFINAL)
744 YYACCEPT;
745
746 YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
747
748 *++yyvsp = yylval;
9388183f
CB
749#ifdef DEBUGGING
750 *++yynsp ="<err>";
751#endif
0de566d7
DM
752
753 yystate = yyn;
9388183f
CB
754 YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
755
0de566d7
DM
756 goto yynewstate;
757
758
759 /*-------------------------------------.
760 | yyacceptlab -- YYACCEPT comes here. |
761 `-------------------------------------*/
762 yyacceptlab:
763 yyresult = 0;
764 goto yyreturn;
765
766 /*-----------------------------------.
767 | yyabortlab -- YYABORT comes here. |
768 `-----------------------------------*/
769 yyabortlab:
770 yyresult = 1;
771 goto yyreturn;
772
773 /*----------------------------------------------.
774 | yyoverflowlab -- parser overflow comes here. |
775 `----------------------------------------------*/
776 yyoverflowlab:
777 yyerror ("parser stack overflow");
778 yyresult = 2;
779 /* Fall through. */
780
781 yyreturn:
782
c86b7e91 783 LEAVE; /* force stack free before we return */
e1f15930 784
0de566d7 785 return yyresult;
e1f15930 786}
66610fdd
RGS
787
788/*
789 * Local variables:
790 * c-indentation-style: bsd
791 * c-basic-offset: 4
792 * indent-tabs-mode: t
793 * End:
794 *
37442d52
RGS
795 * ex: set ts=8 sts=4 sw=4 noet:
796 */