%{
/* $Id: pxsc.l,v 1.9 1996/06/19 08:15:56 ae59 Exp ae59 $ */
/******************************************************************************
		LEXICAL ANALYSER for ISO standard Pascal/PXSC
		---------------------------------------------

This lexical analyser satisfies the following requirements in British
Standards Institution Specification for Computer programming language Pascal
BS6192:1982 (ISO 7185:1983)

Extensions for PXSC by H. Berlejung

6.1.1	6.1.2	6.1.3	6.1.4	6.1.5	6.1.6	6.1.7
6.1.8	(except ^Z is considered to be a space)
6.1.9

******************************************************************************/

#include "pxsc_tab.h"
#include <stdio.h>
#include <string.h>
#include <sys/types.h>
#include "config.h"

#ifdef FLEX_SCANNER
#define yyinput input
#else
#undef input
#undef unput
_PROTOTYPE(int input,(VOID));
_PROTOTYPE(VOID unput,(int c));
#endif

#undef ECHO

VOID (*echofct)();
#define ECHO (*echofct)()


#define ECHOC(c) { \
	if (echoinp&&report_id++==0) fprintf(yyout, "%4d:",lines); \
	if (echoinp||trace)  fprintf(yyout, "%c",c);\
	if (echoinp&&c =='\n') fprintf(yyout, "%4d:",lines);\
	}

_PROTOTYPE(VOID Comment,(int c));
_PROTOTYPE(VOID strings,(VOID));

static char RCSid[] = "$Id: pxsc.l,v 1.9 1996/06/19 08:15:56 ae59 Exp ae59 $";

/* metrics' parameters */

extern int lines;
extern int inslines;
extern int blanklines;
extern int commentlines;
extern int checkbegin;
extern int trace;
extern int pathlen	;
extern char lastline[]	;
char *laststring;
extern char outbuffer[];


extern int echoinp;

int	report_id 		= 0; /* flags line numbering                        */
int	ins_line  		= 0; /* flags instruction occurence in current line */

_PROTOTYPE(VOID fempty,(void));
VOID fempty()
{
}
int scmp(str1,str2)
char *str1;
char *str2;
{
	static char buffer[80];
	char *p=buffer;
	while (*str1 && *str2)
		if (toupper(*str1++)!=toupper(*str2++)) return 0;
	return (*str1==*str2)? 1: 0;
}

_PROTOTYPE(VOID fecho,(void));
VOID fecho()
{ 	strcpy(lastline,yytext);
	if (echoinp&&report_id++==0) fprintf(yyout, "%4d:",lines);
	if (trace && outbuffer[0] !=EOS &&((*yytext !=EOLN && *yytext !=' ') 
		/*|| *outbuffer == 'B'*/)&&*yytext !='{' &&*yytext!='(')
	{ 
		fprintf(yyout, "%s %s",outbuffer, 
		(scmp(yytext,"BEGIN")) ? "":yytext);outbuffer[0]=EOS;
	} 
	else  if (echoinp||trace) fprintf(yyout, "%s",yytext);  
	if (echoinp&&yytext[yyleng-1] =='\n') fprintf(yyout, "%4d:",lines);
}
void InitParserVars()
{
	report_id 		= 0; 
	ins_line  		= 0; 
	echofct=(trace) ? fecho:fempty;
	echofct= fecho;
}

#ifndef FLEX_SCANNER
int  input()
{
    if(yysptr > yysbuf) yytchar = U(*--yysptr);
    else yytchar = getc(yyin);
    if(yytchar == '\n'||yytchar == EOF) 
    {
    }
    else if(yytchar == 0)   {yytchar= ' ';};
    return yytchar;
}

VOID unput(c)
int c;
{
    yytchar = c;
    *yysptr++ = yytchar;
}
#endif

VOID FlushFile()
{
	char c;
	int blanks=1;
	while ((c=yyinput())!=EOF)
	{
		if (c==EOLN) 
		{	if ((c=yyinput())==EOF) return;
			else 
			{	if (blanks) blanklines++;
				blanks=1;lines++; unput(c);
		  	}
		}
		else blanks=blanks && (c==' ' || c=='\t');
		ECHOC(c);
	};
	return;
}

VOID Comment(c)
char c;
{
    ECHO;
    commentlines++; /* counts single-lined comments */
    switch (c)
    {
     case '(': 
		{char  lastc=' ';
    	 	while(c = yyinput())
		{
			if (c==EOLN)  {lines++;commentlines++;}
			ECHOC(c);
			if ((lastc=='*' && c==')')|| c=='}') return;
			lastc=c;
		}
		break;
		}
     case '$': 
		{ char lastc=' ',llast=' ';
    	 	while(c = yyinput())
		{
			if (c==EOLN) {lines++;commentlines++;}
			ECHOC(c);
			if(llast=='$' && (toupper(lastc)=='O') && (toupper(c)=='N')) 
			{
				return;
			}
			else 
			{
    	    			llast = lastc; 	
			     lastc=c;
			}
		}
		break;
		}
	}
	if (c == ' ') 
		yyerror("Unexpected eof while reading comment");
	return;
}


