home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The C Users' Group Library 1994 August
/
wc-cdrom-cusersgrouplibrary-1994-08.iso
/
vol_100
/
131_01
/
alex.c
< prev
next >
Wrap
C/C++ Source or Header
|
1985-03-10
|
8KB
|
386 lines
/*
************************************************************
ACRL Scanner
************************************************************
W. Lemiszki 9 Jan 1982
Filename: alex.c BDS C v1.50
*/
#include "acrl.h"
/*
Scans the next token from the current line, stores the
token in tokbuf, and sets the global variables 'class', 'type',
'value', and 'reloc'. For ASCII character tokens, 'type' is
the ASCII code.
*/
scan()
{
L1: value = reloc = 0;
while ((type = *lptr++) == ' ' || /* skip spaces */
type == '\t' || /* tabs */
type == '\f' ) /* and formfeeds */
;
if (type == '\n' || type == ';')
{
lptr--; /* never scan past EOL */
class = EOL;
return;
}
switch (class = cclass(type))
{
case 0: /* Illegal character */
error('I');
goto L1; /* scan next */
case 'A': /* Identifier */
identifier();
break;
case '1': /* Number */
number();
break;
case '$' : /* String */
string();
break;
default: /* 1 char token */
break;
}
}
/*
* Scan an identifier
* ------------------
*/
identifier()
{
idn(); /* ident to tokbuf */
if (look(tokbuf)) /* defined ? */
{
class = id->clas;
type = id->typ;
value = id->val;
}
else /* undefined */
{
class = IDENT;
type = idUND;
}
if (type & RELBIT) /* relocatable ? */
{
type ^= RELBIT; /* turn bit off */
reloc = TRUE; /* set global */
}
}
/* Copy chars into 'tokbuf' until non-alphanumeric */
idn()
{
char cc, *ptr;
ptr = tokbuf; /* move into token buffer */
do {
*ptr++ = toupper(type);
} while ((cc=cclass(type=*lptr++)) == 'A' || cc == '1');
lptr--; /* backup */
*ptr = EOS;
}
/* Check the symbol tables */
int look(s)
char *s;
{
if (lookup(RESVD, s)) /* reserved word ? */
return TRUE;
if (infunc && lookup(LOCAL, s)) /* local symbol ? */
return TRUE;
if (lookup(GLOBAL, s)) /* global symbol ? */
return TRUE;
if (!infunc && lookup(FUNCS, s)) /* function name ? */
return TRUE;
return FALSE;
}
/*
* Scan a number
* -------------
*/
number()
{
char c, *ptr;
int radix;
value = 0; /* init */
radix = 10;
idn(); /* ident to tokbuf */
for (ptr=tokbuf; *++ptr; ) /* scan to end of string */
;
c = *--ptr; /* get last char */
*ptr = EOS; /* erase it */
switch (c) /* check if radix char */
{
case 'H': radix = 16; break;
case 'D': radix = 10; break;
case 'Q':
case 'O': radix = 8; break;
case 'B': radix = 2; break;
default : *ptr = c; /* no, put it back */
}
for (ptr = tokbuf; c = *ptr++; ) /* convert tokbuf */
{
if ((c -= '0') > 9) /* ascii to bcd */
c -= 7;
if (c >= radix)
error ('I');
value = value * radix + c;
}
class = OPERAND;
type = NUMBER;
}
/*
* Scan a quoted string
* --------------------
* From input buffer into 'tokbuf'
*/
string()
{
char c, *ptr;
for (ptr=tokbuf; (c=*lptr) != '\n'; )
{
lptr++;
if (c == '\'') /* quote ? */
if (*lptr == '\'') /* double quote ? */
lptr++; /* just move 1 */
else
break; /* delim */
*ptr++ = c;
}
*ptr = EOS; /* terminate string */
class = STRING;
}
/*
CHARACTER CLASSES
Tokens are scanned based on their 1st character. The following
values (from cctab[]) indicate that further action is necessary
to complete scanning this token. Otherwise it's a 1 char token,
and cclass returns its token class. Its type is its ASCII code.
0 - illegal character
'A' - first char of identifier
'1' - first char of number
'$' - string delimitter (')
*/
/* Return character class */
byte cclass(c)
char c;
{
if (c < 128)
return (cctab[c]); /* from table */
else
return (0); /* illegal */
}
/*
* Init the character class table
* ------------------------------
*/
initctab()
{
setmem(cctab, 128, 0); /* fill with zeros */
setmem(&cctab['A'], 26, 'A'); /* upper case letters */
setmem(&cctab['a'], 26, 'A'); /* lower case letters */
cctab['?'] = 'A';
cctab['@'] = 'A';
setmem(&cctab['0'], 10, '1'); /* digits */
cctab['\''] = '$'; /* quote */
cctab[':'] = PSEUDO;
cctab['*'] = OPERATOR;
cctab['+'] = OPERATOR;
cctab['-'] = OPERATOR;
cctab['/'] = OPERATOR;
cctab['$'] = OPERAND;
cctab['('] = OPERAND;
cctab[')'] = MISC;
cctab[','] = MISC;
}
/*
SYMBOL TABLE ROUTINES
Symbols are stored as linked lists of 'entry's, with the head
of each list stored in the 'roots[]' array. To speed up access
of reserved words, 256 lists are allocated for this table, and
a simple hash function is used to select the list for any word.
*/
/*
* Lookup an identifier in a table
* -------------------------------
* If found, the global pointer 'id' is left pointing to
* the entry.
*/
int lookup(level, str)
int level; /* which table to use */
char *str; /* ptr to ident string */
{
if (level == RESVD) /* reserved word ? */
level += hash(str);
if (level == LOCAL) /* local symbol ? */
level += numfunc;
for (id = roots[level]; id != NULL; id = id->next)
if (strcmp(str, id->nam) == 0)
return TRUE;
return FALSE;
}
/* Hash function: sum the chars */
byte hash(str)
char *str; /* ident string */
{
int i;
for (i=0; *str; i += *str++) /* sum up the chars */
;
return (i & 255); /* mod 256 */
}
/*
* Add a symbol into a table
* -------------------------
* This function assumes the identifier name is static or
* already strsav()'d.
*/
install(level, name, class, type, value)
int level; /* the table to use */
char *name; /* the identifier string */
byte class; /* the symbol's class */
byte type; /* the symbol's type */
int value; /* the symbol's value */
{
char *alloc();
id = alloc(sizeof(*id)); /* first make an entry */
id->nam = name; /* store parameters */
id->clas = class;
id->typ = type;
id->val = value;
if (level == RESVD) /* reserved word ? */
level += hash(name);
if (level == LOCAL) /* local symbol ? */
level += numfunc;
id->next = roots[level]; /* add to head of list */
roots[level] = id;
}
/* Save a string in upper memory */
char *strsave(s)
char *s; /* string pointer */
{
char *p;
p = alloc(strlen(s) + 1); /* get memory */
strcpy(p, s); /* move string */
return (p);
}
/* Allocate memory */
char *alloc(n)
int n; /* number of bytes */
{
char *p, *sbrk();
if ((p=sbrk(n)) == ERROR)
fatal("Out of memory\n");
return (p);
}
/*
* Init the symbol tables
* ----------------------
*/
initsymb()
{
int i;
for (i = 0; i < ROOTSIZ; ++i) /* init all lists empty */
roots[i] = NULL;
install(RESVD, "AND", OPERATOR, opAND, 0);
install(RESVD, "OR", OPERATOR, opOR, 0);
install(RESVD, "XOR", OPERATOR, opXOR, 0);
install(RESVD, "HIGH", OPERAND, opHIGH, 0);
install(RESVD, "LOW", OPERAND, opLOW, 0);
install(RESVD, "SHL", OPERATOR, opSHL, 0);
install(RESVD, "SHR", OPERATOR, opSHR, 0);
install(RESVD, "MOD", OPERATOR, opMOD, 0);
install(RESVD, "NOT", OPERAND, opNOT, 0);
install(RESVD, "DB", PSEUDO, psDB, 0);
install(RESVD, "DS", PSEUDO, psDS, 0);
install(RESVD, "DW", PSEUDO, psDW, 0);
install(RESVD, "END", PSEUDO, psEND, 0);
install(RESVD, "EQU", PSEUDO, psEQU, 0);
install(RESVD, "SET", PSEUDO, psSET, 0);
install(RESVD, "FUNCTION", PSEUDO, psFUNC, 0);
install(RESVD, "FEND", PSEUDO, psFEND, 0);
install(RESVD, "INCLUDE", PSEUDO, psINCL, 0);
}
/*EOF*/