pascal-grammar

this is a lp0 compilator new

#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
#	ident-list
#	makefile
#	misc.c
#	mktoken_name
#	pascal.l
#	pascal.y
#	types.h
# This archive created: Thu Nov 26 22:10:37 1987
export PATH; PATH=/bin:/usr/bin:$PATH
echo shar: "extracting 'ident-list'" '(1162 characters)'
if test -f 'ident-list'
then
	echo shar: "will not over-write existing file 'ident-list'"
else
sed 's/^	X//' << \SHAR_EOF > 'ident-list'
	X#!/bin/sh
	X#
	X#	ident-list [-s] <program>
	X#
	Xtmp1=/tmp/a$$X
	Xtmp2=/tmp/a$$Y
	Xsflag="$1"
	Xif [ "x$sflag" = "x-s" ]
	Xthen shift
	Xfi
	X
	Xcat $* | extract-ids >$tmp1
	Xif [ "x$sflag" = "x-s" ]
	Xthen
	X	sed -e '/^program/d
	X/^field/d
	X/^external-file/d
	Xs/^conformant-bound/parameter/
	Xs/^procedure-parameter/parameter/
	Xs/^function-parameter/parameter/
	Xs/^var-parameter/parameter/
	Xs/^value-parameter/parameter/
	Xs/^enumerated-literal/constant/' <$tmp1 >$tmp2
	X	mv $tmp2 $tmp1
	Xfi
	Xsort -uf +0 -1 +1 -2 <$tmp1 |
	Xawk '
	Xfunc tabulate(title,n) {
	X	columns = int(pagewidth/(maxlen+3));
	X	colwidth = int(pagewidth/columns);
	X	rows = int((n+columns-1)/columns);
	X	format = sprintf("%%-%ds", colwidth);
	X	for(i=1;i<=rows; i++)
	X	{
	X	    printf "%-19s| ", title; title=""
	X	    for(j=0; j<columns; j++)
	X	    {
	X		x = i + j*rows
	X		if(x<=n)printf(format, s[x]);
	X	    }
	X	    print ""
	X	}
	X	print ""
	X}
	X
	XBEGIN { itemtype="";  pagewidth=59
	Xbar="---------------------------------------------------------------"}
	X{
	X	if($1 != itemtype)
	X	{
	X		if(n>0)  tabulate(itemtype,n)
	X		itemtype = $1; n=0; maxlen=0;
	X	}
	X	s[++n] = $2;  len = length($2);  if(len>maxlen)maxlen=len;
	X}
	XEND { if(n>0)  tabulate(itemtype,n) }'
	X
	Xrm -f $tmp1
SHAR_EOF
if test 1162 -ne "`wc -c < 'ident-list'`"
then
	echo shar: "error transmitting 'ident-list'" '(should have been 1162 characters)'
fi
fi
echo shar: "extracting 'makefile'" '(557 characters)'
if test -f 'makefile'
then
	echo shar: "will not over-write existing file 'makefile'"
else
sed 's/^	X//' << \SHAR_EOF > 'makefile'
	XOBJECTS = y.tab.o misc.o lex.yy.o token_name.o
	X
	X#
	Xall:		extract-ids
	Xextract-ids:	$(OBJECTS)
	X		cc -o extract-ids $(OBJECTS) -ly -ll
	Xy.tab.c y.tab.h:	pascal.y
	X		yacc -vd pascal.y
	Xlex.yy.c:	pascal.l
	X		lex pascal.l
	Xlex.yy.o:	tokens.h
	Xtokens.h:	y.tab.h
	X		-cmp -s y.tab.h tokens.h || cp y.tab.h tokens.h
	Xtoken_name.c:	mktoken_name tokens.h
	X		sh mktoken_name
	X
	Xinstall:	extract-ids
	X		if [ -d "$(BIN)" ] ; then cp extract-ids ident-list $(BIN)/ ; \
	X			     chmod 755 $(BIN)/extract-ids $(BIN)/ident-list ; fi
	X		
	Xclean:
	X		rm -f *.o lex.yy.c y.* token_name.c tokens.h
SHAR_EOF
if test 557 -ne "`wc -c < 'makefile'`"
then
	echo shar: "error transmitting 'makefile'" '(should have been 557 characters)'
fi
fi
echo shar: "extracting 'misc.c'" '(253 characters)'
if test -f 'misc.c'
then
	echo shar: "will not over-write existing file 'misc.c'"