VOID strings()
{
    char  *create_string();
    char  buf[256];
    char  c, *p = buf;
    while(c = yyinput())
    {
        switch(c) {
	    case '\'' : 
			if((c = yyinput()) == '\'')
			{   *p++ = c;
			    ECHOC(c);
			    ECHOC(c);
			}
			else
			{   unput(c); *p++ = '\0';
			    laststring = create_string(buf);
			    return;
			}
			break;
	    case EOLN :
	    case '\014' :
	    case '\015': yyerror("String not terminated");
			return;
	    default   : *p++ = c;
    			ECHOC(c);
			break;
	  }
	}
}

char	numbertext[80];
char    lastident[128];

%}
%a 6800
%o 10000
%k 700
%e 1200
A	[Aa]
B	[Bb]
C	[Cc]
D	[Dd]
E	[Ee]
F	[Ff]
G	[Gg]
H	[Hh]
I	[Ii]
J	[Jj]
K	[Kk]
L	[Ll]
M	[Mm]
N	[Nn]
O	[Oo]
P	[Pp]
Q	[Qq]
R	[Rr]
S	[Ss]
T	[Tt]
U	[Uu]
V	[Vv]
W	[Ww]
X	[Xx]
Y	[Yy]
Z	[Zz]
%%
^[ \t]*[\n]			{ins_line=0;lines++;blanklines++; ECHO; 	}
\n					{if (ins_line) inslines++;
					 else ins_line=0;lines++;ECHO;	}
[ \t\32]				{ECHO ;				}
{A}{N}{D}				{ins_line=1;ECHO;return(AND);		}
{A}{R}{R}{A}{Y}		{ins_line=1;ECHO;return(ARRAY);	}
{B}{E}{G}{I}{N}		{ins_line=1;ECHO;return(SBEGIN);	}
{B}{O}{O}{L}{E}{A}{N}	{ins_line=1;ECHO;return(TBOOLEAN);	}
{C}{A}{S}{E}			{ins_line=1;ECHO;return(CASE);		}
{C}{H}{A}{R}			{ins_line=1;ECHO;return(TCHAR);	}
{C}{O}{M}{P}{L}{E}{X}	{ins_line=1;ECHO;return(TCOMPLEX);	}
{C}{O}{N}{S}{T}		{ins_line=1;ECHO;return(CONST);	}
{D}{I}{V}				{ins_line=1;ECHO;return(DIV);		}
{D}{O}{W}{N}{T}{O}		{ins_line=1;ECHO;return(DOWNTO);	}
{D}{O}				{ins_line=1;ECHO;return(DO);		}
{D}{Y}{N}{A}{M}{I}{C}	{ins_line=1;ECHO;return(DYNAMIC);	}
{E}{L}{S}{E}			{ins_line=1;if (!trace) ECHO;else  strcpy(lastline,yytext);return(ELSE);		}
{E}{N}{D}				{ins_line=1;ECHO;return(END);		}
{E}{X}{T}{E}{R}{N}{A}{L}	{ins_line=1;ECHO;return(EXTERNAL);	}
{F}{I}{L}{E}			{ins_line=1;ECHO;return(SFILE);	}
{F}{O}{R}{W}{A}{R}{D}	{ins_line=1;ECHO;return(FORWARD);		}
{F}{O}{R}				{ins_line=1;ECHO;return(FOR);		}
{F}{U}{N}{C}{T}{I}{O}{N}	{ins_line=1;ECHO;return(FUNCTION);	}
{G}{O}{T}{O}			{ins_line=1;ECHO;return(GOTO);		}
{G}{L}{O}{B}{A}{L}		{ins_line=1;ECHO;return(GLOBAL);	}
{I}{F}				{ins_line=1;ECHO;return(IF);		}
{I}{N}				{ins_line=1;ECHO;return(IN);		}
{I}{N}{T}{E}{G}{E}{R}	{ins_line=1;ECHO;return(TINTEGER);	}
{I}{N}{T}{E}{R}{V}{A}{L}	{ins_line=1;ECHO;return(TINTERVAL);	}
{L}{A}{B}{E}{L}		{ins_line=1;ECHO;return(LABEL);	}
{M}{O}{D}				{ins_line=1;ECHO;return(MOD);		}
{M}{O}{D}{U}{L}{E}		{ins_line=1;ECHO;return(MODULE);	}
{N}{I}{L}				{ins_line=1;ECHO;return(NIL);		}
{N}{O}{T}				{ins_line=1;ECHO;return(NOT);		}
{O}{F}				{ins_line=1;ECHO;return(OF);		}
{O}{R}				{ins_line=1;ECHO;return(OR);		}
{O}{P}{E}{R}{A}{T}{O}{R}	{ins_line=1;ECHO;return(OPERATOR);	}
{P}{A}{C}{K}{E}{D}		{ins_line=1;ECHO;return(PACKED);	}
{P}{R}{I}{O}{R}{I}{T}{Y}	{ins_line=1;ECHO;return(PRIORITY);	}
{P}{R}{O}{C}{E}{D}{U}{R}{E}	{ins_line=1;ECHO;return(PROCEDURE);	}
{P}{R}{O}{G}{R}{A}{M}	{ins_line=1;ECHO;return(PROGRAM);	}
{R}{E}{C}{O}{R}{D}		{ins_line=1;ECHO;return(RECORD);	}
{R}{E}{P}{E}{A}{T}		{ins_line=1;ECHO;return(REPEAT);	}
{R}{E}{A}{L}			{ins_line=1;ECHO;return(TREAL);	}
{R}{E}{A}{L}{C}{O}{N}{S}{T}{A}{N}{T}{C}{O}{N}{V}{E}{R}{S}{I}{O}{N}			{ins_line=1;ECHO;return(REALCC);	}
{S}{E}{T}				{ins_line=1;ECHO;return(SET);		}
{S}{T}{R}{I}{N}{G}		{ins_line=1;ECHO;return(TSTRING);	}
{S}{U}{M}				{ins_line=1;ECHO;return(SUM);		}
{T}{E}{X}{T}			{ins_line=1;ECHO;return(TTEXT);	}
{T}{H}{E}{N}			{ins_line=1;ECHO;return(THEN);		}
{T}{O}				{ins_line=1;ECHO;return(TO);		}
{T}{Y}{P}{E}			{ins_line=1;ECHO;return(TYPE);		}
{U}{N}{T}{I}{L}		{ins_line=1;ECHO;return(UNTIL);	}
{U}{S}{E}				{ins_line=1;ECHO;return(USE);		}
{V}{A}{R}				{ins_line=1;ECHO;return(VAR);		}
{W}{H}{I}{L}{E}		{ins_line=1;ECHO;return(WHILE);	}
{W}{I}{T}{H}			{ins_line=1;ECHO;return(WITH);		}
"$"{O}{F}{F} 			{Comment('$');			}
"$"{O}{N} 			{ECHO;			}



