-char rcsid[] = "$Header: perly.c,v 3.0 89/10/18 15:22:21 lwall Locked $\nPatch level: ###\n";
-/*
- * Copyright (c) 1989, Larry Wall
+/* perly.c
*
- * You may distribute under the terms of the GNU General Public License
- * as specified in the README file that comes with the perl 3.0 kit.
+ * Copyright (c) 2004 Larry Wall
*
- * $Log: perly.c,v $
- * Revision 3.0 89/10/18 15:22:21 lwall
- * 3.0 baseline
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
*
+ * Note that this file was originally generated as an output from
+ * GNU bison version 1.875, but now the code is statically maintained
+ * and edited; the bits that are dependent on perly.y are now #included
+ * from the files perly.tab and perly.act.
+ *
+ * Here is an important copyright statement from the original, generated
+ * file:
+ *
+ * As a special exception, when this file is copied by Bison into a
+ * Bison output file, you may use that output file without
+ * restriction. This special exception was added by the Free
+ * Software Foundation in version 1.24 of Bison.
*/
+
+/* allow stack size to grow effectively without limit */
+#define YYMAXDEPTH 10000000
+
#include "EXTERN.h"
+#define PERL_IN_PERLY_C
#include "perl.h"
-#include "perly.h"
-#include "patchlevel.h"
-#ifdef IAMSUID
-#ifndef DOSUID
-#define DOSUID
-#endif
-#endif
+typedef signed char yysigned_char;
-#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-#ifdef DOSUID
-#undef DOSUID
-#endif
+#ifdef DEBUGGING
+# define YYDEBUG 1
+#else
+# define YYDEBUG 0
#endif
-main(argc,argv,env)
-register int argc;
-register char **argv;
-register char **env;
-{
- register STR *str;
- register char *s;
- char *index(), *strcpy(), *getenv();
- bool dosearch = FALSE;
- char **origargv = argv;
-#ifdef DOSUID
- char *validarg = "";
-#endif
+/* contains all the parser state tables; auto-generated from perly.y */
+#include "perly.tab"
-#ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
-#ifdef IAMSUID
-#undef IAMSUID
- fatal("suidperl is no longer needed since the kernel can now execute\n\
-setuid perl scripts securely.\n");
-#endif
-#endif
+# define YYSIZE_T size_t
- uid = (int)getuid();
- euid = (int)geteuid();
- gid = (int)getgid();
- egid = (int)getegid();
- if (do_undump) {
- do_undump = 0;
- loop_ptr = 0; /* start label stack again */
- goto just_doit;
- }
- (void)sprintf(index(rcsid,'#'), "%d\n", PATCHLEVEL);
- linestr = Str_new(65,80);
- str_nset(linestr,"",0);
- str = str_make("",0); /* first used for -I flags */
- curstash = defstash = hnew(0);
- curstname = str_make("main",4);
- stab_xhash(stabent("_main",TRUE)) = defstash;
- incstab = aadd(stabent("INC",TRUE));
- incstab->str_pok |= SP_MULTI;
- for (argc--,argv++; argc; argc--,argv++) {
- if (argv[0][0] != '-' || !argv[0][1])
- break;
-#ifdef DOSUID
- if (*validarg)
- validarg = " PHOOEY ";
- else
- validarg = argv[0];
-#endif
- s = argv[0]+1;
- reswitch:
- switch (*s) {
- case 'a':
- minus_a = TRUE;
- s++;
- goto reswitch;
- case 'd':
-#ifdef TAINT
- if (euid != uid || egid != gid)
- fatal("No -d allowed in setuid scripts");
-#endif
- perldb = TRUE;
- s++;
- goto reswitch;
-#ifdef DEBUGGING
- case 'D':
-#ifdef TAINT
- if (euid != uid || egid != gid)
- fatal("No -D allowed in setuid scripts");
-#endif
- debug = atoi(s+1);
-#ifdef YYDEBUG
- yydebug = (debug & 1);
-#endif
- break;
-#endif
- case 'e':
-#ifdef TAINT
- if (euid != uid || egid != gid)
- fatal("No -e allowed in setuid scripts");
-#endif
- if (!e_fp) {
- e_tmpname = savestr(TMPPATH);
- (void)mktemp(e_tmpname);
- e_fp = fopen(e_tmpname,"w");
- }
- if (argv[1])
- fputs(argv[1],e_fp);
- (void)putc('\n', e_fp);
- argc--,argv++;
- break;
- case 'i':
- inplace = savestr(s+1);
- argvoutstab = stabent("ARGVOUT",TRUE);
- break;
- case 'I':
-#ifdef TAINT
- if (euid != uid || egid != gid)
- fatal("No -I allowed in setuid scripts");
-#endif
- str_cat(str,"-");
- str_cat(str,s);
- str_cat(str," ");
- if (*++s) {
- (void)apush(stab_array(incstab),str_make(s,0));
- }
- else {
- (void)apush(stab_array(incstab),str_make(argv[1],0));
- str_cat(str,argv[1]);
- argc--,argv++;
- str_cat(str," ");
- }
- break;
- case 'n':
- minus_n = TRUE;
- s++;
- goto reswitch;
- case 'p':
- minus_p = TRUE;
- s++;
- goto reswitch;
- case 'P':
-#ifdef TAINT
- if (euid != uid || egid != gid)
- fatal("No -P allowed in setuid scripts");
-#endif
- preprocess = TRUE;
- s++;
- goto reswitch;
- case 's':
-#ifdef TAINT
- if (euid != uid || egid != gid)
- fatal("No -s allowed in setuid scripts");
-#endif
- doswitches = TRUE;
- s++;
- goto reswitch;
- case 'S':
- dosearch = TRUE;
- s++;
- goto reswitch;
- case 'u':
- do_undump = TRUE;
- s++;
- goto reswitch;
- case 'U':
- unsafe = TRUE;
- s++;
- goto reswitch;
- case 'v':
- fputs(rcsid,stdout);
- fputs("\nCopyright (c) 1989, Larry Wall\n\n\
-Perl may be copied only under the terms of the GNU General Public License,\n\
-a copy of which can be found with the Perl 3.0 distribution kit.\n",stdout);
- exit(0);
- case 'w':
- dowarn = TRUE;
- s++;
- goto reswitch;
- case '-':
- argc--,argv++;
- goto switch_end;
- case 0:
- break;
- default:
- fatal("Unrecognized switch: -%s",s);
- }
- }
- switch_end:
- if (e_fp) {
- (void)fclose(e_fp);
- argc++,argv--;
- argv[0] = e_tmpname;
- }
-#ifndef PRIVLIB
-#define PRIVLIB "/usr/local/lib/perl"
-#endif
- (void)apush(stab_array(incstab),str_make(PRIVLIB,0));
-
- str_set(&str_no,No);
- str_set(&str_yes,Yes);
-
- /* open script */
-
- if (argv[0] == Nullch)
- argv[0] = "-";
- if (dosearch && !index(argv[0], '/') && (s = getenv("PATH"))) {
- char *xfound = Nullch, *xfailed = Nullch;
- int len;
-
- bufend = s + strlen(s);
- while (*s) {
- s = cpytill(tokenbuf,s,bufend,':',&len);
- if (*s)
- s++;
- if (len)
- (void)strcat(tokenbuf+len,"/");
- (void)strcat(tokenbuf+len,argv[0]);
+#define yyerrok (yyerrstatus = 0)
+#define yyclearin (yychar = YYEMPTY)
+#define YYEMPTY (-2)
+#define YYEOF 0
+
+#define YYACCEPT goto yyacceptlab
+#define YYABORT goto yyabortlab
+#define YYERROR goto yyerrlab1
+
+
+/* Like YYERROR except do call yyerror. This remains here temporarily
+ to ease the transition to the new meaning of YYERROR, for GCC.
+ Once GCC version 2 has supplanted version 1, this can go. */
+
+#define YYFAIL goto yyerrlab
+
+#define YYRECOVERING() (!!yyerrstatus)
+
+#define YYBACKUP(Token, Value) \
+do \
+ if (yychar == YYEMPTY && yylen == 1) { \
+ yychar = (Token); \
+ yylval = (Value); \
+ yytoken = YYTRANSLATE (yychar); \
+ YYPOPSTACK; \
+ goto yybackup; \
+ } \
+ else { \
+ yyerror ("syntax error: cannot back up"); \
+ YYERROR; \
+ } \
+while (0)
+
+#define YYTERROR 1
+#define YYERRCODE 256
+
+/* Enable debugging if requested. */
#ifdef DEBUGGING
- if (debug & 1)
- fprintf(stderr,"Looking for %s\n",tokenbuf);
-#endif
- if (stat(tokenbuf,&statbuf) < 0) /* not there? */
- continue;
- if ((statbuf.st_mode & S_IFMT) == S_IFREG
- && cando(S_IREAD,TRUE,&statbuf) && cando(S_IEXEC,TRUE,&statbuf)) {
- xfound = tokenbuf; /* bingo! */
- break;
- }
- if (!xfailed)
- xfailed = savestr(tokenbuf);
- }
- if (!xfound)
- fatal("Can't execute %s", xfailed ? xfailed : argv[0] );
- if (xfailed)
- Safefree(xfailed);
- argv[0] = savestr(xfound);
- }
- pidstatary = anew(Nullstab); /* for remembering popen pids, status */
-
- filename = savestr(argv[0]);
- origfilename = savestr(filename);
- if (strEQ(filename,"-"))
- argv[0] = "";
- if (preprocess) {
- str_cat(str,"-I");
- str_cat(str,PRIVLIB);
- (void)sprintf(buf, "\
-/bin/sed -e '/^[^#]/b' \
- -e '/^#[ ]*include[ ]/b' \
- -e '/^#[ ]*define[ ]/b' \
- -e '/^#[ ]*if[ ]/b' \
- -e '/^#[ ]*ifdef[ ]/b' \
- -e '/^#[ ]*ifndef[ ]/b' \
- -e '/^#[ ]*else/b' \
- -e '/^#[ ]*endif/b' \
- -e 's/^#.*//' \
- %s | %s -C %s %s",
- argv[0], CPPSTDIN, str_get(str), CPPMINUS);
-#ifdef IAMSUID /* actually, this is caught earlier */
- if (euid != uid && !euid) /* if running suidperl */
-#ifdef SETEUID
- (void)seteuid(uid); /* musn't stay setuid root */
-#else
-#ifdef SETREUID
- (void)setreuid(-1, uid);
-#else
- setuid(uid);
-#endif
-#endif
-#endif /* IAMSUID */
- rsfp = mypopen(buf,"r");
+# define yydebug (DEBUG_p_TEST)
+
+# define YYFPRINTF PerlIO_printf
+
+# define YYDPRINTF(Args) \
+do { \
+ if (yydebug) \
+ YYFPRINTF Args; \
+} while (0)
+
+# define YYDSYMPRINT(Args) \
+do { \
+ if (yydebug) \
+ yysymprint Args; \
+} while (0)
+
+# define YYDSYMPRINTF(Title, Token, Value) \
+do { \
+ if (yydebug) { \
+ YYFPRINTF (Perl_debug_log, "%s ", Title); \
+ yysymprint (aTHX_ Perl_debug_log, Token, Value); \
+ YYFPRINTF (Perl_debug_log, "\n"); \
+ } \
+} while (0)
+
+/*--------------------------------.
+| Print this symbol on YYOUTPUT. |
+`--------------------------------*/
+
+static void
+yysymprint (pTHX_ PerlIO *yyoutput, int yytype, const YYSTYPE *yyvaluep)
+{
+ if (yytype < YYNTOKENS) {
+ YYFPRINTF (yyoutput, "token %s (", yytname[yytype]);
+# ifdef YYPRINT
+ YYPRINT (yyoutput, yytoknum[yytype], *yyvaluep);
+# else
+ YYFPRINTF (yyoutput, "0x%"UVxf, (UV)yyvaluep->ival);
+# endif
}
- else if (!*argv[0])
- rsfp = stdin;
else
- rsfp = fopen(argv[0],"r");
- if (rsfp == Nullfp) {
- extern char *sys_errlist[];
- extern int errno;
-
-#ifdef DOSUID
-#ifndef IAMSUID /* in case script is not readable before setuid */
- if (euid && stat(filename,&statbuf) >= 0 &&
- statbuf.st_mode & (S_ISUID|S_ISGID)) {
- (void)sprintf(buf, "%s/%s", BIN, "suidperl");
- execv(buf, origargv); /* try again */
- fatal("Can't do setuid\n");
- }
-#endif
-#endif
- fatal("Can't open perl script \"%s\": %s\n",
- filename, sys_errlist[errno]);
+ YYFPRINTF (yyoutput, "nterm %s (", yytname[yytype]);
+
+ YYFPRINTF (yyoutput, ")");
+}
+
+
+/* yy_stack_print()
+ * print the top 8 items on the parse stack. The args have the same
+ * meanings as the local vars in yyparse() of the same name */
+
+static void
+yy_stack_print (pTHX_ const short *yyss, const short *yyssp, const YYSTYPE *yyvs, const char**yyns)
+{
+ int i;
+ int start = 1;
+ int count = (int)(yyssp - yyss);
+
+ if (count > 8) {
+ start = count - 8 + 1;
+ count = 8;
}
- str_free(str); /* free -I directories */
-
- /* do we need to emulate setuid on scripts? */
-
- /* This code is for those BSD systems that have setuid #! scripts disabled
- * in the kernel because of a security problem. Merely defining DOSUID
- * in perl will not fix that problem, but if you have disabled setuid
- * scripts in the kernel, this will attempt to emulate setuid and setgid
- * on scripts that have those now-otherwise-useless bits set. The setuid
- * root version must be called suidperl. If regular perl discovers that
- * it has opened a setuid script, it calls suidperl with the same argv
- * that it had. If suidperl finds that the script it has just opened
- * is NOT setuid root, it sets the effective uid back to the uid. We
- * don't just make perl setuid root because that loses the effective
- * uid we had before invoking perl, if it was different from the uid.
- *
- * DOSUID must be defined in both perl and suidperl, and IAMSUID must
- * be defined in suidperl only. suidperl must be setuid root. The
- * Configure script will set this up for you if you want it.
- *
- * There is also the possibility of have a script which is running
- * set-id due to a C wrapper. We want to do the TAINT checks
- * on these set-id scripts, but don't want to have the overhead of
- * them in normal perl, and can't use suidperl because it will lose
- * the effective uid info, so we have an additional non-setuid root
- * version called taintperl that just does the TAINT checks.
- */
-
-#ifdef DOSUID
- if (fstat(fileno(rsfp),&statbuf) < 0) /* normal stat is insecure */
- fatal("Can't stat script \"%s\"",filename);
- if (statbuf.st_mode & (S_ISUID|S_ISGID)) {
- int len;
-
-#ifdef IAMSUID
-#ifndef SETREUID
- /* On this access check to make sure the directories are readable,
- * there is actually a small window that the user could use to make
- * filename point to an accessible directory. So there is a faint
- * chance that someone could execute a setuid script down in a
- * non-accessible directory. I don't know what to do about that.
- * But I don't think it's too important. The manual lies when
- * it says access() is useful in setuid programs.
- */
- if (access(filename,1)) /* as a double check */
- fatal("Permission denied");
-#else
- /* If we can swap euid and uid, then we can determine access rights
- * with a simple stat of the file, and then compare device and
- * inode to make sure we did stat() on the same file we opened.
- * Then we just have to make sure he or she can execute it.
- */
- {
- struct stat tmpstatbuf;
-
- if (setreuid(euid,uid) < 0 || getuid() != euid || geteuid() != uid)
- fatal("Can't swap uid and euid"); /* really paranoid */
- if (stat(filename,&tmpstatbuf) < 0) /* testing full pathname here */
- fatal("Permission denied");
- if (tmpstatbuf.st_dev != statbuf.st_dev ||
- tmpstatbuf.st_ino != statbuf.st_ino) {
- (void)fclose(rsfp);
- if (rsfp = mypopen("/bin/mail root","w")) { /* heh, heh */
- fprintf(rsfp,
-"User %d tried to run dev %d ino %d in place of dev %d ino %d!\n\
-(Filename of set-id script was %s, uid %d gid %d.)\n\nSincerely,\nperl\n",
- uid,tmpstatbuf.st_dev, tmpstatbuf.st_ino,
- statbuf.st_dev, statbuf.st_ino,
- filename, statbuf.st_uid, statbuf.st_gid);
- (void)mypclose(rsfp);
- }
- fatal("Permission denied\n");
- }
- if (setreuid(uid,euid) < 0 || getuid() != uid || geteuid() != euid)
- fatal("Can't reswap uid and euid");
- if (!cando(S_IEXEC,FALSE,&statbuf)) /* can real uid exec? */
- fatal("Permission denied\n");
- }
-#endif /* SETREUID */
-#endif /* IAMSUID */
-
- if ((statbuf.st_mode & S_IFMT) != S_IFREG)
- fatal("Permission denied");
- if ((statbuf.st_mode >> 6) & S_IWRITE)
- fatal("Setuid/gid script is writable by world");
- doswitches = FALSE; /* -s is insecure in suid */
- line++;
- if (fgets(tokenbuf,sizeof tokenbuf, rsfp) == Nullch ||
- strnNE(tokenbuf,"#!",2) ) /* required even on Sys V */
- fatal("No #! line");
- for (s = tokenbuf+2; !isspace(*s); s++) ;
- if (strnNE(s-4,"perl",4)) /* sanity check */
- fatal("Not a perl script");
- while (*s == ' ' || *s == '\t') s++;
- /*
- * #! arg must be what we saw above. They can invoke it by
- * mentioning suidperl explicitly, but they may not add any strange
- * arguments beyond what #! says if they do invoke suidperl that way.
- */
- len = strlen(validarg);
- if (strEQ(validarg," PHOOEY ") ||
- strnNE(s,validarg,len) || !isspace(s[len]))
- fatal("Args must match #! line");
-
-#ifndef IAMSUID
- if (euid != uid && (statbuf.st_mode & S_ISUID) &&
- euid == statbuf.st_uid)
- if (!do_undump)
- fatal("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
-FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
-#endif /* IAMSUID */
-
- if (euid) { /* oops, we're not the setuid root perl */
- (void)fclose(rsfp);
-#ifndef IAMSUID
- (void)sprintf(buf, "%s/%s", BIN, "suidperl");
- execv(buf, origargv); /* try again */
+
+ PerlIO_printf(Perl_debug_log, "\nindex:");
+ for (i=0; i < count; i++)
+ PerlIO_printf(Perl_debug_log, " %8d", start+i);
+ PerlIO_printf(Perl_debug_log, "\nstate:");
+ for (i=0, yyss += start; i < count; i++, yyss++)
+ PerlIO_printf(Perl_debug_log, " %8d", *yyss);
+ PerlIO_printf(Perl_debug_log, "\ntoken:");
+ for (i=0, yyns += start; i < count; i++, yyns++)
+ PerlIO_printf(Perl_debug_log, " %8.8s", *yyns);
+ PerlIO_printf(Perl_debug_log, "\nvalue:");
+ for (i=0, yyvs += start; i < count; i++, yyvs++)
+ PerlIO_printf(Perl_debug_log, " %8"UVxf, (UV)yyvs->ival);
+ PerlIO_printf(Perl_debug_log, "\n\n");
+}
+
+# define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns) \
+do { \
+ if (yydebug && DEBUG_v_TEST) \
+ yy_stack_print (aTHX_ (yyss), (yyssp), (yyvs), (yyns)); \
+} while (0)
+
+
+/*------------------------------------------------.
+| Report that the YYRULE is going to be reduced. |
+`------------------------------------------------*/
+
+static void
+yy_reduce_print (pTHX_ int yyrule)
+{
+ int yyi;
+ const unsigned int yylineno = yyrline[yyrule];
+ YYFPRINTF (Perl_debug_log, "Reducing stack by rule %d (line %u), ",
+ yyrule - 1, yylineno);
+ /* Print the symbols being reduced, and their result. */
+ for (yyi = yyprhs[yyrule]; 0 <= yyrhs[yyi]; yyi++)
+ YYFPRINTF (Perl_debug_log, "%s ", yytname [yyrhs[yyi]]);
+ YYFPRINTF (Perl_debug_log, "-> %s\n", yytname [yyr1[yyrule]]);
+}
+
+# define YY_REDUCE_PRINT(Rule) \
+do { \
+ if (yydebug) \
+ yy_reduce_print (aTHX_ Rule); \
+} while (0)
+
+#else /* !DEBUGGING */
+# define YYDPRINTF(Args)
+# define YYDSYMPRINT(Args)
+# define YYDSYMPRINTF(Title, Token, Value)
+# define YY_STACK_PRINT(yyss, yyssp, yyvs, yyns)
+# define YY_REDUCE_PRINT(Rule)
+#endif /* !DEBUGGING */
+
+
+/* YYINITDEPTH -- initial size of the parser's stacks. */
+#ifndef YYINITDEPTH
+# define YYINITDEPTH 200
#endif
- fatal("Can't do setuid\n");
- }
- if (statbuf.st_mode & S_ISGID && statbuf.st_gid != getegid())
-#ifdef SETEGID
- (void)setegid(statbuf.st_gid);
-#else
-#ifdef SETREGID
- (void)setregid((GIDTYPE)-1,statbuf.st_gid);
+
+#if YYERROR_VERBOSE
+# ifndef yystrlen
+# if defined (__GLIBC__) && defined (_STRING_H)
+# define yystrlen strlen
+# else
+/* Return the length of YYSTR. */
+static YYSIZE_T
+yystrlen (const char *yystr)
+{
+ register const char *yys = yystr;
+
+ while (*yys++ != '\0')
+ continue;
+
+ return yys - yystr - 1;
+}
+# endif
+# endif
+
+# ifndef yystpcpy
+# if defined (__GLIBC__) && defined (_STRING_H) && defined (_GNU_SOURCE)
+# define yystpcpy stpcpy
+# else
+/* Copy YYSRC to YYDEST, returning the address of the terminating '\0' in
+ YYDEST. */
+static char *
+yystpcpy (pTHX_ char *yydest, const char *yysrc)
+{
+ register char *yyd = yydest;
+ register const char *yys = yysrc;
+
+ while ((*yyd++ = *yys++) != '\0')
+ continue;
+
+ return yyd - 1;
+}
+# endif
+# endif
+
+#endif /* !YYERROR_VERBOSE */
+
+/*----------.
+| yyparse. |
+`----------*/
+
+int
+Perl_yyparse (pTHX)
+{
+ int yychar; /* The lookahead symbol. */
+ YYSTYPE yylval; /* The semantic value of the lookahead symbol. */
+ int yynerrs; /* Number of syntax errors so far. */
+ register int yystate;
+ register int yyn;
+ int yyresult;
+
+ /* Number of tokens to shift before error messages enabled. */
+ int yyerrstatus;
+ /* Lookahead token as an internal (translated) token number. */
+ int yytoken = 0;
+
+ /* two stacks and their tools:
+ yyss: related to states,
+ yyvs: related to semantic values,
+
+ Refer to the stacks thru separate pointers, to allow yyoverflow
+ to reallocate them elsewhere. */
+
+ /* The state stack. */
+ short *yyss;
+ register short *yyssp;
+
+ /* The semantic value stack. */
+ YYSTYPE *yyvs;
+ register YYSTYPE *yyvsp;
+
+ /* for ease of re-allocation and automatic freeing, have two SVs whose
+ * SvPVX points to the stacks */
+ SV *yyss_sv, *yyvs_sv;
+
+#ifdef DEBUGGING
+ /* maintain also a stack of token/rule names for debugging with -Dpv */
+ const char **yyns, **yynsp;
+ SV *yyns_sv;
+# define YYPOPSTACK (yyvsp--, yyssp--, yynsp--)
#else
- setgid(statbuf.st_gid);
+# define YYPOPSTACK (yyvsp--, yyssp--)
#endif
+
+
+ YYSIZE_T yystacksize = YYINITDEPTH;
+
+ /* The variables used to return semantic value and location from the
+ action routines. */
+ YYSTYPE yyval;
+
+
+ /* When reducing, the number of symbols on the RHS of the reduced
+ rule. */
+ int yylen;
+
+ YYDPRINTF ((Perl_debug_log, "Starting parse\n"));
+
+ ENTER; /* force stack free before we return */
+ SAVEVPTR(PL_yycharp);
+ SAVEVPTR(PL_yylvalp);
+ PL_yycharp = &yychar; /* so PL_yyerror() can access it */
+ PL_yylvalp = &yylval; /* so various functions in toke.c can access it */
+
+ yyss_sv = NEWSV(73, YYINITDEPTH * sizeof(short));
+ yyvs_sv = NEWSV(73, YYINITDEPTH * sizeof(YYSTYPE));
+ SAVEFREESV(yyss_sv);
+ SAVEFREESV(yyvs_sv);
+ yyss = (short *) SvPVX(yyss_sv);
+ yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
+ /* note that elements zero of yyvs and yyns are not used */
+ yyssp = yyss;
+ yyvsp = yyvs;
+#ifdef DEBUGGING
+ yyns_sv = NEWSV(73, YYINITDEPTH * sizeof(char *));
+ SAVEFREESV(yyns_sv);
+ /* XXX This seems strange to cast char * to char ** */
+ yyns = (const char **) SvPVX(yyns_sv);
+ yynsp = yyns;
#endif
- if (statbuf.st_mode & S_ISUID) {
- if (statbuf.st_uid != euid)
-#ifdef SETEUID
- (void)seteuid(statbuf.st_uid); /* all that for this */
-#else
-#ifdef SETREUID
- (void)setreuid((UIDTYPE)-1,statbuf.st_uid);
-#else
- setuid(statbuf.st_uid);
-#endif
+
+ yystate = 0;
+ yyerrstatus = 0;
+ yynerrs = 0;
+ yychar = YYEMPTY; /* Cause a token to be read. */
+
+
+
+ YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
+
+ goto yysetstate;
+
+/*------------------------------------------------------------.
+| yynewstate -- Push a new state, which is found in yystate. |
+`------------------------------------------------------------*/
+ yynewstate:
+ /* In all cases, when you get here, the value and location stacks
+ have just been pushed. so pushing a state here evens the stacks.
+ */
+ yyssp++;
+
+ yysetstate:
+ *yyssp = yystate;
+
+ if (yyss + yystacksize - 1 <= yyssp) {
+ /* Get the current used size of the three stacks, in elements. */
+ const YYSIZE_T yysize = yyssp - yyss + 1;
+
+ /* Extend the stack our own way. */
+ if (YYMAXDEPTH <= yystacksize)
+ goto yyoverflowlab;
+ yystacksize *= 2;
+ if (YYMAXDEPTH < yystacksize)
+ yystacksize = YYMAXDEPTH;
+
+ SvGROW(yyss_sv, yystacksize * sizeof(short));
+ SvGROW(yyvs_sv, yystacksize * sizeof(YYSTYPE));
+ yyss = (short *) SvPVX(yyss_sv);
+ yyvs = (YYSTYPE *) SvPVX(yyvs_sv);
+#ifdef DEBUGGING
+ SvGROW(yyns_sv, yystacksize * sizeof(char *));
+ /* XXX This seems strange to cast char * to char ** */
+ yyns = (const char **) SvPVX(yyns_sv);
+ if (! yyns)
+ goto yyoverflowlab;
+ yynsp = yyns + yysize - 1;
#endif
+ if (!yyss || ! yyvs)
+ goto yyoverflowlab;
+
+ yyssp = yyss + yysize - 1;
+ yyvsp = yyvs + yysize - 1;
+
+
+ YYDPRINTF ((Perl_debug_log, "Stack size increased to %lu\n",
+ (unsigned long int) yystacksize));
+
+ if (yyss + yystacksize - 1 <= yyssp)
+ YYABORT;
+ }
+
+ goto yybackup;
+
+ /*-----------.
+ | yybackup. |
+ `-----------*/
+ yybackup:
+
+/* Do appropriate processing given the current state. */
+/* Read a lookahead token if we need one and don't already have one. */
+/* yyresume: */
+
+ /* First try to decide what to do without reference to lookahead token. */
+
+ yyn = yypact[yystate];
+ if (yyn == YYPACT_NINF)
+ goto yydefault;
+
+ /* Not known => get a lookahead token if don't already have one. */
+
+ /* YYCHAR is either YYEMPTY or YYEOF or a valid lookahead symbol. */
+ if (yychar == YYEMPTY) {
+ YYDPRINTF ((Perl_debug_log, "Reading a token: "));
+ yychar = yylex();
+# ifdef EBCDIC
+ if (yychar >= 0 && yychar < 255) {
+ yychar = NATIVE_TO_ASCII(yychar);
}
- else if (uid) /* oops, mustn't run as root */
-#ifdef SETEUID
- (void)seteuid((UIDTYPE)uid);
-#else
-#ifdef SETREUID
- (void)setreuid((UIDTYPE)-1,(UIDTYPE)uid);
-#else
- setuid((UIDTYPE)uid);
-#endif
-#endif
- euid = (int)geteuid();
- if (!cando(S_IEXEC,TRUE,&statbuf))
- fatal("Permission denied\n"); /* they can't do this */
+# endif
}
-#ifdef IAMSUID
- else if (preprocess)
- fatal("-P not allowed for setuid/setgid script\n");
- else
- fatal("Script is not setuid/setgid in suidperl\n");
-#else
-#ifndef TAINT /* we aren't taintperl or suidperl */
- /* script has a wrapper--can't run suidperl or we lose euid */
- else if (euid != uid || egid != gid) {
- (void)fclose(rsfp);
- (void)sprintf(buf, "%s/%s", BIN, "taintperl");
- execv(buf, origargv); /* try again */
- fatal("Can't run setuid script with taint checks");
+
+ if (yychar <= YYEOF) {
+ yychar = yytoken = YYEOF;
+ YYDPRINTF ((Perl_debug_log, "Now at end of input.\n"));
}
-#endif /* TAINT */
-#endif /* IAMSUID */
-#else /* !DOSUID */
-#ifndef TAINT /* we aren't taintperl or suidperl */
- if (euid != uid || egid != gid) { /* (suidperl doesn't exist, in fact) */
-#ifndef SETUID_SCRIPTS_ARE_SECURE_NOW
- fstat(fileno(rsfp),&statbuf); /* may be either wrapped or real suid */
- if ((euid != uid && euid == statbuf.st_uid && statbuf.st_mode & S_ISUID)
- ||
- (egid != gid && egid == statbuf.st_gid && statbuf.st_mode & S_ISGID)
- )
- if (!do_undump)
- fatal("YOU HAVEN'T DISABLED SET-ID SCRIPTS IN THE KERNEL YET!\n\
-FIX YOUR KERNEL, PUT A C WRAPPER AROUND THIS SCRIPT, OR USE -u AND UNDUMP!\n");
-#endif /* SETUID_SCRIPTS_ARE_SECURE_NOW */
- /* not set-id, must be wrapped */
- (void)fclose(rsfp);
- (void)sprintf(buf, "%s/%s", BIN, "taintperl");
- execv(buf, origargv); /* try again */
- fatal("Can't run setuid script with taint checks");
+ else {
+ yytoken = YYTRANSLATE (yychar);
+ YYDSYMPRINTF ("Next token is", yytoken, &yylval);
}
-#endif /* TAINT */
-#endif /* DOSUID */
-
- defstab = stabent("_",TRUE);
-
- if (perldb) {
- debstash = hnew(0);
- stab_xhash(stabent("_DB",TRUE)) = debstash;
- curstash = debstash;
- lineary = stab_xarray(aadd((tmpstab = stabent("line",TRUE))));
- tmpstab->str_pok |= SP_MULTI;
- subname = str_make("main",4);
- DBstab = stabent("DB",TRUE);
- DBstab->str_pok |= SP_MULTI;
- DBsub = hadd(tmpstab = stabent("sub",TRUE));
- tmpstab->str_pok |= SP_MULTI;
- DBsingle = stab_val((tmpstab = stabent("single",TRUE)));
- tmpstab->str_pok |= SP_MULTI;
- curstash = defstash;
+
+ /* If the proper action on seeing token YYTOKEN is to reduce or to
+ detect an error, take that action. */
+ yyn += yytoken;
+ if (yyn < 0 || YYLAST < yyn || yycheck[yyn] != yytoken)
+ goto yydefault;
+ yyn = yytable[yyn];
+ if (yyn <= 0) {
+ if (yyn == 0 || yyn == YYTABLE_NINF)
+ goto yyerrlab;
+ yyn = -yyn;
+ goto yyreduce;
}
- /* init tokener */
+ if (yyn == YYFINAL)
+ YYACCEPT;
- bufend = bufptr = str_get(linestr);
+ /* Shift the lookahead token. */
+ YYDPRINTF ((Perl_debug_log, "Shifting token %s, ", yytname[yytoken]));
- savestack = anew(Nullstab); /* for saving non-local values */
- stack = anew(Nullstab); /* for saving non-local values */
- stack->ary_flags = 0; /* not a real array */
+ /* Discard the token being shifted unless it is eof. */
+ if (yychar != YYEOF)
+ yychar = YYEMPTY;
- /* now parse the script */
+ *++yyvsp = yylval;
+#ifdef DEBUGGING
+ *++yynsp = (const char *)(yytname[yytoken]);
+#endif
- error_count = 0;
- if (yyparse() || error_count)
- fatal("Execution aborted due to compilation errors.\n");
- New(50,loop_stack,128,struct loop);
- New(51,debname,128,char);
- New(52,debdelim,128,char);
- curstash = defstash;
+ /* Count tokens shifted since error; after three, turn off error
+ status. */
+ if (yyerrstatus)
+ yyerrstatus--;
- preprocess = FALSE;
- if (e_fp) {
- e_fp = Nullfp;
- (void)UNLINK(e_tmpname);
- }
+ yystate = yyn;
+ YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
- /* initialize everything that won't change if we undump */
+ goto yynewstate;
- if (sigstab = stabent("SIG",allstabs)) {
- sigstab->str_pok |= SP_MULTI;
- (void)hadd(sigstab);
- }
- magicalize("!#?^~=-%0123456789.+&*()<>,\\/[|`':");
+ /*-----------------------------------------------------------.
+ | yydefault -- do the default action for the current state. |
+ `-----------------------------------------------------------*/
+ yydefault:
+ yyn = yydefact[yystate];
+ if (yyn == 0)
+ goto yyerrlab;
+ goto yyreduce;
- amperstab = stabent("&",allstabs);
- leftstab = stabent("`",allstabs);
- rightstab = stabent("'",allstabs);
- sawampersand = (amperstab || leftstab || rightstab);
- if (tmpstab = stabent(":",allstabs))
- str_set(STAB_STR(tmpstab),chopset);
- /* these aren't necessarily magical */
- if (tmpstab = stabent(";",allstabs))
- str_set(STAB_STR(tmpstab),"\034");
-#ifdef TAINT
- tainted = 1;
-#endif
- if (tmpstab = stabent("0",allstabs))
- str_set(STAB_STR(tmpstab),origfilename);
-#ifdef TAINT
- tainted = 0;
-#endif
- if (tmpstab = stabent("]",allstabs))
- str_set(STAB_STR(tmpstab),rcsid);
- str_nset(stab_val(stabent("\"", TRUE)), " ", 1);
-
- stdinstab = stabent("STDIN",TRUE);
- stdinstab->str_pok |= SP_MULTI;
- stab_io(stdinstab) = stio_new();
- stab_io(stdinstab)->ifp = stdin;
- tmpstab = stabent("stdin",TRUE);
- stab_io(tmpstab) = stab_io(stdinstab);
- tmpstab->str_pok |= SP_MULTI;
-
- tmpstab = stabent("STDOUT",TRUE);
- tmpstab->str_pok |= SP_MULTI;
- stab_io(tmpstab) = stio_new();
- stab_io(tmpstab)->ofp = stab_io(tmpstab)->ifp = stdout;
- defoutstab = tmpstab;
- tmpstab = stabent("stdout",TRUE);
- stab_io(tmpstab) = stab_io(defoutstab);
- tmpstab->str_pok |= SP_MULTI;
-
- curoutstab = stabent("STDERR",TRUE);
- curoutstab->str_pok |= SP_MULTI;
- stab_io(curoutstab) = stio_new();
- stab_io(curoutstab)->ofp = stab_io(curoutstab)->ifp = stderr;
- tmpstab = stabent("stderr",TRUE);
- stab_io(tmpstab) = stab_io(curoutstab);
- tmpstab->str_pok |= SP_MULTI;
- curoutstab = defoutstab; /* switch back to STDOUT */
-
- statname = Str_new(66,0); /* last filename we did stat on */
-
- perldb = FALSE; /* don't try to instrument evals */
-
- if (dowarn) {
- stab_check('A','Z');
- stab_check('a','z');
- }
+ /*-----------------------------.
+ | yyreduce -- Do a reduction. |
+ `-----------------------------*/
+ yyreduce:
+ /* yyn is the number of a rule to reduce with. */
+ yylen = yyr2[yyn];
- if (do_undump)
- abort();
+ /* If YYLEN is nonzero, implement the default value of the action:
+ "$$ = $1".
+
+ Otherwise, the following line sets YYVAL to garbage.
+ This behavior is undocumented and Bison
+ users should not rely upon it. Assigning to YYVAL
+ unconditionally makes the parser a bit smaller, and it avoids a
+ GCC warning that YYVAL may be used uninitialized. */
+ yyval = yyvsp[1-yylen];
+
+
+ YY_REDUCE_PRINT (yyn);
+ switch (yyn) {
+
+/* contains all the rule actions; auto-generated from perly.y */
+
+#define dep() deprecate("\"do\" to call subroutines")
+#include "perly.act"
- just_doit: /* come here if running an undumped a.out */
- argc--,argv++; /* skip name of script */
- if (doswitches) {
- for (; argc > 0 && **argv == '-'; argc--,argv++) {
- if (argv[0][1] == '-') {
- argc--,argv++;
- break;
- }
- str_numset(stab_val(stabent(argv[0]+1,TRUE)),(double)1.0);
- }
- }
-#ifdef TAINT
- tainted = 1;
-#endif
- if (argvstab = stabent("ARGV",allstabs)) {
- argvstab->str_pok |= SP_MULTI;
- (void)aadd(argvstab);
- for (; argc > 0; argc--,argv++) {
- (void)apush(stab_array(argvstab),str_make(argv[0],0));
- }
- }
-#ifdef TAINT
- (void) stabent("ENV",TRUE); /* must test PATH and IFS */
-#endif
- if (envstab = stabent("ENV",allstabs)) {
- envstab->str_pok |= SP_MULTI;
- (void)hadd(envstab);
- for (; *env; env++) {
- if (!(s = index(*env,'=')))
- continue;
- *s++ = '\0';
- str = str_make(s--,0);
- str_magic(str, envstab, 'E', *env, s - *env);
- (void)hstore(stab_hash(envstab), *env, s - *env, str, 0);
- *s = '=';
- }
}
-#ifdef TAINT
- tainted = 0;
+
+ yyvsp -= yylen;
+ yyssp -= yylen;
+#ifdef DEBUGGING
+ yynsp -= yylen;
#endif
- if (tmpstab = stabent("$",allstabs))
- str_numset(STAB_STR(tmpstab),(double)getpid());
- if (setjmp(top_env)) /* sets goto_targ on longjump */
- loop_ptr = 0; /* start label stack again */
+ *++yyvsp = yyval;
#ifdef DEBUGGING
- if (debug & 1024)
- dump_all();
- if (debug)
- fprintf(stderr,"\nEXECUTING...\n\n");
+ *++yynsp = (const char *)(yytname [yyr1[yyn]]);
#endif
- /* do it */
-
- (void) cmd_exec(main_root,G_SCALAR,-1);
+ /* Now shift the result of the reduction. Determine what state
+ that goes to, based on the state we popped back to and the rule
+ number reduced by. */
- if (goto_targ)
- fatal("Can't find label \"%s\"--aborting",goto_targ);
- exit(0);
- /* NOTREACHED */
-}
+ yyn = yyr1[yyn];
-magicalize(list)
-register char *list;
-{
- register STAB *stab;
- char sym[2];
-
- sym[1] = '\0';
- while (*sym = *list++) {
- if (stab = stabent(sym,allstabs)) {
- stab_flags(stab) = SF_VMAGIC;
- str_magic(stab_val(stab), stab, 0, Nullch, 0);
- }
- }
-}
+ yystate = yypgoto[yyn - YYNTOKENS] + *yyssp;
+ if (0 <= yystate && yystate <= YYLAST && yycheck[yystate] == *yyssp)
+ yystate = yytable[yystate];
+ else
+ yystate = yydefgoto[yyn - YYNTOKENS];
-/* this routine is in perly.c by virtue of being sort of an alternate main() */
+ YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
-int
-do_eval(str,optype,stash,gimme,arglast)
-STR *str;
-int optype;
-HASH *stash;
-int gimme;
-int *arglast;
-{
- STR **st = stack->ary_array;
- int retval;
- CMD *myroot;
- ARRAY *ar;
- int i;
- char *oldfile = filename;
- line_t oldline = line;
- int oldtmps_base = tmps_base;
- int oldsave = savestack->ary_fill;
- SPAT *oldspat = curspat;
- static char *last_eval = Nullch;
- static CMD *last_root = Nullcmd;
- int sp = arglast[0];
-
- tmps_base = tmps_max;
- if (curstash != stash) {
- (void)savehptr(&curstash);
- curstash = stash;
- }
- str_set(stab_val(stabent("@",TRUE)),"");
- if (optype != O_DOFILE) { /* normal eval */
- filename = "(eval)";
- line = 1;
- str_sset(linestr,str);
- str_cat(linestr,";"); /* be kind to them */
- }
- else {
- if (last_root) {
- Safefree(last_eval);
- cmd_free(last_root);
- last_root = Nullcmd;
- }
- filename = savestr(str_get(str)); /* can't free this easily */
- str_set(linestr,"");
- rsfp = fopen(filename,"r");
- ar = stab_array(incstab);
- if (!rsfp && *filename != '/') {
- for (i = 0; i <= ar->ary_fill; i++) {
- (void)sprintf(buf,"%s/%s",str_get(afetch(ar,i,TRUE)),filename);
- rsfp = fopen(buf,"r");
- if (rsfp) {
- filename = savestr(buf);
- break;
+#ifdef DEBUGGING
+ /* tmp push yystate for stack print; this is normally pushed later in
+ * yynewstate */
+ yyssp++;
+ *yyssp = yystate;
+ YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
+ yyssp--;
+#endif
+
+ goto yynewstate;
+
+
+ /*------------------------------------.
+ | yyerrlab -- here on detecting error |
+ `------------------------------------*/
+ yyerrlab:
+ /* If not already recovering from an error, report this error. */
+ if (!yyerrstatus) {
+ ++yynerrs;
+#if YYERROR_VERBOSE
+ yyn = yypact[yystate];
+
+ if (YYPACT_NINF < yyn && yyn < YYLAST) {
+ YYSIZE_T yysize = 0;
+ const int yytype = YYTRANSLATE (yychar);
+ char *yymsg;
+ int yyx, yycount;
+
+ yycount = 0;
+ /* Start YYX at -YYN if negative to avoid negative indexes in
+ YYCHECK. */
+ for (yyx = yyn < 0 ? -yyn : 0;
+ yyx < (int) (sizeof (yytname) / sizeof (char *)); yyx++)
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR)
+ yysize += yystrlen (yytname[yyx]) + 15, yycount++;
+ yysize += yystrlen ("syntax error, unexpected ") + 1;
+ yysize += yystrlen (yytname[yytype]);
+ Newx(yymsg, yysize, char *);
+ if (yymsg != 0) {
+ const char *yyp = yystpcpy (yymsg, "syntax error, unexpected ");
+ yyp = yystpcpy (yyp, yytname[yytype]);
+
+ if (yycount < 5) {
+ yycount = 0;
+ for (yyx = yyn < 0 ? -yyn : 0;
+ yyx < (int) (sizeof (yytname) / sizeof (char *));
+ yyx++)
+ {
+ if (yycheck[yyx + yyn] == yyx && yyx != YYTERROR) {
+ const char *yyq = ! yycount ?
+ ", expecting " : " or ";
+ yyp = yystpcpy (yyp, yyq);
+ yyp = yystpcpy (yyp, yytname[yyx]);
+ yycount++;
+ }
+ }
}
+ yyerror (yymsg);
+ YYSTACK_FREE (yymsg);
}
+ else
+ yyerror ("syntax error; also virtual memory exhausted");
}
- if (!rsfp) {
- filename = oldfile;
- tmps_base = oldtmps_base;
- if (gimme != G_ARRAY)
- st[++sp] = &str_undef;
- return sp;
- }
- line = 0;
- }
- in_eval++;
- oldoldbufptr = oldbufptr = bufptr = str_get(linestr);
- bufend = bufptr + linestr->str_cur;
- if (setjmp(eval_env)) {
- retval = 1;
- last_root = Nullcmd;
+ else
+#endif /* YYERROR_VERBOSE */
+ yyerror ("syntax error");
}
- else {
- error_count = 0;
- if (rsfp)
- retval = yyparse();
- else if (last_root && *bufptr == *last_eval && strEQ(bufptr,last_eval)){
- retval = 0;
- eval_root = last_root; /* no point in reparsing */
- }
- else if (in_eval == 1) {
- if (last_root) {
- Safefree(last_eval);
- cmd_free(last_root);
+
+
+ if (yyerrstatus == 3) {
+ /* If just tried and failed to reuse lookahead token after an
+ error, discard it. */
+
+ /* Return failure if at end of input. */
+ if (yychar == YYEOF) {
+ /* Pop the error token. */
+ YYPOPSTACK;
+ /* Pop the rest of the stack. */
+ while (yyss < yyssp) {
+ YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
+ YYPOPSTACK;
}
- last_eval = savestr(bufptr);
- last_root = Nullcmd;
- retval = yyparse();
- if (!retval)
- last_root = eval_root;
+ YYABORT;
}
- else
- retval = yyparse();
+
+ YYDSYMPRINTF ("Error: discarding", yytoken, &yylval);
+ yychar = YYEMPTY;
+
}
- myroot = eval_root; /* in case cmd_exec does another eval! */
- if (retval || error_count) {
- str = &str_undef;
- last_root = Nullcmd; /* can't free on error, for some reason */
- if (rsfp) {
- fclose(rsfp);
- rsfp = 0;
+
+ /* Else will try to reuse lookahead token after shifting the error
+ token. */
+ goto yyerrlab1;
+
+
+ /*----------------------------------------------------.
+ | yyerrlab1 -- error raised explicitly by an action. |
+ `----------------------------------------------------*/
+ yyerrlab1:
+ yyerrstatus = 3; /* Each real token shifted decrements this. */
+
+ for (;;) {
+ yyn = yypact[yystate];
+ if (yyn != YYPACT_NINF) {
+ yyn += YYTERROR;
+ if (0 <= yyn && yyn <= YYLAST && yycheck[yyn] == YYTERROR) {
+ yyn = yytable[yyn];
+ if (0 < yyn)
+ break;
+ }
}
+
+ /* Pop the current state because it cannot handle the error token. */
+ if (yyssp == yyss)
+ YYABORT;
+
+ YYDSYMPRINTF ("Error: popping", yystos[*yyssp], yyvsp);
+ yyvsp--;
+#ifdef DEBUGGING
+ yynsp--;
+#endif
+ yystate = *--yyssp;
+
+ YY_STACK_PRINT (yyss, yyssp, yyvs, yyns);
}
- else {
- sp = cmd_exec(eval_root,gimme,sp);
- st = stack->ary_array;
- for (i = arglast[0] + 1; i <= sp; i++)
- st[i] = str_static(st[i]);
- /* if we don't save result, free zaps it */
- if (in_eval != 1 && myroot != last_root)
- cmd_free(myroot);
- }
- in_eval--;
- filename = oldfile;
- line = oldline;
- tmps_base = oldtmps_base;
- curspat = oldspat;
- if (savestack->ary_fill > oldsave) /* let them use local() */
- restorelist(oldsave);
- return sp;
+
+ if (yyn == YYFINAL)
+ YYACCEPT;
+
+ YYDPRINTF ((Perl_debug_log, "Shifting error token, "));
+
+ *++yyvsp = yylval;
+#ifdef DEBUGGING
+ *++yynsp ="<err>";
+#endif
+
+ yystate = yyn;
+ YYDPRINTF ((Perl_debug_log, "Entering state %d\n", yystate));
+
+ goto yynewstate;
+
+
+ /*-------------------------------------.
+ | yyacceptlab -- YYACCEPT comes here. |
+ `-------------------------------------*/
+ yyacceptlab:
+ yyresult = 0;
+ goto yyreturn;
+
+ /*-----------------------------------.
+ | yyabortlab -- YYABORT comes here. |
+ `-----------------------------------*/
+ yyabortlab:
+ yyresult = 1;
+ goto yyreturn;
+
+ /*----------------------------------------------.
+ | yyoverflowlab -- parser overflow comes here. |
+ `----------------------------------------------*/
+ yyoverflowlab:
+ yyerror ("parser stack overflow");
+ yyresult = 2;
+ /* Fall through. */
+
+ yyreturn:
+
+ LEAVE; /* force stack free before we return */
+
+ return yyresult;
}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
projects / p5sagit/p5-mst-13.2.git / blobdiff