/*
	************************************************************
			      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*/