612 lines
14 KiB
Plaintext
612 lines
14 KiB
Plaintext
/*
|
|
* (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
|
|
* See the copyright notice in the ACK home directory, in the file "Copyright".
|
|
*/
|
|
|
|
|
|
|
|
|
|
/* This file contains the new lexical analizer */
|
|
typedef struct {
|
|
char *name;
|
|
int token;
|
|
int classvalue;
|
|
int length;
|
|
} Key;
|
|
|
|
Key keywords [] ={
|
|
{"abs", FUNCTION, ABSSYM, 0},
|
|
{"and", ANDSYM, ANDSYM, 0},
|
|
{"asc", FUNCTION, ASCSYM, 0},
|
|
{"as", ASSYM, 0, 0},
|
|
{"atn", FUNCTION, ATNSYM, 0},
|
|
{"auto", ILLEGAL, 0, 0},
|
|
{"base", BASESYM, 0, 0},
|
|
{"call", CALLSYM, 0, 0},
|
|
{"cdbl", FUNCTION, CDBLSYM, 0},
|
|
{"chain", ILLEGAL, 0, 0},
|
|
{"chr", FUNCTION, CHRSYM, 0},
|
|
{"cint", FUNCTION, CINTSYM, 0},
|
|
{"clear", CLEARSYM, 0, 0},
|
|
{"cload", ILLEGAL, 0, 0},
|
|
{"close", CLOSESYM, 0, 0},
|
|
{"common", ILLEGAL, 0, 0},
|
|
{"cont", ILLEGAL, 0, 0},
|
|
{"cos", FUNCTION, COSSYM, 0},
|
|
{"csng", FUNCTION, CSNGSYM, 0},
|
|
{"csave", ILLEGAL, 0, 0},
|
|
{"cvi", FUNCTION, CVISYM, 0},
|
|
{"cvs", FUNCTION, CVSSYM, 0},
|
|
{"cvd", FUNCTION, CVDSYM, 0},
|
|
{"data", DATASYM, 0, 0},
|
|
{"defint", DEFINTSYM, 0, 0},
|
|
{"defsng", DEFSNGSYM, 0, 0},
|
|
{"defdbl", DEFDBLSYM, 0, 0},
|
|
{"defstr", DEFSTRSYM, 0, 0},
|
|
{"def", DEFSYM, 0, 0},
|
|
{"delete", ILLEGAL, 0, 0},
|
|
{"dim", DIMSYM, 0, 0},
|
|
{"edit", ILLEGAL, 0, 0},
|
|
{"else", ELSESYM, 0, 0},
|
|
{"end", ENDSYM, 0, 0},
|
|
{"eof", FUNCTION, EOFSYM, 0},
|
|
{"eqv", EQVSYM, EQVSYM, 0},
|
|
{"erase", ILLEGAL, 0, 0},
|
|
{"error", ERRORSYM, 0, 0},
|
|
{"err", ERRSYM, 0, 0},
|
|
{"erl", ERLSYM, 0, 0},
|
|
{"exp", FUNCTION, EXPSYM, 0},
|
|
{"field", FIELDSYM, 0, 0},
|
|
{"fix", FUNCTION, FIXSYM, 0},
|
|
{"for", FORSYM, 0, 0},
|
|
{"fre", FUNCTION, FRESYM, 0},
|
|
{"get", GETSYM, 0, 0},
|
|
{"gosub", GOSUBSYM, 0, 0},
|
|
{"goto", GOTOSYM, 0, 0},
|
|
{"hex", FUNCTION, HEXSYM, 0},
|
|
{"if", IFSYM, 0, 0},
|
|
{"imp", IMPSYM, IMPSYM, 0},
|
|
{"inkey", INKEYSYM, 0, 0},
|
|
{"input", INPUTSYM, 0, 0},
|
|
{"inp", FUNCTION, INPSYM, 0},
|
|
{"instr", FUNCTION, INSTRSYM, 0},
|
|
{"int", FUNCTION, INTSYM, 0},
|
|
{"kill", ILLEGAL, 0, 0},
|
|
{"left", FUNCTION, LEFTSYM, 0},
|
|
{"len", FUNCTION, LENSYM, 0},
|
|
{"let", LETSYM, 0, 0},
|
|
{"line", LINESYM, 0, 0},
|
|
{"list", LISTSYM, 0, 0},
|
|
{"llist", ILLEGAL, 0, 0},
|
|
{"load", LOADSYM, 0, 0},
|
|
{"loc", FUNCTION, LOCSYM, 0},
|
|
{"log", FUNCTION, LOGSYM, 0},
|
|
{"lpos", FUNCTION, LPOSSYM, 0},
|
|
{"lprint", ILLEGAL, 0, 0},
|
|
{"lset", LSETSYM, 0, 0},
|
|
{"merge", MERGESYM, 0, 0},
|
|
{"mid", MIDSYM, 0, 0},
|
|
{"mki", FUNCTION, MKISYM, 0},
|
|
{"mks", FUNCTION, MKSSYM, 0},
|
|
{"mkd", FUNCTION, MKDSYM, 0},
|
|
{"mod", MODSYM, 0, 0},
|
|
{"name", ILLEGAL, 0, 0},
|
|
{"new", ILLEGAL, 0, 0},
|
|
{"next", NEXTSYM, 0, 0},
|
|
{"not", NOTSYM, 0, 0},
|
|
{"null", ILLEGAL, 0, 0},
|
|
{"on", ONSYM, 0, 0},
|
|
{"oct", FUNCTION, OCTSYM, 0},
|
|
{"open", OPENSYM, 0, 0},
|
|
{"option", OPTIONSYM, 0, 0},
|
|
{"or", ORSYM, ORSYM, 0},
|
|
{"out", FUNCTION, OUTSYM, 0},
|
|
{"peek", PEEKSYM, 0, 0},
|
|
{"poke", POKESYM, 0, 0},
|
|
{"print", PRINTSYM, 0, 0},
|
|
{"pos", FUNCTION, POSSYM, 0},
|
|
{"put", PUTSYM, 0, 0},
|
|
{"randomize", RANDOMIZESYM, 0, 0},
|
|
{"read", READSYM, 0, 0},
|
|
{"rem", REMSYM, 0, 0},
|
|
{"renum", ILLEGAL, 0, 0},
|
|
{"ren", ILLEGAL, 0, 0},
|
|
{"restore", RESTORESYM, 0, 0},
|
|
{"resume", ILLEGAL, 0, 0},
|
|
{"return", RETURNSYM, 0, 0},
|
|
{"right", FUNCTION, RIGHTSYM, 0},
|
|
{"rnd", FUNCTION, RNDSYM, 0},
|
|
{"run", ILLEGAL, 0, 0},
|
|
{"save", ILLEGAL, 0, 0},
|
|
{"step", STEPSYM, 0, 0},
|
|
{"sgn", FUNCTION, SGNSYM, 0},
|
|
{"sin", FUNCTION, SINSYM, 0},
|
|
{"space", FUNCTION, SPACESYM, 0},
|
|
{"spc", FUNCTION, SPCSYM, 0},
|
|
{"sqr", FUNCTION, SQRSYM, 0},
|
|
{"stop", STOPSYM, 0, 0},
|
|
{"string", FUNCTION, STRINGSYM, 0},
|
|
{"str", FUNCTION, STRSYM, 0},
|
|
{"swap", SWAPSYM, 0, 0},
|
|
{"tab", FUNCTION, TABSYM, 0},
|
|
{"tan", FUNCTION, TANSYM, 0},
|
|
{"then", THENSYM, 0, 0},
|
|
{"to", TOSYM, 0, 0},
|
|
{"tron", TRONOFFSYM, TRONSYM, 0},
|
|
{"troff", TRONOFFSYM, TROFFSYM, 0},
|
|
{"using", USINGSYM, 0, 0},
|
|
{"usr", FUNCTION, USRSYM, 0},
|
|
{"val", FUNCTION, VALSYM, 0},
|
|
{"varptr", FUNCTION, VARPTRSYM, 0},
|
|
{"wait", ILLEGAL, 0, 0},
|
|
{"while", WHILESYM, 0, 0},
|
|
{"wend", WENDSYM, 0, 0},
|
|
{"width", ILLEGAL, 0, 0},
|
|
{"write", WRITESYM, 0, 0},
|
|
{"xor", XORSYM, XORSYM, 0},
|
|
{0, 0, 0, 0}
|
|
};
|
|
|
|
/* Keyword index table */
|
|
|
|
int kex[27];
|
|
|
|
/* Initialize the keyword table */
|
|
void fillkex(void)
|
|
{
|
|
Key *k;
|
|
int i;
|
|
for(k=keywords;k->name;k++)
|
|
k->length= strlen(k->name);
|
|
k=keywords;
|
|
for(i=0;k->name && i<='z'-'a';i++)
|
|
{
|
|
for(;k->name && *k->name<i+'a';k++);
|
|
if ( *k->name!=i+'a') continue;
|
|
kex[*k->name-'a']=k-keywords;
|
|
for(;k->name && *k->name==i+'a';k++);
|
|
kex[*(k-1)->name-'a'+1]=k-keywords;
|
|
}
|
|
if (debug)
|
|
{
|
|
for(i=0;i<27;i++)
|
|
print("%c:%d\n",'a'+i,kex[i]);
|
|
}
|
|
}
|
|
|
|
#include <ctype.h>
|
|
|
|
/* Get each line separately into the buffer */
|
|
/* Lines too long are terminated and flagged illegal */
|
|
|
|
#define MAXLINELENGTH 1024
|
|
|
|
char inputline[MAXLINELENGTH]; /* current source line */
|
|
char *cptr; /* next character to decode */
|
|
int yylineno=0; /* source line counter */
|
|
|
|
#define GETSBUFSIZE 1024
|
|
|
|
char fgets_buf[GETSBUFSIZE];
|
|
|
|
|
|
|
|
char *our_fgets(buffer,n_char,stream)
|
|
char *buffer;
|
|
int n_char;
|
|
File *stream;
|
|
{
|
|
/* Read one line or n_char */
|
|
static int characters_left = 0;
|
|
static char *internal_bufp = fgets_buf;
|
|
char *external_bufp;
|
|
|
|
external_bufp = buffer; /* Moves through the external buffer */
|
|
while ( 1 ) {
|
|
if ( characters_left ) { /* There is still something buffered */
|
|
if ( n_char > 1 ) { /* More characters have to be copied */
|
|
if ( *internal_bufp == '\n' ) {
|
|
*external_bufp++ = *internal_bufp++;
|
|
characters_left--;
|
|
*external_bufp = '\0';
|
|
return(buffer); /* One line is read */
|
|
} else {
|
|
*external_bufp++ = *internal_bufp++;
|
|
characters_left--;
|
|
n_char--; /* One character is copied */
|
|
}
|
|
} else { /* Enough characters read */
|
|
*external_bufp = '\0';
|
|
return(buffer);
|
|
}
|
|
} else { /* Read new block */
|
|
sys_read(stream,fgets_buf,GETSBUFSIZE,&characters_left);
|
|
internal_bufp = fgets_buf;
|
|
/* Move pointer back to the beginning */
|
|
if ( characters_left == 0 ) { /* Nothing read */
|
|
if ( external_bufp == buffer ) {
|
|
*external_bufp = '\0';
|
|
return(0); /* EOF */
|
|
} else { /* Something was already copied */
|
|
*external_bufp = '\0';
|
|
return(buffer);
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
int getinputline(void)
|
|
{
|
|
/* get next input line */
|
|
|
|
if ( our_fgets(inputline,MAXLINELENGTH,yyin) == 0)
|
|
return(FALSE);
|
|
yylineno ++;
|
|
if ( strchr(inputline,'\n') == 0)
|
|
error("source line too long");
|
|
inputline[MAXLINELENGTH-1]=0;
|
|
if ( listing)
|
|
fprint(STDERR, inputline);
|
|
cptr= inputline;
|
|
return(TRUE);
|
|
}
|
|
|
|
|
|
|
|
|
|
|
|
int typechar(void)
|
|
{
|
|
switch(*cptr)
|
|
{
|
|
case '$':
|
|
cptr++; return( STRINGTYPE);
|
|
case '%':
|
|
cptr++; return( INTTYPE);
|
|
case '!':
|
|
cptr++; return( FLOATTYPE);
|
|
case '#':
|
|
cptr++; return( DOUBLETYPE);
|
|
}
|
|
return(0);
|
|
}
|
|
|
|
|
|
/* symbols in Microsoft are significant for the first 40 characters */
|
|
#define SIGNIFICANT 40
|
|
char name[SIGNIFICANT+1];
|
|
|
|
|
|
int lookup(void)
|
|
{
|
|
Key *k;
|
|
Symbol *Sym;
|
|
char *c;
|
|
int i, typech;
|
|
|
|
sval= name;
|
|
for(c=cptr; *c && isalnum(*c);c++)
|
|
if ( isupper(*c) )
|
|
*c= tolower(*c);
|
|
for (k= keywords+kex[*cptr-'a']; k->name != 0 && *(k->name)== *cptr;k++)
|
|
if ( strncmp(cptr,k->name,k->length)==0)
|
|
{
|
|
/* if ( isalnum( *(cptr+k->length) )) *//* EHB */
|
|
if ( isalnum( *(cptr+k->length) ) && /* EHB */
|
|
k->token == FUNCTION) /* EHB */
|
|
continue;
|
|
/* keywords door delimiters gescheiden */
|
|
cptr += k->length;
|
|
yylval.integer= k->classvalue;
|
|
if (debug) print("lookup:%d %d\n",
|
|
k->classvalue,k->token);
|
|
if ( k->token == FUNCTION)
|
|
{
|
|
/* stripp type character */
|
|
typech=typechar();
|
|
}
|
|
/* illegals + rem */
|
|
if ( k->token == REMSYM || k->token==ILLEGAL)
|
|
while ( *cptr && *cptr!=':' &&
|
|
*cptr!='\n')
|
|
cptr++;
|
|
return( k->token);
|
|
}
|
|
/* Is it a function name ? */
|
|
c=cptr;
|
|
/* Identifier found, update the symbol table */
|
|
i=0;
|
|
while (( isalnum(*c) || *c == '.') && i < SIGNIFICANT)
|
|
name[i++]= *c++;
|
|
while (isalnum(*c) || *c == '.') c++; /* skip rest */
|
|
name[i]=0;
|
|
cptr=c;
|
|
Sym= srchsymbol(name);
|
|
yylval.Sptr = Sym;
|
|
typech= typechar();
|
|
if (Sym->symtype!=DEFAULTTYPE)
|
|
{
|
|
if (typech && typech!=Sym->symtype && wflag)
|
|
warning("type re-declared,ignored");
|
|
}
|
|
if ( typech)
|
|
Sym->symtype=typech;
|
|
if (debug) print("lookup:%d Identifier\n",Sym);
|
|
if ( (name[0]=='f' || name[0]=='F') &&
|
|
(name[1]=='n' || name[1]=='N') )
|
|
return(FUNCTID);
|
|
return(IDENTIFIER);
|
|
}
|
|
|
|
|
|
|
|
/* Parsing unsigned numbers */
|
|
int readconstant(void)
|
|
{
|
|
/* read HEX and OCTAL numbers */
|
|
char *c;
|
|
cptr++;
|
|
if ( *cptr == 'H' || *cptr=='h')
|
|
{
|
|
/* HEX */
|
|
cptr++;
|
|
c=cptr;
|
|
while ( isdigit(*cptr) ||
|
|
(*cptr>='a' && *cptr<='f' ) ||
|
|
(*cptr>='A' && *cptr<='F' ) ) cptr++;
|
|
(void) sscanf(c,"%x",&ival);
|
|
} else
|
|
if ( *cptr == 'O' || *cptr == 'o')
|
|
{
|
|
/* OCTAL */
|
|
cptr++;
|
|
c=cptr;
|
|
while ( isdigit(*cptr) ) cptr++;
|
|
(void) sscanf(c,"%o",&ival);
|
|
} else error("H or O expected");
|
|
return(INTVALUE);
|
|
}
|
|
|
|
|
|
|
|
#ifdef ____
|
|
/* Computes base to the power exponent. This was not done in the old
|
|
compiler */
|
|
double powr(double base,int exp)
|
|
{
|
|
int i;
|
|
double result;
|
|
int abs_exp;
|
|
|
|
if ( exp < 0 )
|
|
abs_exp = -exp;
|
|
else
|
|
abs_exp = exp;
|
|
|
|
result = 1.0;
|
|
for ( i = 1; i <= abs_exp; i++ ) {
|
|
result = result * base;
|
|
}
|
|
|
|
if ( exp < 0 )
|
|
return ( 1.0 / result );
|
|
else
|
|
return ( result );
|
|
}
|
|
#endif
|
|
|
|
|
|
int number(void)
|
|
{
|
|
long i1;
|
|
int overflow = 0;
|
|
register char *c;
|
|
static char numbuf[256];
|
|
register char *d = numbuf;
|
|
|
|
dval = numbuf;
|
|
i1=0;
|
|
c=cptr;
|
|
while (*c == '0') c++;
|
|
while (isdigit(*c)){
|
|
i1= i1*10 + *c-'0';
|
|
if (i1 < 0) overflow = 1;
|
|
if (d < &numbuf[255]) *d++ = *c;
|
|
c++;
|
|
}
|
|
if (d == numbuf) *d++ = '0';
|
|
cptr=c;
|
|
if ( *c != '.' && *c != 'e' && *c != 'E'
|
|
&& *c != 'd' && *c != 'D' ){
|
|
if ( i1> MAXINT || i1<MININT || overflow) {
|
|
*d = 0;
|
|
return(FLTVALUE);
|
|
}
|
|
/*NOSTRICT*/ ival= i1;
|
|
#ifdef YYDEBUG
|
|
if (yydebug) print("number:INTVALUE %d",i1);
|
|
#endif
|
|
return(INTVALUE);
|
|
}
|
|
/* handle floats */
|
|
if (*c == '.') {
|
|
if (d < &numbuf[255]) *d++ = *c;
|
|
c++;
|
|
while ( isdigit(*c)){
|
|
if (d < &numbuf[255]) *d++ = *c;
|
|
c++;
|
|
}
|
|
}
|
|
/* handle exponential part */
|
|
if ( *c == 'e' || *c == 'E' || *c == 'd' || *c == 'D' ){
|
|
if (d < &numbuf[254]) *d++ = 'e';
|
|
c++;
|
|
if ( *c=='-' || *c=='+') {
|
|
if (d < &numbuf[255]) *d++ = *c;
|
|
c++;
|
|
}
|
|
while (isdigit(*c)){
|
|
if (d < &numbuf[255]) *d++ = *c;
|
|
c++;
|
|
}
|
|
if (*(d-1) == 'e') *d++ = '0';
|
|
}
|
|
*d = 0;
|
|
cptr=c;
|
|
#ifdef YYDEBUG
|
|
if (yydebug) print("number:FLTVALUE %s",dval);
|
|
#endif
|
|
return(FLTVALUE);
|
|
}
|
|
|
|
|
|
|
|
/* Maximale grootte van een chunk; >= 4 */
|
|
#define CHUNKSIZE 123
|
|
|
|
|
|
|
|
int scanstring(void)
|
|
{
|
|
int i,length=0;
|
|
char firstchar = *cptr;
|
|
char buffer[CHUNKSIZE],*bufp = buffer;
|
|
|
|
/* generate label here */
|
|
if (! in_data) yylval.integer= genemlabel();
|
|
if ( *cptr== '"') cptr++;
|
|
sval= cptr;
|
|
while ( *cptr !='"')
|
|
{
|
|
switch(*cptr)
|
|
{
|
|
case 0:
|
|
case '\n':
|
|
#ifdef YYDEBUG
|
|
if (yydebug) print("STRVALUE\n");
|
|
#endif
|
|
if ( firstchar == '"')
|
|
error("non-terminated string");
|
|
return(STRVALUE);
|
|
/*
|
|
case '\'':
|
|
case '\\':
|
|
*bufp++ = '\\';
|
|
*bufp++ = *cptr;
|
|
if ( bufp >= buffer + CHUNKSIZE - 4 ) {
|
|
if (! in_data)
|
|
C_con_scon(buffer,(arith)(bufp-buffer));
|
|
bufp = buffer;
|
|
}
|
|
break;
|
|
*/
|
|
default:
|
|
*bufp++ = *cptr;
|
|
if ( bufp >= buffer + CHUNKSIZE - 4 ) {
|
|
if (! in_data)
|
|
C_con_scon(buffer,(arith)(bufp-buffer));
|
|
bufp = buffer;
|
|
}
|
|
}
|
|
cptr++;
|
|
length++;
|
|
}
|
|
*cptr = 0;
|
|
*bufp++ = 0;
|
|
cptr++;
|
|
if (! in_data) {
|
|
C_con_scon(buffer,(arith)(bufp-buffer));
|
|
i=yylval.integer;
|
|
yylval.integer= genemlabel();
|
|
C_rom_dlb((label)i,(arith)0);
|
|
C_rom_icon("9999",(arith)BEMINTSIZE);
|
|
C_rom_icon(myitoa(length),(arith)BEMINTSIZE);
|
|
}
|
|
#ifdef YYDEBUG
|
|
if (yydebug) print("STRVALUE found\n");
|
|
#endif
|
|
return(STRVALUE);
|
|
}
|
|
|
|
|
|
|
|
int yylex(void)
|
|
{
|
|
char *c;
|
|
|
|
/* Here is the big switch */
|
|
c= cptr;
|
|
switch(*c){
|
|
case 'a': case 'b': case 'c': case 'd': case 'e':
|
|
case 'f': case 'g': case 'h': case 'i': case 'j':
|
|
case 'k': case 'l': case 'm': case 'n': case 'o':
|
|
case 'p': case 'q': case 'r': case 's': case 't':
|
|
case 'u': case 'v': case 'w': case 'x': case 'y':
|
|
case 'z': case 'A': case 'B': case 'C': case 'D':
|
|
case 'E': case 'F': case 'G': case 'H': case 'I':
|
|
case 'J': case 'K': case 'L': case 'M': case 'N':
|
|
case 'O': case 'P': case 'Q': case 'R': case 'S':
|
|
case 'T': case 'U': case 'V': case 'W': case 'X':
|
|
case 'Y': case 'Z': case '_':
|
|
return(lookup());
|
|
|
|
case '0': case '1': case '2': case '3': case '4':
|
|
case '5': case '6': case '7': case '8': case '9':
|
|
case '.':
|
|
return(number());
|
|
|
|
case '\'':
|
|
/* comment at end of line */
|
|
while ( *cptr != '\n' && *cptr) cptr++;
|
|
case '\n':
|
|
cptr++;
|
|
return(EOLN);
|
|
case 0:
|
|
#ifdef YYDEBUG
|
|
if ( yydebug) print("end of buffer");
|
|
#endif
|
|
return(0);
|
|
case '"':
|
|
return(scanstring());
|
|
/* handle double operators */
|
|
case ' ':
|
|
case '\t':
|
|
case '\r':
|
|
cptr++;
|
|
return(yylex());
|
|
case '&':
|
|
return(readconstant());
|
|
case '?':
|
|
cptr++;
|
|
return(PRINTSYM);
|
|
case '>':
|
|
if ( *(c+1)=='='){
|
|
c++; c++;
|
|
cptr=c;
|
|
yylval.integer= GESYM;
|
|
return(RELOP);
|
|
}
|
|
yylval.integer= '>';
|
|
cptr++;
|
|
return(RELOP);
|
|
case '<':
|
|
if ( *(c+1)=='='){
|
|
c++; c++;
|
|
cptr=c;
|
|
yylval.integer=LESYM;
|
|
return(RELOP);
|
|
} else
|
|
if ( *(c+1)=='>'){
|
|
c++; c++;
|
|
cptr=c;
|
|
yylval.integer=NESYM;
|
|
return(RELOP);
|
|
}
|
|
yylval.integer= '<';
|
|
cptr++;
|
|
return(RELOP);
|
|
}
|
|
return(*cptr++);
|
|
}
|