else
sed 's/^	X//' << \SHAR_EOF > 'misc.c'
	X#include <stdio.h>
	X
	X
	Xchar  *create_string(s)
	Xchar	*s;
	X{
	X    char *p = (char *) malloc(strlen(s) + 1);
	X    if(p==NULL) internal_error("Cannot malloc in create-string");
	X    strcpy(p,s);
	X    return p;
	X}
	X
	Xint max(a,b)
	Xint	a,b;
	X{
	X    return  a>b ? a : b;
	X}
SHAR_EOF
if test 253 -ne "`wc -c < 'misc.c'`"
then
	echo shar: "error transmitting 'misc.c'" '(should have been 253 characters)'
fi
fi
echo shar: "extracting 'mktoken_name'" '(465 characters)'
if test -f 'mktoken_name'
then
	echo shar: "will not over-write existing file 'mktoken_name'"
else
sed 's/^	X//' << \SHAR_EOF > 'mktoken_name'
	X#!/bin/sh
	X#
	X#	Make a symbol name
	X#
	X(
	Xecho 'char *token_name(i)
	Xint i;
	X{
	X    static char buf[10];
	X    switch(i)
	X    {
	X	default  : if(i<256)
	X		   {
	X		       if(i<32 || i>126)
	X			   sprintf(buf, "0%o", i);
	X		       else
	X		           sprintf(buf, "'%c'", i);
	X		       return buf;
	X		   }
	X		   else
	X		       return("<Unknown token>");
	X	case   0 : return("<End of input>");'
	Xawk '{printf"	case %d : return(\"%s\");\n",  $4, $3}'	< y.tab.h
	Xecho '    }
	X}'
	X)  > token_name.c
SHAR_EOF
if test 465 -ne "`wc -c < 'mktoken_name'`"
then
	echo shar: "error transmitting 'mktoken_name'" '(should have been 465 characters)'
fi
fi
echo shar: "extracting 'pascal.l'" '(3817 characters)'
if test -f 'pascal.l'
then
	echo shar: "will not over-write existing file 'pascal.l'"
else
sed 's/^	X//' << \SHAR_EOF > 'pascal.l'
	X%{
	X/******************************************************************************
	X		LEXICAL ANALYSER for ISO standard Pascal
	X		----------------------------------------
	X
	XThis lexical analyser satisfies the following requirements in British
	XStandards Institution Specification for Computer programming language Pascal
	XBS6192:1982 (ISO 7185:1983)
	X
	X6.1.1	6.1.2	6.1.3	6.1.4	6.1.5	6.1.6	6.1.7
	X6.1.8	(except ^Z is considered to be a space)
	X6.1.9
	X******************************************************************************/
	X
	X#include "y.tab.h"
	Xint	character_no = -1;
	X
	X#undef input
	X#undef unput
	Xint  input()
	X{
	X    if(yysptr > yysbuf)
	X    {
	X	yytchar = U(*--yysptr);
	X    } else
	X	yytchar = getc(yyin);
	X    character_no++;
	X    if(yytchar == 10)  yylineno ++;
	X    if(yytchar == 0)   yytchar= ' ';
	X    if(yytchar == EOF) yytchar= 0;
	X    return yytchar;
	X}
	X
	Xunput(c)
	Xint c;
	X{
	X    yytchar = c;
	X    if (yytchar == '\n') yylineno--;
	X    *yysptr++ = yytchar;
	X    character_no--;
	X}
	X
	Xcomment()
	X{
	X    char c, lastc=' ';
	X    while(c = yyinput())
	X	if(c == '}' || (lastc=='*' && c==')'))
	X	    break;
	X        else
	X	    lastc = c;
	X}
	X
	Xchar *laststring;
	Xstrings()
	X{
	X    char  *create_string();
	X    char  buf[256];
	X    char  c, *p = buf;
	X    while(c = yyinput())
	X        switch(c) {
	X	    case '\'' : if((c = yyinput()) == '\'')
	X			    *p++ = c;
	X			else
	X			{   unput(c); *p++ = '\0';
	X			    laststring = create_string(buf);
	X			    return;
	X			}
	X			break;
	X	    case '\n' :
	X	    case '\014' :
	X	    case '\015': yyerror("String not terminated");
	X			return;
	X	    default   : *p++ = c;
	X			break;
	X	}
	X}
	X
	Xchar	numbertext[80];
	Xchar    lastident[128];
	X
	X%}
	X
	XA	[Aa]
	XB	[Bb]
	XC	[Cc]
	XD	[Dd]
	XE	[Ee]
	XF	[Ff]
	XG	[Gg]
	XH	[Hh]
	XI	[Ii]
	XJ	[Jj]
	XK	[Kk]
	XL	[Ll]
	XM	[Mm]
	XN	[Nn]
	XO	[Oo]
	XP	[Pp]
	XQ	[Qq]
	XR	[Rr]
	XS	[Ss]
	XT	[Tt]
	XU	[Uu]
	XV	[Vv]
	XW	[Ww]
	XX	[Xx]
	XY	[Yy]
	XZ	[Zz]
	X%%
	X\n				;
	X[ \t\32]			;
	X{A}{N}{D}			{ return(AND);		}
	X{A}{R}{R}{A}{Y}			{ return(ARRAY);	}
	X{B}{E}{G}{I}{N}			{ return(SBEGIN);	}
	X{C}{A}{S}{E}			{ return(CASE);		}
	X{C}{O}{N}{S}{T}			{ return(CONST);	}
	X{D}{I}{V}			{ return(DIV);		}
	X{D}{O}{W}{N}{T}{O}		{ return(DOWNTO);	}
	X{D}{O}				{ return(DO);		}
	X{E}{L}{S}{E}			{ return(ELSE);		}
	X{E}{N}{D}			{ return(END);		}
	X{F}{I}{L}{E}			{ return(SFILE);	}
	X{F}{O}{R}			{ return(FOR);		}
	X{F}{U}{N}{C}{T}{I}{O}{N}	{ return(FUNCTION);	}
	X{G}{O}{T}{O}			{ return(GOTO);		}
	X{I}{F}				{ return(IF);		}
	X{I}{N}				{ return(IN);		}
	X{L}{A}{B}{E}{L}			{ return(LABEL);	}
	X{M}{O}{D}			{ return(MOD);		}
	X{N}{I}{L}			{ return(NIL);		}
	X{N}{O}{T}			{ return(NOT);		}
	X{O}{F}				{ return(OF);		}
	X{O}{R}				{ return(OR);		}
	X{P}{A}{C}{K}{E}{D}		{ return(PACKED);	}
	X{P}{R}{O}{C}{E}{D}{U}{R}{E}	{ return(PROCEDURE);	}
	X{P}{R}{O}{G}{R}{A}{M}		{ return(PROGRAM);	}
	X{R}{E}{C}{O}{R}{D}		{ return(RECORD);	}
	X{R}{E}{P}{E}{A}{T}		{ return(REPEAT);	}
	X{S}{E}{T}			{ return(SET);		}
	X{T}{H}{E}{N}			{ return(THEN);		}
	X{T}{O}				{ return(TO);		}
	X{T}{Y}{P}{E}			{ return(TYPE);		}
	X{U}{N}{T}{I}{L}			{ return(UNTIL);	}
	X{V}{A}{R}			{ return(VAR);		}
	X{W}{H}{I}{L}{E}			{ return(WHILE);	}
	X{W}{I}{T}{H}			{ return(WITH);		}
	X
	X[a-zA-Z][a-zA-Z0-9_]*		{ strcpy(lastident, yytext);
	X				  return(IDENTIFIER);
	X						/*if strict check no '_' */}
	X"<="				{ return(LE);	}
	X">="				{ return(GE);	}
	X"<>"				{ return(NE);	}
	X":="				{ return(BECOMES);	}
	X".."				{ return(DOTDOT);	}
	X"(."				{ return('[');	}
	X".)"				{ return(']');	}
	X"-"	|
	X"+"	|
	X"*"	|
	X"/"	|
	X"="	|
	X"<"	|
	X">"	|
	X"("	|
	X")"	|
	X"["	|
	X"]"	|
	X"."	|
	X","	|
	X";"	|
	X":"	|
	X"^"	{ return(yytext[0]); }
	X"@"	{ return('^');	}
	X[0-9]+("."[0-9]+)?[eE][+-]?[0-9]+	|
	X[0-9]+"."[0-9]+				{ strcpy(numbertext,yytext);
	X					  return(UNSIGNED_REAL);	}
	X[0-9]+	{ strcpy(numbertext,yytext); return(UNSIGNED_INT);	}
	X
	X"{"	comment();
	X"(*"	comment();
	X'	{ strings(); return(STRING); }
	X"}"	yyerror("'}' not in comment");
	X.	{ char m[40];
	X	  sprintf(m,"Illegal character '\\%o'", (int)yytext[0]);
	X	  yyerror(m);
	X	}
SHAR_EOF
if test 3817 -ne "`wc -c < 'pascal.l'`"
then
	echo shar: "error transmitting 'pascal.l'" '(should have been 3817 characters)'
fi
fi
echo shar: "extracting 'pascal.y'" '(7510 characters)'
if test -f 'pascal.y'
then
	echo shar: "will not over-write existing file 'pascal.y'"
else
sed 's/^	X//' << \SHAR_EOF > 'pascal.y'
	X%{
	X#include <stdio.h>
	X#include "types.h"
	X