[a-zA-Z_][a-zA-Z0-9_]*	{ins_line=1; strcpy(lastident, yytext);
				  ECHO;return(IDENTIFIER);
					/*if strict check no '_' */}
"<="				{ ins_line=1;ECHO;return(LE);		}
">="				{ ins_line=1;ECHO;return(GE);		}
"<>"				{ ins_line=1;ECHO;return(NE);		}
":="				{ ins_line=1;ECHO;return(BECOMES);	}
".."				{ ins_line=1;ECHO;return(DOTDOT);	}
"(."				{ ins_line=1;ECHO;return('[');		}
"(<"				{ ins_line=1;ECHO;return(CCD);		}
"(>"				{ ins_line=1;ECHO;return(CCU);		}
".)"				{ ins_line=1;ECHO;return(']');		}
"+>"				{ ins_line=1;ECHO;return(ADDU);	}
"+<"				{ ins_line=1;ECHO;return(ADDD);	}
"->"				{ ins_line=1;ECHO;return(ADDU);	}
"-<"				{ ins_line=1;ECHO;return(ADDD);	}
"*>"				{ ins_line=1;ECHO;return(MULU);	}
"*<"				{ ins_line=1;ECHO;return(MULD);	}
"/>"				{ ins_line=1;ECHO;return(DIVU);	}
"/<"				{ ins_line=1;ECHO;return(DIVD);	}
"#*"				{ ins_line=1;ECHO;return(DOTN);	}
"#>"				{ ins_line=1;ECHO;return(DOTU);	}
"#<"				{ ins_line=1;ECHO;return(DOTD);	}
"##"				{ ins_line=1;ECHO;return(DOTI);	}
"**"				{ ins_line=1;ECHO;return(STARSTAR);	}
"+*"				{ ins_line=1;ECHO;return(PSTAR);	}
"><"				{ ins_line=1;ECHO;return(GTLT);	}
"#"	|
"-"	|
"+"	|
"*"	|
"/"	|
"="	|
"<"	|
">"	|
"("	|
")"	|
"["	|
"]"	|
"."	|
","	|
";"	|
":"	|
"^"	{ ins_line=1;ECHO;return(yytext[0]); }
"@"	{ ins_line=1;ECHO;return('^');	}
[0-9]+("."[0-9]+)?[eE][+-]?[0-9]+	|
[0-9]+"."[0-9]+				{ strcpy(numbertext,yytext);
					  ins_line=1;ECHO;return(UNSIGNED_REAL);	}
[0-9]+		{ strcpy(numbertext,yytext); ins_line=1;ECHO;
			return(UNSIGNED_INT);	}
[0-9a-fA-F]+	{ ins_line=1;strcpy(numbertext,yytext); ECHO;return(HDS);	}

"{"	{Comment('(');}
"(*"	{Comment('(');}
'	{ ins_line=1;ECHO;strings(); ECHO;return(STRING); }
"}"	yyerror("'}' not in comment");
"*)"	yyerror("'*)' not in comment");
"
" {}
.	{ char m[40];
	  sprintf(m,"Illegal character '\\%o'", (int)yytext[0]);
	  yyerror(m);
	}

