--- a/man.page +++ b/man.page @@ -51,13 +51,13 @@ .B -l option is not specified, .I byacc -will insert \#line directives in the generated code. -The \#line directives let the C compiler relate errors in the +will insert #line directives in the generated code. +The #line directives let the C compiler relate errors in the generated code to the user's original code. If the \fB-l\fP option is specified, .I byacc -will not insert the \#line directives. -\&\#line directives specified by the user will be retained. +will not insert the #line directives. +\&#line directives specified by the user will be retained. .TP \fB-p \fIsymbol_prefix\fP Change the prefix in symbols in the generated code to the string --- a/Makefile +++ b/Makefile @@ -1,8 +1,11 @@ # where to install program -DEST = /usr/local/bin +DEST = $(DESTDIR)/usr/bin # where to install library -LIB_DEST = /usr/local/lib +LIB_DEST = $(DESTDIR)/usr/lib + +# where to install man page +MAN_DEST = $(DESTDIR)/usr/share/man/man1 HDRS = defs.h @@ -10,7 +13,7 @@ #RINDEX = -Dstrrchr=rindex # the name of the final executable -PROGRAM = byacc +PROGRAM = pbyacc LIBRARY = libby.a @@ -23,9 +26,9 @@ CPPFLAGS = $(RINDEX) -DPROGRAM=\"$(PROGRAM)\" -DSIG_TYPE=$(SIG_TYPE) -CFLAGS = -O $(CPPFLAGS) +CFLAGS = -O2 -g $(CPPFLAGS) -#CC = gcc -Wall +CC = gcc -Wall CPP = /lib/cpp LDFLAGS = @@ -107,12 +110,16 @@ index: @ctags -wx $(HDRS) $(SRCS) -install: $(PROGRAM) $(LIBRARY) +$(DEST) $(LIB_DEST) $(MAN_DEST): + mkdir -p $@ + +install: $(PROGRAM) $(LIBRARY) $(DEST) $(LIB_DEST) $(MAN_DEST) @echo Installing $(PROGRAM) in $(DEST) @install -s $(PROGRAM) $(DEST) @echo Installing $(LIBRARY) in $(LIB_DEST) @cp $(LIBRARY) $(LIB_DEST)/$(LIBRARY) @$(RANLIB) $(LIB_DEST)/$(LIBRARY) + @install $(PROGRAM).man $(MAN_DEST)/$(PROGRAM).1 library: $(LIBRARY) --- a/test/Makefile +++ b/test/Makefile @@ -1,5 +1,7 @@ +PROGRAM=pbyacc + all_tests: - -../$(PROGRAM) -dv -b error error.y - -../$(PROGRAM) -dv -b ftp -p ftp ftp.y - -../$(PROGRAM) -P -dv -b calc calc.y - -../$(PROGRAM) -P -dv -b getdate getdate.y + -$(PROGRAM) -dv -b error error.y + -$(PROGRAM) -dv -b ftp -p ftp ftp.y + -$(PROGRAM) -P -dv -b calc calc.y + -$(PROGRAM) -P -dv -b getdate getdate.y --- a/perl5-patch/Makefile +++ b/perl5-patch/Makefile @@ -0,0 +1,28 @@ +# $Id: Makefile,v 1.1 2002/04/10 04:58:09 srz Exp $ + +VERSION=0.6 + +all: CalcParser.pm GenParser.pm + +CalcParser.pm: calc.y + pbyacc -P CalcParser calc.y + +GenParser.pm: gen.y + pbyacc -P GenParser gen.y + +clean: + -rm -f CalcParser.pm GenParser.pm + +patch: + cd ..; \ + diff -C 2 perl-byacc1.8.2.orig perl-byacc1.8.2 > patch; \ + mv patch perl5-byacc-patches + +dist: + cd ..; \ + mv perl5-byacc-patches perl5-byacc-patches-$(VERSION); \ + tar cvf perl5-byacc-patches-$(VERSION).tar \ + `find perl5-byacc-patches-$(VERSION) -type f | grep -v CVS`; \ + gzip perl5-byacc-patches-$(VERSION).tar; \ + mv perl5-byacc-patches-$(VERSION) perl5-byacc-patches; \ + mv perl5-byacc-patches-$(VERSION).tar.gz perl5-byacc-patches --- a/perl5-patch/gen.y +++ b/perl5-patch/gen.y @@ -0,0 +1,75 @@ +%{ +%} +%token NUMBER LITERAL NAME +%% +ruleset: rule { $main::start = $1; } + | ruleset rule + ; + +rule: NAME '=' blist ';' { $$ = $1; + $main::rules{$1} = $3; } + ; + +blist: branch { $$ = bless [$1], Rule; } + | blist '|' branch { $$ = $1; push (@{$$}, $3); } + ; + +branch: item { $$ = bless [$1], Branch; } + | branch item { $$ = $1; push (@{$$}, $2); } + ; + +item: LITERAL { $$ = new Literal($1); } + | NAME { $$ = new Name($1); } + ; +%% +sub yylex +{ + my ($s) = @_; + my ($c, $val); + + AGAIN: + while (($c = $s->getc) eq ' ' || $c eq "\t" || $c eq "\n") { } + + if ($c eq '') { return 0; } + + # read a comment + elsif ($c eq '#') { + while (($c = $s->getc) ne '' && $c ne "\n") { } + $s->ungetc; + goto AGAIN; + } + + # read a string literal + elsif ($c eq "\"") { + while (($c = $s->getc) ne '' && $c ne "\"") { + if ($c eq "\\") { + $c = $s->getc; + if ($c eq "\\") { $c = "\\"; } + elsif ($c eq "n") { $c = "\n"; } + elsif ($c eq "t") { $c = "\t"; } + elsif ($c eq "\"") { $c = "\""; } + } + $val .= $c; + } + return ($LITERAL, $val); + } + + # read a rule name + elsif ($c =~ /[a-zA-Z_-]/) { + $val = $c; + while (($c = $s->getc) =~ /[a-zA-Z0-9_-]/) { + $val .= $c; + } + $s->ungetc; + return ($NAME, $val); + } + + else { + return ord($c); + } +} + +sub yyerror { + my ($msg, $s) = @_; + die "$msg at " . $s->name . " line " . $s->lineno . ".\n"; +} --- a/perl5-patch/patch +++ b/perl5-patch/patch @@ -0,0 +1,823 @@ +Only in perl-byacc1.8.2: TAGS +diff -C 2 perl-byacc1.8.2.orig/defs.h perl-byacc1.8.2/defs.h +*** perl-byacc1.8.2.orig/defs.h Fri Jan 15 19:28:53 1993 +--- perl-byacc1.8.2/defs.h Tue Apr 28 23:07:12 1998 +*************** +*** 209,212 **** +--- 209,213 ---- + extern char tflag; + extern char vflag; ++ extern char perl5005flag; + + extern Language language; +*************** +*** 227,230 **** +--- 228,232 ---- + extern char *define_prefix; + extern char *symbol_prefix; ++ extern char *perl_package; + + extern char *action_file_name; +diff -C 2 perl-byacc1.8.2.orig/main.c perl-byacc1.8.2/main.c +*** perl-byacc1.8.2.orig/main.c Fri Jan 15 20:08:00 1993 +--- perl-byacc1.8.2/main.c Tue Apr 28 23:15:22 1998 +*************** +*** 9,12 **** +--- 9,13 ---- + char tflag; + char vflag; ++ char perl5005flag; + + char *myname = PROGRAM; +*************** +*** 24,27 **** +--- 25,30 ---- + char** suffixes = c_suffixes; + ++ char *perl_package = 0; ++ + int lineno; + int outline; +*************** +*** 135,139 **** + { + fprintf(stderr, +! "usage: %s [-CPcdlrtv] [-b file_prefix] [-p symbol_prefix] filename\n", + myname); + exit(1); +--- 138,142 ---- + { + fprintf(stderr, +! "usage: %s [-Ccdlrtv] [-b file_prefix] [-p sym_prefix] [-P package] filename\n", + myname); + exit(1); +*************** +*** 186,189 **** +--- 189,196 ---- + goto no_more_options; + ++ case '5': ++ perl5005flag = 1; ++ break; ++ + case 'b': + if (*++s) +*************** +*** 211,215 **** + case 'p': + if (*++s) +! symbol_prefix = s; + else if (++i < argc) + symbol_prefix = argv[i]; +--- 218,222 ---- + case 'p': + if (*++s) +! symbol_prefix = s; + else if (++i < argc) + symbol_prefix = argv[i]; +*************** +*** 221,225 **** + language = PERL; + suffixes = perl_suffixes; +! break; + + case 'r': +--- 228,238 ---- + language = PERL; + suffixes = perl_suffixes; +! if (*++s) +! perl_package = s; +! else if (++i < argc) +! perl_package = argv[i]; +! else +! usage(); +! continue; + + case 'r': +*************** +*** 293,298 **** + + if (language == PERL && rflag) +! fprintf(stderr, "%s: Warning: -r not recommended with Perl mode.\n", +! myname); + + no_more_options:; +--- 306,317 ---- + + if (language == PERL && rflag) +! fprintf(stderr, "%s: Warning: -r not recommended with Perl mode.\n", +! myname); +! if (language == PERL && strcmp(symbol_prefix, "yy") != 0) +! fprintf(stderr, "%s: Warning: -p not recommended with Perl mode.\n", +! myname); +! if (language != PERL && perl5005flag) +! fprintf(stderr, "%s: Warning: -5 has no effect without Perl mode.\n", +! myname); + + no_more_options:; +*************** +*** 442,448 **** + len = strlen(file_prefix); + +! output_file_name = MALLOC(len + strlen(suffixes[OUTPUT_SUFFIX]) + 1); +! strcpy(output_file_name, file_prefix); +! strcpy(output_file_name + len, suffixes[OUTPUT_SUFFIX]); + + if (rflag) +--- 461,475 ---- + len = strlen(file_prefix); + +! if (language == PERL) { +! int len = strlen(perl_package); +! output_file_name = MALLOC(len + 4); +! strcpy(output_file_name, perl_package); +! strcpy(output_file_name + len, ".pm"); +! } +! else { +! output_file_name = MALLOC(len + strlen(suffixes[OUTPUT_SUFFIX]) + 1); +! strcpy(output_file_name, file_prefix); +! strcpy(output_file_name + len, suffixes[OUTPUT_SUFFIX]); +! } + + if (rflag) +diff -C 2 perl-byacc1.8.2.orig/output.c perl-byacc1.8.2/output.c +*** perl-byacc1.8.2.orig/output.c Fri Jan 15 19:29:28 1993 +--- perl-byacc1.8.2/output.c Tue Apr 28 23:20:25 1998 +*************** +*** 71,82 **** + output_stype(); + if (rflag) write_section(tables); + write_section(header); + if (language == C) + output_trailing_text(); + write_section(body); + output_semantic_actions(); + write_section(trailer); +! if (language == PERL) + output_trailing_text(); + free_derives(); + free_nullable(); +--- 71,102 ---- + output_stype(); + if (rflag) write_section(tables); ++ if (language == PERL && perl5005flag) { ++ fprintf(code_file, ++ "use fields qw(yylex yyerror yydebug yynerrs yyerrflag yym \n"); ++ fprintf(code_file, ++ " yyn yyss yyssp yyvs yyvsp yystate yyval \n"); ++ fprintf(code_file, ++ " yylval yychar yys);\n"); ++ } + write_section(header); + if (language == C) + output_trailing_text(); ++ if (language == PERL) { ++ fprintf(code_file, "sub new {\n"); ++ if (perl5005flag) { ++ fprintf(code_file, " my %s $p = bless [\\%FIELDS], $_[0];\n", ++ perl_package); ++ } ++ else { ++ fprintf(code_file, " my $p = bless {}, $_[0];\n"); ++ } ++ } + write_section(body); + output_semantic_actions(); + write_section(trailer); +! if (language == PERL) { + output_trailing_text(); ++ fprintf(code_file, "1;\n"); ++ } + free_derives(); + free_nullable(); +diff -C 2 perl-byacc1.8.2.orig/reader.c perl-byacc1.8.2/reader.c +*** perl-byacc1.8.2.orig/reader.c Fri Jan 15 19:29:30 1993 +--- perl-byacc1.8.2/reader.c Tue Apr 28 17:37:36 1998 +*************** +*** 1,2 **** +--- 1,5 ---- ++ /* $Id: patch,v 1.1 2002/04/10 04:58:09 srz Exp $ */ ++ /* Modified for perl5-byacc-patches-0.5 */ ++ + #include "defs.h" + +*************** +*** 1379,1383 **** + + if (language == PERL) +! fprintf(f, "if ($%sn == %d) {\n", symbol_prefix, nrules - 2); + else + fprintf(f, "case %d:\n", nrules - 2); +--- 1382,1386 ---- + + if (language == PERL) +! fprintf(f, "if ($p->{%sn} == %d) {\n", symbol_prefix, nrules - 2); + else + fprintf(f, "case %d:\n", nrules - 2); +*************** +*** 1406,1410 **** + { + if (language == PERL) +! fprintf(f, "$%sval", symbol_prefix); + else + fprintf(f, "%sval.%s", symbol_prefix, tag); +--- 1409,1413 ---- + { + if (language == PERL) +! fprintf(f, "$p->{%sval}", symbol_prefix); + else + fprintf(f, "%sval.%s", symbol_prefix, tag); +*************** +*** 1418,1422 **** + if (i > n) dollar_warning(d_lineno, i); + if (language == PERL) +! fprintf(f, "$%svs[$%svsp-%d]", + symbol_prefix, symbol_prefix, n - i); + else +--- 1421,1425 ---- + if (i > n) dollar_warning(d_lineno, i); + if (language == PERL) +! fprintf(f, "$p->{%svs}->[$p->{%svsp}-%d]", + symbol_prefix, symbol_prefix, n - i); + else +*************** +*** 1430,1434 **** + i = -get_number() - n; + if (language == PERL) +! fprintf(f, "$%svsp[$%svsp-%d]", + symbol_prefix, symbol_prefix, -i); + else +--- 1433,1437 ---- + i = -get_number() - n; + if (language == PERL) +! fprintf(f, "$p->{%svsp}->[$p->{%svsp}-%d]", + symbol_prefix, symbol_prefix, -i); + else +*************** +*** 1447,1456 **** + if (tag == 0) untyped_lhs(); + if (language == PERL) +! fprintf(f, "$%sval", symbol_prefix); + else + fprintf(f, "%sval.%s", symbol_prefix, tag); + } + else if (language == PERL) +! fprintf(f, "$%sval", symbol_prefix); + else + fprintf(f, "%sval", symbol_prefix); +--- 1450,1459 ---- + if (tag == 0) untyped_lhs(); + if (language == PERL) +! fprintf(f, "$p->{%sval}", symbol_prefix); + else + fprintf(f, "%sval.%s", symbol_prefix, tag); + } + else if (language == PERL) +! fprintf(f, "$p->{%sval}", symbol_prefix); + else + fprintf(f, "%sval", symbol_prefix); +*************** +*** 1469,1473 **** + if (tag == 0) untyped_rhs(i, pitem[nitems + i - n - 1]->name); + if (language == PERL) +! fprintf(f, "$%svs[$%svsp-%d]", + symbol_prefix, symbol_prefix, n - i); + else +--- 1472,1476 ---- + if (tag == 0) untyped_rhs(i, pitem[nitems + i - n - 1]->name); + if (language == PERL) +! fprintf(f, "$p->{%svs}->[$p->{%svsp}-%d]", + symbol_prefix, symbol_prefix, n - i); + else +*************** +*** 1479,1483 **** + dollar_warning(lineno, i); + if (language == PERL) +! fprintf(f, "$%svs[$%svsp-%d]", + symbol_prefix, symbol_prefix, n - i); + else +--- 1482,1486 ---- + dollar_warning(lineno, i); + if (language == PERL) +! fprintf(f, "$p->{%svs}->[$p->{%svsp}-%d]", + symbol_prefix, symbol_prefix, n - i); + else +*************** +*** 1493,1497 **** + unknown_rhs(-i); + if (language == PERL) +! fprintf(f, "$%svs[$%svsp-%d]", + symbol_prefix, symbol_prefix, i + n); + else +--- 1496,1500 ---- + unknown_rhs(-i); + if (language == PERL) +! fprintf(f, "$p->{%svs}->[$p->{%svsp}-%d]", + symbol_prefix, symbol_prefix, i + n); + else +*************** +*** 1523,1527 **** + if (depth > 0) goto loop; + if (language == PERL) +! fprintf(f, "\nlast switch; }\n"); + else + fprintf(f, "\nbreak;\n"); +--- 1526,1530 ---- + if (depth > 0) goto loop; + if (language == PERL) +! fprintf(f, "\n}\n"); + else + fprintf(f, "\nbreak;\n"); +*************** +*** 1541,1545 **** + + if (language == PERL) +! fprintf(f, "\nlast switch;\n} }\n"); + else + fprintf(f, "}\nbreak;\n"); +--- 1544,1548 ---- + + if (language == PERL) +! fprintf(f, "}\n}\n"); + else + fprintf(f, "}\nbreak;\n"); +*************** +*** 2051,2054 **** +--- 2054,2059 ---- + { + write_section(banner); ++ if (language == PERL) ++ fprintf(code_file, "package %s;\n", perl_package); + create_symbol_table(); + read_declarations(); +diff -C 2 perl-byacc1.8.2.orig/skeleton.c perl-byacc1.8.2/skeleton.c +*** perl-byacc1.8.2.orig/skeleton.c Fri Jan 15 20:12:28 1993 +--- perl-byacc1.8.2/skeleton.c Tue Apr 28 23:16:48 1998 +*************** +*** 18,23 **** + static char *perl_banner[] = + { +! "$yysccsid = \"@(#)yaccpar 1.8 (Berkeley) 01/20/91 (Perl 2.0 12/31/92)\";", +! "#define YYBYACC 1", + (char *) NULL + }; +--- 18,22 ---- + static char *perl_banner[] = + { +! "# @(#)yaccpar 1.8 (Berkeley) 01/20/91 (JAKE-P5BP-0.6 04/26/98)", + (char *) NULL + }; +*************** +*** 77,86 **** + static char *perl_header[] = + { +! "sub yyclearin { $yychar = -1; }", +! "sub yyerrok { $yyerrflag = 0; }", +! "$YYSTACKSIZE = $YYSTACKSIZE || $YYMAXDEPTH || 500;", +! "$YYMAXDEPTH = $YYMAXDEPTH || $YYSTACKSIZE || 500;", +! "$yyss[$YYSTACKSIZE] = 0;", +! "$yyvs[$YYSTACKSIZE] = 0;", + (char *) NULL + }; +--- 76,89 ---- + static char *perl_header[] = + { +! "sub yyclearin {", +! " my PP $p;", +! " ($p) = @_;", +! " $p->{yychar} = -1;", +! "}", +! "sub yyerrok {", +! " my PP $p;", +! " ($p) = @_;", +! " $p->{yyerrflag} = 0;", +! "}", + (char *) NULL + }; +*************** +*** 236,268 **** + static char *perl_body[] = + { +! "sub YYERROR { ++$yynerrs; &yy_err_recover; }", +! "sub yy_err_recover", +! "{", +! " if ($yyerrflag < 3)", + " {", +! " $yyerrflag = 3;", + " while (1)", + " {", +! " if (($yyn = $yysindex[$yyss[$yyssp]]) && ", +! " ($yyn += $YYERRCODE) >= 0 && ", +! " $yycheck[$yyn] == $YYERRCODE)", + " {", +! "#if YYDEBUG", +! " print \"yydebug: state $yyss[$yyssp], error recovery shifting\",", +! " \" to state $yytable[$yyn]\\n\" if $yydebug;", +! "#endif", +! " $yyss[++$yyssp] = $yystate = $yytable[$yyn];", +! " $yyvs[++$yyvsp] = $yylval;", + " next yyloop;", + " }", + " else", + " {", +! "#if YYDEBUG", +! " print \"yydebug: error recovery discarding state \",", +! " $yyss[$yyssp], \"\\n\" if $yydebug;", +! "#endif", +! " return(1) if $yyssp <= 0;", +! " --$yyssp;", +! " --$yyvsp;", + " }", + " }", +--- 239,287 ---- + static char *perl_body[] = + { +! /* This is kludgy--the top of this sub needs to vary based on -5, so +! * it was moved to output.c. +! */ +! " $p->{yylex} = $_[1];", +! " $p->{yyerror} = $_[2];", +! " $p->{yydebug} = $_[3];", +! " return $p;", +! "}", +! "sub YYERROR {", +! " my PP $p;", +! " ($p) = @_;", +! " ++$p->{yynerrs};", +! " $p->yy_err_recover;", +! "}", +! "sub yy_err_recover {", +! " my PP $p;", +! " ($p) = @_;", +! " if ($p->{yyerrflag} < 3)", + " {", +! " $p->{yyerrflag} = 3;", + " while (1)", + " {", +! " if (($p->{yyn} = $yysindex[$p->{yyss}->[$p->{yyssp}]]) && ", +! " ($p->{yyn} += $YYERRCODE) >= 0 && ", +! " $p->{yyn} <= $#yycheck &&", +! " $yycheck[$p->{yyn}] == $YYERRCODE)", + " {", +! " warn(\"yydebug: state \" . ", +! " $p->{yyss}->[$p->{yyssp}] . ", +! " \", error recovery shifting to state\" . ", +! " $yytable[$p->{yyn}] . \"\\n\") ", +! " if $p->{yydebug};", +! " $p->{yyss}->[++$p->{yyssp}] = ", +! " $p->{yystate} = $yytable[$p->{yyn}];", +! " $p->{yyvs}->[++$p->{yyvsp}] = $p->{yylval};", + " next yyloop;", + " }", + " else", + " {", +! " warn(\"yydebug: error recovery discarding state \".", +! " $p->{yyss}->[$p->{yyssp}]. \"\\n\") ", +! " if $p->{yydebug};", +! " return(undef) if $p->{yyssp} <= 0;", +! " --$p->{yyssp};", +! " --$p->{yyvsp};", + " }", + " }", +*************** +*** 270,285 **** + " else", + " {", +! " return (1) if $yychar == 0;", +! "#if YYDEBUG", +! " if ($yydebug)", + " {", +! " $yys = '';", +! " if ($yychar <= $YYMAXTOKEN) { $yys = $yyname[$yychar]; }", +! " if (!$yys) { $yys = 'illegal-symbol'; }", +! " print \"yydebug: state $yystate, error recovery discards \",", +! " \"token $yychar ($yys)\\n\";", + " }", +! "#endif", +! " $yychar = -1;", + " next yyloop;", + " }", +--- 289,305 ---- + " else", + " {", +! " return (undef) if $p->{yychar} == 0;", +! " if ($p->{yydebug})", + " {", +! " $p->{yys} = '';", +! " if ($p->{yychar} <= $YYMAXTOKEN) { $p->{yys} = ", +! " $yyname[$p->{yychar}]; }", +! " if (!$p->{yys}) { $p->{yys} = 'illegal-symbol'; }", +! " warn(\"yydebug: state \" . $p->{yystate} . ", +! " \", error recovery discards \" . ", +! " \"token \" . $p->{yychar} . \"(\" . ", +! " $p->{yys} . \")\\n\");", + " }", +! " $p->{yychar} = -1;", + " next yyloop;", + " }", +*************** +*** 287,357 **** + "} # yy_err_recover", + "", +! "sub yyparse", +! "{", +! "#ifdef YYDEBUG", +! " if ($yys = $ENV{'YYDEBUG'})", + " {", +! " $yydebug = int($1) if $yys =~ /^(\\d)/;", + " }", +- "#endif", + "", +! " $yynerrs = 0;", +! " $yyerrflag = 0;", +! " $yychar = (-1);", + "", +! " $yyssp = 0;", +! " $yyvsp = 0;", +! " $yyss[$yyssp] = $yystate = 0;", + "", + "yyloop: while(1)", + " {", + " yyreduce: {", +! " last yyreduce if ($yyn = $yydefred[$yystate]);", +! " if ($yychar < 0)", + " {", +! " if (($yychar = &yylex) < 0) { $yychar = 0; }", +! "#if YYDEBUG", +! " if ($yydebug)", + " {", +! " $yys = '';", +! " if ($yychar <= $#yyname) { $yys = $yyname[$yychar]; }", +! " if (!$yys) { $yys = 'illegal-symbol'; };", +! " print \"yydebug: state $yystate, reading $yychar ($yys)\\n\";", + " }", +- "#endif", + " }", +! " if (($yyn = $yysindex[$yystate]) && ($yyn += $yychar) >= 0 &&", +! " $yycheck[$yyn] == $yychar)", + " {", +! "#if YYDEBUG", +! " print \"yydebug: state $yystate, shifting to state \",", +! " $yytable[$yyn], \"\\n\" if $yydebug;", +! "#endif", +! " $yyss[++$yyssp] = $yystate = $yytable[$yyn];", +! " $yyvs[++$yyvsp] = $yylval;", +! " $yychar = (-1);", +! " --$yyerrflag if $yyerrflag > 0;", + " next yyloop;", + " }", +! " if (($yyn = $yyrindex[$yystate]) && ($yyn += $yychar) >= 0 &&", +! " $yycheck[$yyn] == $yychar)", + " {", +! " $yyn = $yytable[$yyn];", + " last yyreduce;", + " }", +! " if (! $yyerrflag) {", +! " &yyerror('syntax error');", +! " ++$yynerrs;", + " }", +! " return(1) if &yy_err_recover;", + " } # yyreduce", +! "#if YYDEBUG", +! " print \"yydebug: state $yystate, reducing by rule \",", +! " \"$yyn ($yyrule[$yyn])\\n\" if $yydebug;", +! "#endif", +! " $yym = $yylen[$yyn];", +! " $yyval = $yyvs[$yyvsp+1-$yym];", +! " switch:", +! " {", + (char *) NULL + }; +--- 307,381 ---- + "} # yy_err_recover", + "", +! "sub yyparse {", +! " my PP $p;", +! " my $s;", +! " ($p, $s) = @_;", +! " if ($p->{yys} = $ENV{'YYDEBUG'})", + " {", +! " $p->{yydebug} = int($1) if $p->{yys} =~ /^(\\d)/;", + " }", + "", +! " $p->{yynerrs} = 0;", +! " $p->{yyerrflag} = 0;", +! " $p->{yychar} = (-1);", + "", +! " $p->{yyssp} = 0;", +! " $p->{yyvsp} = 0;", +! " $p->{yyss}->[$p->{yyssp}] = $p->{yystate} = 0;", + "", + "yyloop: while(1)", + " {", + " yyreduce: {", +! " last yyreduce if ($p->{yyn} = $yydefred[$p->{yystate}]);", +! " if ($p->{yychar} < 0)", + " {", +! " if ((($p->{yychar}, $p->{yylval}) = ", +! " &{$p->{yylex}}($s)) < 0) { $p->{yychar} = 0; }", +! " if ($p->{yydebug})", + " {", +! " $p->{yys} = '';", +! " if ($p->{yychar} <= $#yyname) ", +! " { $p->{yys} = $yyname[$p->{yychar}]; }", +! " if (!$p->{yys}) { $p->{yys} = 'illegal-symbol'; };", +! " warn(\"yydebug: state \" . $p->{yystate} . ", +! " \", reading \" . $p->{yychar} . \" (\" . ", +! " $p->{yys} . \")\\n\");", + " }", + " }", +! " if (($p->{yyn} = $yysindex[$p->{yystate}]) && ", +! " ($p->{yyn} += $p->{yychar}) >= 0 && ", +! " $p->{yyn} <= $#yycheck &&", +! " $yycheck[$p->{yyn}] == $p->{yychar})", + " {", +! " warn(\"yydebug: state \" . $p->{yystate} . ", +! " \", shifting to state \" .", +! " $yytable[$p->{yyn}] . \"\\n\") if $p->{yydebug};", +! " $p->{yyss}->[++$p->{yyssp}] = $p->{yystate} = ", +! " $yytable[$p->{yyn}];", +! " $p->{yyvs}->[++$p->{yyvsp}] = $p->{yylval};", +! " $p->{yychar} = (-1);", +! " --$p->{yyerrflag} if $p->{yyerrflag} > 0;", + " next yyloop;", + " }", +! " if (($p->{yyn} = $yyrindex[$p->{yystate}]) && ", +! " ($p->{yyn} += $p->{'yychar'}) >= 0 &&", +! " $p->{yyn} <= $#yycheck &&", +! " $yycheck[$p->{yyn}] == $p->{yychar})", + " {", +! " $p->{yyn} = $yytable[$p->{yyn}];", + " last yyreduce;", + " }", +! " if (! $p->{yyerrflag}) {", +! " &{$p->{yyerror}}('syntax error', $s);", +! " ++$p->{yynerrs};", + " }", +! " return(undef) if $p->yy_err_recover;", + " } # yyreduce", +! " warn(\"yydebug: state \" . $p->{yystate} . ", +! " \", reducing by rule \" . ", +! " $p->{yyn} . \" (\" . $yyrule[$p->{yyn}] . ", +! " \")\\n\") if $p->{yydebug};", +! " $p->{yym} = $yylen[$p->{yyn}];", +! " $p->{yyval} = $p->{yyvs}->[$p->{yyvsp}+1-$p->{yym}];", + (char *) NULL + }; +*************** +*** 422,468 **** + static char *perl_trailer[] = + { +! " } # switch", +! " $yyssp -= $yym;", +! " $yystate = $yyss[$yyssp];", +! " $yyvsp -= $yym;", +! " $yym = $yylhs[$yyn];", +! " if ($yystate == 0 && $yym == 0)", +! " {", +! "#if YYDEBUG", +! " print \"yydebug: after reduction, shifting from state 0 \",", +! " \"to state $YYFINAL\\n\" if $yydebug;", +! "#endif", +! " $yystate = $YYFINAL;", +! " $yyss[++$yyssp] = $YYFINAL;", +! " $yyvs[++$yyvsp] = $yyval;", +! " if ($yychar < 0)", + " {", +! " if (($yychar = &yylex) < 0) { $yychar = 0; }", +! "#if YYDEBUG", +! " if ($yydebug)", + " {", +! " $yys = '';", +! " if ($yychar <= $#yyname) { $yys = $yyname[$yychar]; }", +! " if (!$yys) { $yys = 'illegal-symbol'; }", +! " print \"yydebug: state $YYFINAL, reading $yychar ($yys)\\n\";", + " }", +- "#endif", + " }", +! " return(0) if $yychar == 0;", + " next yyloop;", + " }", +! " if (($yyn = $yygindex[$yym]) && ($yyn += $yystate) >= 0 &&", +! " $yyn <= $#yycheck && $yycheck[$yyn] == $yystate)", + " {", +! " $yystate = $yytable[$yyn];", + " } else {", +! " $yystate = $yydgoto[$yym];", + " }", +! "#if YYDEBUG", +! " print \"yydebug: after reduction, shifting from state \",", +! " \"$yyss[$yyssp] to state $yystate\\n\" if $yydebug;", +! "#endif", +! " $yyss[++$yyssp] = $yystate;", +! " $yyvs[++$yyvsp] = $yyval;", + " } # yyloop", + "} # yyparse", +--- 446,491 ---- + static char *perl_trailer[] = + { +! " $p->{yyssp} -= $p->{yym};", +! " $p->{yystate} = $p->{yyss}->[$p->{yyssp}];", +! " $p->{yyvsp} -= $p->{yym};", +! " $p->{yym} = $yylhs[$p->{yyn}];", +! " if ($p->{yystate} == 0 && $p->{yym} == 0)", +! " {", +! " warn(\"yydebug: after reduction, shifting from state 0 \",", +! " \"to state $YYFINAL\\n\") if $p->{yydebug};", +! " $p->{yystate} = $YYFINAL;", +! " $p->{yyss}->[++$p->{yyssp}] = $YYFINAL;", +! " $p->{yyvs}->[++$p->{yyvsp}] = $p->{yyval};", +! " if ($p->{yychar} < 0)", + " {", +! " if ((($p->{yychar}, $p->{yylval}) = ", +! " &{$p->{yylex}}($s)) < 0) { $p->{yychar} = 0; }", +! " if ($p->{yydebug})", + " {", +! " $p->{yys} = '';", +! " if ($p->{yychar} <= $#yyname) ", +! " { $p->{yys} = $yyname[$p->{yychar}]; }", +! " if (!$p->{yys}) { $p->{yys} = 'illegal-symbol'; }", +! " warn(\"yydebug: state $YYFINAL, reading \" . ", +! " $p->{yychar} . \" (\" . $p->{yys} . \")\\n\");", + " }", + " }", +! " return ($p->{yyvs}->[1]) if $p->{yychar} == 0;", + " next yyloop;", + " }", +! " if (($p->{yyn} = $yygindex[$p->{yym}]) && ", +! " ($p->{yyn} += $p->{yystate}) >= 0 && ", +! " $p->{yyn} <= $#yycheck && ", +! " $yycheck[$p->{yyn}] == $p->{yystate})", + " {", +! " $p->{yystate} = $yytable[$p->{yyn}];", + " } else {", +! " $p->{yystate} = $yydgoto[$p->{yym}];", + " }", +! " warn(\"yydebug: after reduction, shifting from state \" . ", +! " $p->{yyss}->[$p->{yyssp}] . \" to state \" . ", +! " $p->{yystate} . \"\\n\") if $p->{yydebug};", +! " $p->{yyss}[++$p->{yyssp}] = $p->{yystate};", +! " $p->{yyvs}[++$p->{yyvsp}] = $p->{yyval};", + " } # yyloop", + "} # yyparse", +*************** +*** 473,476 **** +--- 496,529 ---- + + #if __STDC__ ++ static char *add_perl_package(char *old_str, char *new_str) ++ #else ++ static char *add_perl_package(old_str, new_str) ++ char *old_str; ++ char *new_str; ++ #endif ++ { ++ register char *from = old_str; ++ register char *to = new_str; ++ register char *p; ++ ++ while (*from) { ++ if (*from == 'P' && *(from + 1) == 'P') { ++ from += 2; ++ p = perl5005flag ? perl_package : ""; ++ while (*to++ = *p++) ++ /* void */ ; ++ to--; ++ } ++ else { ++ *to++ = *from++; ++ } ++ } ++ ++ *to = *from; ++ ++ return new_str; ++ } ++ ++ #if __STDC__ + static char *add_prefixes(char *old_str, char *new_str) + #else +*************** +*** 523,527 **** + { + fp = code_file; +! if (prefix_changed) + { + char buf[BUFSIZ]; +--- 576,590 ---- + { + fp = code_file; +! if (language == PERL) +! { +! char buf[BUFSIZ]; +! +! for (i = 0; sec[i]; ++i) +! { +! ++outline; +! fprintf(fp, "%s\n", add_perl_package(sec[i], buf)); +! } +! } +! else if (prefix_changed) + { + char buf[BUFSIZ]; +Common subdirectories: perl-byacc1.8.2.orig/test and perl-byacc1.8.2/test --- a/perl5-patch/README +++ b/perl5-patch/README @@ -0,0 +1,111 @@ +# $Id: README,v 1.1 2002/04/10 04:58:09 srz Exp $ + + ------------------------ + Perl 5 Byacc Patches 0.6 + ------------------------ + +This is a set of patches to perl-byacc1.8.2 which cause it to generate +a Perl 5 class implementing a parser (instead of a file full of global +data and procedures). It's nice if you want to be squeaky clean, and +very nice if you have a need for multiple parsers or multiple +instances of a parser in one program. + + How to install it + ----------------- + +1. Get perl-byacc1.8.2 and unpack it. See + + http://www.perl.com/CPAN/src/misc/perl-byacc1.8.2.tar.gz + +2. Patch byacc with + + cd perl-byacc1.8.2 + patch < ../perl5-byacc-patches-0.6/patch + +3. Compile perl-byacc1.8.2 as usual. + + + How to use it + ------------- + +You invoke byacc a little differently: + + 1. -P now takes a package name argument, and the output file is + written as {package name}.pm. + + 2. You can pass a -5 argument to get a somewhat faster parser under + Perl 5.005 (using 'my Dog $spot' and 'use fields'). By the way, + parsers generated with these patches are thread-safe (all package + variables are static data), although of course you will break + that if you do something non-thread-safe in your lexer or + actions. + +You must write your parser a little differently: + + 1. Your &yylex and &yyerror procedures can (optionally) take an + extra argument, which is passed from &yyparse (see below). + + 2. Your &yylex procedure no longer side-effects $yylval; instead, + it must return a list containing the token and the value. + + 3. Your top-level rule can assign a value to $$, and this value will + be returned as the value of &yyparse (see below). + +And you must write the code that uses the parser differently too: + + 1. Use 'use Parser' (or whatever package you put in -P) + instead of 'require "y.tab.pl"'. + + 2. Create a new parser object with + + $p = Parser->new($yylex, $yyerror, $yydebug); + + The first two arguments are references to your &yylex and + &yyerror procedures, respectively. The third is true or false to + enable or disable debugging output. + + Although you may wind up sticking your &yylex and &yyerror in the + parser package in most cases, this is more composable if you want + to do something weird. + + 3. Start a parse by calling + + $val = $p->yyparse($s); + + Here $s is an optional "stream" argument which represents the + state of the text you're scanning. Depending on what you want to + do, this could be a filehandle reference, a string, some object + you cooked up, or whatever. + + The argument is passed down to &yylex and &yyerror. &yylex should + use it to get characters, and &yyerror should examine it to + generate a meaningful message. + + 4. $p->yyparse returns the value that your top-level rule assigned + to $$, instead of true or false to indicate success or + failure. This obviates the need to side-effect global variables + to return values from the parser. You should use exceptions to + handle error conditions. + + + Example + ------- + +I've include two examples: an ultra-simple calculator and a random +text generator. Type 'make' to build the parsers. + + + Copying + ------- + +This code is in the public domain--use it and redistribute it as you +like. I would appreciate acknowledgement of some kind (or at the very +least an email) if you use it in something that is widely used or +distributed. + + + Bugs and feedback + ----------------- + +Send them to Jake Donham (donham@linex.com). I'd love to hear from you +if you find these patches useful. --- a/perl5-patch/thought +++ b/perl5-patch/thought @@ -0,0 +1,108 @@ +start = thought "\n" + ; + +thought = quote | funny | girl | body + ; + + +# quote -------------------------------------------------------------------- + +quote = "\"Being is always the being of a being.\"" + | "\"All of life is erotic losses.\"" + | "\"Wheel in the sky keeps on turnin'.\"" + | "\"Hey Jude, don't be afraid.\"" + | "\"Past performance is no guarantee of future results.\"" + | "\"It's OK--I'm an intellectual too!\"" + | "\"We have met the enemy, and he is us!\"" + | "\"My nipples are exploding with delight!\"" + ; + + +# funny -------------------------------------------------------------------- + +funny = f_intstart " " f_funny " when " f_clause "?" + | f_decstart " " f_funny " when " f_clause "." + | f_decstart2 " " f_clause "." + ; + +f_intstart = "Isn't it" | "Don't you think it's" | "Do you find it" + ; + +f_decstart = "It's" | "I find it" + ; + +f_decstart2 = "I see that" | "Don't tell me that" | "I'm convinced that" + | "I'm aware that" | "I can't escape the fact that" + ; + +f_funny = "funny" | "humorous" | "laughable" | "risible" | "amusing" + | "sad" | "heart-rending" | "hard to take" | "painful" + ; + +f_clause = s_noun " " s_iverb + | p_noun " " p_iverb + | s_noun " " s_tverb " " noun + | p_noun " " p_tverb " " noun + ; + +noun = s_noun | p_noun + ; + +s_noun = "my butt" | "your computer" | "The President" | "Madonna" + | "an egg" | "a dog" | "The New York Times" | "an iguana" + | "plexiglass" | "hummus" | "baba ghanoush" | "a tall building" + | "The Legion of Doom" | "Stretch Armstrong" + ; + +p_noun = "monkies" | "The Monkees" | "phat beats" | "Neuticles" + | "tender morsels" | "damaged goods" | "cheese-filled hotdogs" + | "killer bees" | "naughty librarians" | "R-2 units" + | "Imperial stormtroopers" | "senators" | "celebrities" + | "the roses" + ; + +s_iverb = "dies" | "falls on the floor" | "drops out of school" + | "flees in terror" | "calls you 'Mom'" | "votes the party line" + | "goes into shock" + ; + +s_tverb = "crushes" | "propositions" | "votes for" | "placates" + | "plagiarizes from" | "woos" | "tattles on" | "slanders" + | "reviles" | "liberates" | "licks" + ; + +p_iverb = "capitulate" | "implode" | "pray for mercy" + ; + +p_tverb = "fly out of" | "become acquainted with" | "flock to" + | "detail the war-crimes of" | "de-criminalize" + | "stop to smell" | "ponder the relevance of" + ; + + +# girl --------------------------------------------------------------------- + +girl = "I like " g_adj " girls." + | "I like " g_adj " girls with " g_attr "." + ; + +g_adj = "cute" | "smart" | "funny" + ; + +g_attr = "a quicker wit than me" | "nice hair" | "T-shirts" + ; + + +# body --------------------------------------------------------------------- + +body = "I'm hungry." | "I'm thirsty." | "I'm tired." + | "I'm having a bad hair day." | "I'm lonely." | "I'm angry." + | "I'm overjoyed." | "I need a beer." | "I need a vodka tonic." + | "I need a Coke." | "My clothes itch." + ; + + +# misc --------------------------------------------------------------------- + +misc = "misc" + ; --- a/perl5-patch/calc.y +++ b/perl5-patch/calc.y @@ -0,0 +1,60 @@ +%{ +%} + +%token NUMBER EOL +%left '+' '-' +%left '*' '/' + +%% +start: | + start input + ; + +input: expr EOL { print $1 . "\n"; } + | EOL + ; + +expr: NUMBER { $$ = $1; } + | expr '+' expr { $$ = $1 + $3; } + | expr '-' expr { $$ = $1 - $3; } + | expr '*' expr { $$ = $1 * $3; } + | expr '/' expr { $$ = $1 / $3; } + | '(' expr ')' { $$ = $2; } + ; +%% +# $Id: calc.y,v 1.1 2002/04/10 04:58:09 srz Exp $ + +sub yylex +{ + my ($s) = @_; + my ($c, $val); + + while (($c = $s->getc) eq ' ' || $c eq "\t") { + } + + if ($c eq '') { + return 0; + } + + elsif ($c eq "\n") { + return $EOL; + } + + elsif ($c =~ /[0-9]/) { + $val = $c; + while (($c = $s->getc) =~ /[0-9]/) { + $val .= $c; + } + $s->ungetc; + return ($NUMBER, $val); + } + + else { + return ord($c); + } +} + +sub yyerror { + my ($msg, $s) = @_; + die "$msg at " . $s->name . " line " . $s->lineno . ".\n"; +} --- a/perl5-patch/gen.pl +++ b/perl5-patch/gen.pl @@ -0,0 +1,87 @@ +#!/usr/bin/perl + +# This is a Perl rewrite of a C program I wrote a while back that +# generates random strings from a language specified in BNF. Try +# 'gen.pl < thought' to see how it works. + +# $Id: gen.pl,v 1.1 2002/04/10 04:58:09 srz Exp $ + +# Structs for the grammar. + +# These two aren't really used as classes per se but it's convenient +# to bless things into them so you can see what's going on in the +# debugger. +package Rule; +package Branch; + +package Literal; +sub new { + my ($class, $value) = @_; + bless { value => $value }, $class; +} + +package Name; +sub new { + my ($class, $name) = @_; + bless { name => $name }, $class; +} + +# Here is the actual generation code. + +package main; + +use GenParser; +use Fstream; + +srand(time|$$); + +$s = Fstream->new(\*STDIN, 'STDIN'); +$p = GenParser->new(\&GenParser::yylex, \&GenParser::yyerror, 0); +$p->yyparse($s); + +&fixup_names; +&gen($rules{$start}); + +# connect rule invocations to the actual rule. +sub fixup_names { + my ($rule, $branch, $item); + + foreach $rule (values %rules) { + foreach $branch (@$rule) { + foreach $item (@$branch) { + if ($item->isa("Name")) { + my $r = $rules{$item->{name}} or + die "Undefined rule " . $item->{name}; + $item->{blist} = $r; + } + } + } + } +} + +# generate language. We keep a manual stack instead of doing a +# recursive call (just for the hell of it). +sub gen { + my ($blist) = @_; + my @stack; + + LOOP: + + my $ilist = [ @{$$blist[int(rand(@$blist))]} ]; + push(@stack, $ilist); + + while (@stack) { + my $ilist = $stack[-1]; + while (@$ilist) { + my $item = shift @$ilist; + if ($item->isa("Literal")) { + print $item->{value}; + } + elsif ($item->isa("Name")) { + $blist = $item->{blist}; + goto LOOP; + } + } + pop @stack; + } +} --- a/perl5-patch/Fstream.pm +++ b/perl5-patch/Fstream.pm @@ -0,0 +1,119 @@ +# $Id: Fstream.pm,v 1.1 2002/04/10 04:58:09 srz Exp $ + +package Fstream; + +# ---------------------------------------------------------------------------- + +=head1 NAME + +Fstream - a class to encapsulate a filehandle as a stream; + +=head1 SYNOPSIS + + use Fstream; + +=head1 DESCRIPTION + +Fstream wraps a filehandle and provides methods that make it easier to +write a lexer. + +=cut + +# ---------------------------------------------------------------------------- + +=head2 Class Methods +=over 4 + +=item new($filehandle, $name) +Creates an Fstream object from $filehandle (a filehandle glob +reference). $name is a string which is stored for debugging purposes +and may be accessed with &name. + +=back +=cut + +sub new { + my ($class, $fh, $name) = @_; + my $stream = bless {}, $class; + $stream->{fh} = $fh; + $stream->{name} = $name; + $stream->{lineno} = 1; + $stream->{save} = undef; + $stream->{saved} = 0; + return $stream; +} + +# ---------------------------------------------------------------------------- + +=head2 Object Methods +=over 4 + +=item getc +Returns the next character in the stream, or the empty string if the +stream has been exhausted. + +=cut + +sub getc { + my ($stream) = @_; + my $c; + + if ($stream->{saved}) { + $stream->{saved} = 0; + $c = $stream->{save}; + if ($c eq "\n") { + $stream->{lineno}++; + } + return $c; + } + elsif (($c = getc($stream->{fh})) eq '') { + return ''; + } + else { + $stream->{save} = $c; + if ($c eq "\n") { + $stream->{lineno}++; + } + return $c; + } +} + +=item ungetc +Pushes the last character read back onto the stream, where it will be +returned on the next call to getc. You may only push one character +back on the stream. + +=cut + +sub ungetc { + my ($stream) = @_; + + $stream->{saved} = 1; + if ($stream->{save} eq "\n") { + $stream->{lineno}--; + } +} + +=item lineno +Returns the line-number of the stream (based on the number of newlines +seen). + +=cut + +sub lineno { + my ($stream) = @_; + return $stream->{lineno}; +} + +=item name +Returns the name that was given in the constructor. + +=back +=cut + +sub name { + my ($stream) = @_; + return $stream->{name}; +} + +1; --- a/perl5-patch/CHANGES +++ b/perl5-patch/CHANGES @@ -0,0 +1,9 @@ +# $Id: CHANGES,v 1.1 2002/04/10 04:58:09 srz Exp $ + +Since 0.5 +--------- + +Added -P {package name} and automatic 'package {package name};' and '1;' +Added -5 for Perl 5.005 fanciness +Patch for possible stack overflow conditions + (from Rod Whitby ) --- a/perl5-patch/calc.pl +++ b/perl5-patch/calc.pl @@ -0,0 +1,13 @@ +#!/usr/bin/perl + +# $Id: calc.pl,v 1.1 2002/04/10 04:58:09 srz Exp $ + +# Really trivial calculator. + +use CalcParser; +use Fstream; + +$s = Fstream->new(\*STDIN, 'STDIN'); +$p = CalcParser->new(\&CalcParser::yylex, \&CalcParser::yyerror, 0); + +$p->yyparse($s);