/*
 * File: pass1.c
 *
 * Main file for pass 1 of IMP80 compiler
 *
 * Bob Eager   August 2002
 * 
 */

#include "imp.h"
#include "global.h"
#include "syntax.h"
#include "opcode.h"
#include <ctype.h>
#include <limits.h>

#define	COMMALT		2		/* Alternate for comments */
#define	DECALT		8		/* Alternate for declarations */
#define	ENDALT		9		/* Alternate for %ENDs */

/* Forward references */

static	INT	compare(INT);
static	INT	getline(INT);
static	VOID	include(PUCHAR);
static	VOID	readline(INT, UCHAR);
static	VOID	texttext(INT, PINT);
static	VOID	xconst(INT, PINT);

/* Local data */

static	INT	dummyformat;
static	UCHAR	mnem[8];


/*
 * Pass 1 of the compiler
 *
 */

VOID pass1(VOID)
{	INT i;
	INT dummy;
	INT dumfp;

	dummyformat = 0;		/* Dummy record format */
	push(&dummyformat, 0, 0, 0);	/* For better error recovery */

	line = 0;
	length = 0;
	q = 1;
	r = 1;
	level = 1;

	/* Main analysis loop */

	for(;;) {
		if(q >= length) {
			qmax = 1;
			readline(0, 0);
		}
		starstart = r;		/* Remember start of record */
		r += 3;			/* Leave space for length part */
		oldline = line;
		a[r++] = (UCHAR) (line >> 8);	/* Record line number */
		a[r++] = (UCHAR) (line & 0xff);
		if(compare(SS) == 0) {
			fault(100, 0, 0);/* Failed to analyse statement */
			r = starstart;	/* Back up and lose record */
		} else {
			if(r > arsize)	/* Workfile too small */
				fault(102, (UINT) wkfilek, 0);
			if(a[starstart+5] == COMMALT) {
				r = starstart;
					/* Lose comment records */
			} else {
				i = r - starstart;	/* Store length */
				a[starstart] = (UCHAR) (i >> 16);
				a[starstart+1] = (UCHAR) ((i >> 8) & 0xff);
				a[starstart+2] = (UCHAR) (i & 0xff);
				if((a[starstart+5] == DECALT) && (level > 1)) {
					if(sfs[level] == 0) {
						toar4(display[level], (INT) starstart);
						display[level] = starstart + 6;
					} else {	/* Flag as unlinked */
						a[starstart+6] = 128;
					}
				}
#if	DEBUG
				if(smap == YES) {
					INT j = 0;

					fprintf(listfp, "\n%5d %5d\n", line, starstart);
					for(i = starstart; i <= r+1; i++) {
						fprintf(listfp, "%5d", a[i]);
						j++;
						if(j >= 15) {
							fputc('\n', listfp);
							j = 0;
						}
					}
					fputc('\n', listfp);
				}
#endif
				if((a[starstart+5] == ENDALT) &&
					(1 <= a[starstart+6]) &&
					(a[starstart+6] <= 2)) {
						/* %ENDOFPROGRAM or %ENDOFFILE */
					if(ihead == 0) break;
					idepth--;
					pop(&ihead, &dumfp, &dummy, &dummy);
					infp = (FILE *) dumfp;
					r = starstart;	/* Ignore %ENDOFFILE */
					length = 1;
					continue;
				}
				if(level == 0) {
					fault(14, 0, 0);	/* %END is not required */
					r = starstart;	/* Ignore it */
					level = 1;
				}
			}
		}
	}				/* End of main analysis loop */
	toar4(r, 0);			/* Add terminator */
	r += 4;
	toar4(r, 0);			/* Second part of terminator */

	/* See if there is room to copy the dictionary */

	if(r + next > arsize) fault(102, 0, 0);
					/* Workfile too small */

	p1size = r;			/* Record space used by pass 1 */

	/* Copy dictionary to workfile */

	for(i = 0; i <= next; i++)
		a[r+i] = lett[i];
	dictbase = &a[r];
	r = r + next + 1;		/* Record new free pointer */

	/* Deallocate pass 1 storage */

	tline = &tline[-20];		/* Get true base */
	(VOID) free((PUCHAR) display);
	display = (PINT) NULL;
	(VOID) free(lett);
	lett = (PUCHAR) NULL;
	(VOID) free((PUCHAR) sfs);
	sfs = (PINT) NULL;
	(VOID) free(tline);
	tline = (PUCHAR) NULL;
}


/*
 * Main syntax analysis routine (recursive).
 *
 */

static INT compare(INT p)
{	INT i, ii, kk;
	INT alt, item, j, jj, k;
	INT marker;
	INT pp, ra, rp;
	UINT rl;
	INT rq, rr;
	INT rs, ssl;
	UINT s;
	INT strpos;
	static INT savecomp;		/* For checking dsided conds */

	rp = symbol[p];
	rl = level;
	p++;
	pp = p;				/* Routine really starts here */

comm:
	rq = q;				/* Reset values of 'line' and ar ptrs */
	rr = r;
	ssl = strlink;			/* Save string link */
	alt = 1;			/* First alternative to be tried */
	ra = symbol[p];			/* ra to next phrase alternative */
	rs = p;

upr:
	r++;

succ:					/* Success on to next item */
	rs++;				/* rs=next alternative means that */
					/* this alt has been completed so */
					/* exit with hit=1 */
	if(rs == ra) goto fini;
	item = symbol[rs];		/* Next brick in the current alt */
	if(item < 999) goto lit;
	if(item < 1300) goto bips;	/* Brick is a phrase type */
	if(compare(item) == 0) goto fail;
	goto succ;

lit:					/* Brick is literal */
	i = cc[q];			/* Obtain current character */
	if(i != clett[item+1]) goto fail;
	q++;
	k = clett[item]+item;
	item += 2;
	while(item <= k) {
		if(cc[q] != clett[item]) goto fail;
		q++;
		item++;
	}				/* Check it with literal dict entry */
	goto succ;			/* Matched successfully */

fail:					/* Failure - note position reached */
	if(ra == rp) goto tfail;	/* ctotal failure no alt to try */
	if(q > qmax) qmax = q;
	q = rq;				/* Reset line and ar pointers */
	r = rr + 1;			/* Avoid going via upr: */
	strlink = ssl;
	alt++;				/* Move to next alt of phrase */
	rs = ra;
	ra = symbol[ra];
	goto succ;

tfail:
	level = rl;
	return(0);

bips:
	switch(item) {
		case 999:		/* Repeated phrase */
			a[rr] = (UCHAR) alt;
			p = pp;
			goto comm;

		fini:
		case 1000:		/* Null always last and OK */
			a[rr] = (UCHAR) alt;
			return(1);

		case 1001:		/* Phrase NAME */
			i = cc[q];	/* Obtain current character */
			if(trtab[i] != 2) goto fail;
/*			pname(item-1004); */
			pname(1);
			if(hit == 1) goto succ;
			goto fail;

		case 1002:		/* Phrase ICONST (integer constant) */
		case 1003:		/* Phrase CONST (any constant) */
			xconst(item-1003, &strpos);
			if(hit == 0) goto fail;
			goto succ;

		case 1004:		/* Phrase CHXTYPE (check extended type) */
					/* First letter is (B,H,I,L,R,S) */
					/* 3rd letter (A,L,N,R,T,C) */
			i = cc[q];
			if((i > 128) &&
				(((0x80000000 >> (i & 0x1f)) & 0x20c83000) != 0) &&
				(((0x80000000 >> (cc[q+2] & 0x1f)) & 0x500b2800) != 0))
				goto succ;
			goto fail;

		case 1005:		/* Phrase N (16 bit decimal number) */
			i = cc[q];	/* Obtain current character */
			if(!(isdigit(i))) goto fail;
			s = 0;
			while(isdigit(i)) {
				s = 10*s + (i - '0');
				q++;
				i = cc[q];
			}
			toar2(r, (INT) s);
			r += 2;
			goto succ;

		case 1006:		/* Phrase S (separator) */
			i = cc[q];	/* Obtain current character */
			if(i == '\n') goto succ;
			if(i != ';') goto fail;
			q++;
			goto succ;

		case 1007:		/* Phrase TEXT (comment text) */
			i = cc[q];	/* Obtain current character */
			if((i != '!') &&
				(i != '|') &&
				(!((i == 'C'+128) && (cc[q+1] == 'O'+128) &&
				(cc[q+2] == 'M'+128) && (cc[q+3] == 'M'+128) &&
				(cc[q+4] == 'E'+128) && (cc[q+5] == 'N'+128) &&
				(cc[q+6] == 'T'+128)))) goto fail;
			q = q + 1 + 6*(i>>7);
			j = cc[q];
			for(;;) {
				if(j == '\n') break;
				if((j == ';') && (cc[q+1] != '!'))
					warn(6, 0);
						/* Semicolon in comment text */
				q++;
				j = cc[q];
			}
			goto succ;

		case 1008:		/* Phrase BIGHOLE (leave 4 byte space) */
			toar4(r, 0);
			r += 4;
			goto succ;

		case 1009:		/* Phrase HOLE (leave 2 byte space and
					   remember where for linkage) */
			marker = r;
			r += 2;
			goto succ;

		case 1010:		/* Phrase MARK (set marker for linkage) */
			i = r - marker;
			a[marker+1] = (UCHAR) (i & 0xff);
			a[marker] = (UCHAR) ((i>>8) & 0xff);
			goto succ;

		case 1011:		/* Phrase READLINE? (skip to non-empty line) */
			i = cc[q];	/* Obtain current character */
			while(i == '\n') {
				readline(0, 0);
				rq = 1;
				i = cc[q];
			}
			if(r > arsize) fault(102, (UINT) wkfilek, 0);
					/* Workfile too small */
			goto succ;

		case 1012:		/* Phrase ALIASTEXT (alias text) */
			r -= 4;		/* AVOID hole left by 'texttext' */
			texttext(NO, (PINT) NULL);
			if(hit == 0) goto fail;
			goto succ;

		case 1013:		/* Phrase DUMMYAPP */
			a[r++] = 2;
			a[r++] = 2;
			goto succ;

		case 1014:		/* Phrase DOWN (new textual level) */
			toar4(r, 0);
			display[++level] = r;
			sfs[level] = 0;
			r += 4;
			goto succ;

		case 1015:		/* Phrase UP (previous textual level) */
			display[level] = 0;
			while(sfs[level] != 0) {
				pop(&sfs[level], &ii, &jj, &kk);
				if(ii == 1)
					fault(53, (UINT) kk, 0);
						/* %FINISH missing */
				if(ii == 2)
					fault(13, (UINT) kk, 0);
						/* %REPEAT missing */
			}
			level--;
			goto succ;

		case 1016:		/* Phrase LISTON (turn on listing) */
			list = YES;
			goto succ;

		case 1017:		/* Phrase LISTOFF (turn off listing) */
			list = NO;
			goto succ;

		case 1018:		/* Phrase COLON (for label) */
			if(cc[q-1] != ':') goto fail;
			goto succ;

		case 1019:		/* Phrase NOTECONST (for strings) */
			if(ctype == 5) {
				toar4(strpos-4, (INT) strlink);
				strlink = strpos - 4;
			}
			goto succ;

		case 1020:		/* Phrase TRACE (for %ON conditions) */
			parmtrace = YES;
			goto succ;

		case 1021:		/* Phrase SETNEM (set mnemonic) */
			i = cc[q];	/* Obtain current character */
			for(j = 0; j < 8; j++) mnem[j] = ' ';
			j = 0;
			while(isalpha(i)) {
				if(j < 8) mnem[j++] = (UCHAR) i;
				i = cc[++q];
			}
			if((i != '_') || (mnem[0] == ' ')) goto fail;
			q++;		/* Skip past '_' */
			goto succ;

		case 1022:		/* Phrase OP0FORM - opcode with no operand */
			for(j = 0; j < opcsize; j++)
				if((strcmp(opc[j], mnem) == 0) &&
				   (OPSIZE(j) == 0)) {
					goto opfound;
				}
			goto fail;

		case 1023:		/* Phrase OP1FORM */
			for(j = 0; j < opcsize; j++)
				if((strcmp(opc[j], mnem) == 0) &&
				   (OPSIZE(j) == 1)) {
					goto opfound;
				}
			goto fail;

		case 1024:		/* Phrase OP2FORM */
			for(j = 0; j < opcsize; j++)
				if((strcmp(opc[j], mnem) == 0) &&
				   (OPSIZE(j) == 2)) {
					goto opfound;
				}
			goto fail;

		case 1025:		/* Phrase OP3FORM */
			for(j = 0; j < opcsize; j++)
				if((strcmp(opc[j], mnem) == 0) &&
				   (OPSIZE(j) == 3)) {
					goto opfound;
				}
			goto fail;

		case 1026:		/* Phrase OPJFORM */
			for(j = 0; j < opcsize; j++)
				if((strcmp(opc[j], mnem) == 0) &&
				   (JUMP(j) != 0)) {
					goto opfound;
				}
			goto fail;

		case 1027:		/* Phrase OPFFORM */
			for(j = 0; j < opcsize; j++)
				if((strcmp(opc[j], mnem) == 0) &&
				   (mnem[0] == 'F')) {
					goto opfound;
				}
			goto fail;

		opfound:
			a[r++] = (UCHAR) j;
			goto succ;

		case 1028:		/* Phrase REG - register name */
			i = cc[q];	/* Obtain current character */
			for(j = 0; j < 3; j++) mnem[j] = ' ';
			mnem[4] = '\0';
			j = 0;
			while(i > 128) {
				if(j < 3) mnem[j++] = (UCHAR) (i - 128);
				i = cc[++q];
			}
			for(j = 0; j < MAXREGS; j++)
				if(strcmp(regs[j], mnem) == 0) {
					a[r++] = (UCHAR) j;
					goto succ;
				}
			goto fail;

		case 1029:		/* Phrase FPREG - NPX register name */
			i = cc[q] - '0';
			if(0 <= i && i <= 7) {
				q++;
				goto succ;
			}
			goto fail;

		case 1030:		/* Phrase ASMWRONG - assembler errors */
			i = cc[q];
			for(;;) {
				q++;
				if((i == '\n') || (i == ';')) break;
				i = cc[q];
			}
			goto fail;

		case 1031:		/* Phrase OP - various operators: */
					/* +,-,&,****,**,*,!!,!, */
					/* //,/,>>,<<,.,\\,\,^^,^ */
			i = cc[q];	/* Obtain current character */
			if((i <= 32) || (i >= 127) ||
			((0x80000000 >> ((i-32) & 0x1f) & 0x4237000a) == 0))
				goto fail;
			q++;
			if(i == '+') {
				a[r] = 1;
				goto upr;
			}
			if(i == '-') {
				a[r] = 2;
				goto upr;
			}
			if(i == '&') {
				a[r] = 3;
				goto upr;
			}
			j = cc[q];
			if(i == '*') {
				if(j != i) {
					a[r] = 6;
					goto upr;
				}
				if((cc[q+1] == i) && (i == cc[q+2])) {
					a[r] = 4;
					q += 3;
					goto upr;
				}
				a[r] = 5;
				q++;
				goto upr;
			}
			if(i == '/') {
				if(j != i) {
					a[r] = 10;
					goto upr;
				}
				a[r] = 9;
				q++;
				goto upr;
			}
			if(i == '!') {
				if(j != i) {
					a[r] = 8;
					goto upr;
				}
				a[r] = 7;
				q++;
				goto upr;
			}
			if(i == '.') {
				a[r] = CONCOP;
				goto upr;
			}
			if((i == j) && (j == '<')) {
				a[r] = 12;
				q++;
				goto upr;
			}
			if((i == j) && (j == '>')) {
				a[r] = 11;
				q++;
				goto upr;
			}
			if((i == '\\') || (i == '^')) {
				if(j != i) {
					a[r] = 15;
					goto upr;
				}
				q++;
				a[r] = 14;
				goto upr;
			}
			goto fail;

		case 1032:		/* Phrase CHUI - check that statement */
					/* starts with valid character: */
					/* Letter,'-',%C,%E,%M,%R,%S */
			i = cc[q];	/* Obtain current character */
			if((trtab[i] == 2) || (i == '-')) goto succ;
			if(((0x80000000 >> (i & 0x1f)) & 0x14043000) != 0)
				goto succ;
			goto fail;

		case 1033:		/* Phrase +' (unary operator): */
					/* +,-,\,~,none */
			i = cc[q];	/* Obtain current character */
			if((i == '\\') || (i == '~')) {
				a[r] = 3;
				q++;
				goto upr;
			}
			if(i == '-') {
				a[r] = 2;
				q++;
				goto upr;
			}
			if(i == '+') {
				a[r] = 1;
				q++;
				goto upr;
			}
			a[r] = 4;
			goto upr;

		case 1034:		/* Phrase NOTECYCLE (note start of %CYCLE) */
			toar4(r, 0);
			ii = 2;
			jj = r;
			kk = line;
			push(&sfs[level], (INT) ii, (INT) jj, (INT) line);
			r += 4;
			goto succ;

		case 1035:		/* Phrase ,' (parameter list): */
					/* ',',none */

			/* This is very awkward as it means it is very hard
			   to find the end of a parameter list without
			   churning. By making this a BIP we can peep ahead
			   for ')' and fail here. */

			i = cc[q];	/* Obtain current character */
			if(i == ')') goto fail;
			if(i == ',') q++;
			goto succ;

		case 1036:		/* Phrase COMP1 (comparison operator) */
		case 1041:		/* Phrase COMP2(is 2nd half of dsided) */
			i = cc[q];	/* Obtain current character */
			if((i <= 32) ||
				(i > 92) ||
			(((0x80000000 >> (i & 0x1f)) & 0x1004000e) == 0))
					goto fail;
					/* '='=1,'>='=2,'>'=3 */
					/* '#' or '\=' or '<>'=4 */
					/* '<='=5,'<'=6 */
					/* 7 unused,'->'=8,'=='=9 */
					/* '##' or '\==' =10 */
			if(i == '=') {
				if(cc[q+1] == i) {
					j = 9;
					goto join1;
				}
				j = 1;
				goto join;
			}
			if(i == '#') {
				if(cc[q+1] == i) {
					j = 10;
					goto join1;
				}
				j = 4;
				goto join;
			}
			if((i == '\\') && (cc[q+1] == '=')) {
				q++;
				if(cc[q+1] == '=') {
					j = 10;
					goto join1;
				}
				j = 4;
				goto join;
			}
			if(i == '>') {
				if(cc[q+1] == '=') {
					j = 2;
					goto join1;
				}
				j = 3;
				goto join;
			}
			if(i == '<') {
				if(cc[q+1] == '>') {
					j = 4;
					goto join1;
				}
				if(cc[q+1] == '=') {
					j = 5;
					goto join1;
				}
				j = 6;
				goto join;
			}
			if((i == '-') && (cc[q+1] == '>')) {
				j = 8;
				goto join1;
			}
			goto fail;

		join1:
			q++;

		join:
			q++;
			a[r] = (UCHAR) j;
			if(item == 1036) {
				savecomp = j;
				goto upr;
			}

			/* Save 'j' to check double sided comparisons */

			if((savecomp > 6) || (j > 6)) {
				q--;
				goto fail;	/* Illegal dsided */
			}
			goto upr;	/* N.B. Owns won't work if */
					/* cond exprs allowed as they */
					/* can be nested! */

		case 1037:		/* Phrase ASSOP (assignment operators): */
					/* ==,=,<-,-> */
			i = cc[q];	/* Obtain current character */
			if(i == '=') {
				if(cc[q+1] == '=') {
					a[r] = 1;	/* '==' */
					q += 2;
					goto upr;
				}
				a[r] = 2;		/* '=' */
				q++;
				goto upr;
			}
			if((i == '<') && (cc[q+1] == '-')) {
				a[r] = 3;		/* '<-' */
				q += 2;
				goto upr;
			}
			if((i == '-') && (cc[q+1] == '>')) {
				a[r] = 4;		/* '->' */
				q += 2;
				goto upr;
			}
			goto fail;

		case 1038:		/* Phrase NOTESTART (note %START) */
			toar4(r, 0);
					/* Hole for forward ptr */
			ii = 1;
			jj = r;
			kk = line;
			push(&sfs[level], (INT) ii, (INT) jj, (INT) kk);
			r += 4;
			goto succ;

		case 1039:		/* Phrase NOTEFINISH (note %FINISH) */
			if(sfs[level] == 0) {
				fault(51, 0, 0);
					/* %FINISH is not required */
				goto succ;
			}
			pop(&sfs[level], &ii, &jj, &kk);
			if(ii == 2) fault(59, (UINT) kk, 0);
					/* %FINISH instead of %REPEAT */
			toar4(jj, (INT) starstart);
			goto succ;

		case 1040:		/* Phrase NOTEREPEAT (note %REPEAT) */
			if(sfs[level] == 0) {
				fault(1, 0, 0);
					/* %REPEAT is not required */
				goto succ;
			}
			pop(&sfs[level], &ii, &jj, &kk);
			if(ii == 1) fault(52, (UINT) kk, 0);
					/* %REPEAT instead of %FINISH */
			toar4(jj, (INT) starstart);
			goto succ;

		case 1042:		/* Phrase INCLUDE (include file) */
			if(idepth >= MAXIDEPTH)
				fault(111, MAXIDEPTH, 0);
					/* Exceeded maximum nesting depth */
			i = cc[q];
			if((i != '\n') && (i != ';')) goto fail;
			if(i == ';') q++;
			if(ctype != 5) goto fail;
			idepth++;
			push(&ihead, (INT) infp, 0, 0);
			include((PUCHAR) (&a[strpos]));
			goto succ;

		case 1043:		/* Phrase DUMMYSTART: */
					/* give same ar as else start */
			a[r] = 1;
			a[r+1] = 1;	/* Alt 1 of else alt 1 of after else */
			r += 2;
			goto succ;
	}				/* End of BIP switch */
	return(0);
}


/*
 * Routine to read a line from the input file.
 * Handles reversion to previous file at end of included file,
 * and output of the line to the listing file.
 *
 * Returns the length of the line just read.
 *
 */

static INT getline(INT mode)
{	INT ll = 0;			/* Line length counter */
	INT ch;
	INT i;
	INT dummy;

	do {
		ch = fgetc(infp);	/* Read a character */

		if(ch == EOF) {		/* End of file on input */
			if(ihead != 0) {
				pop(&ihead, &infp, &dummy, &dummy);
				idepth--;
				return(getline(mode));
			}
			fault(110, 0, 0);	/* Input ended */
		}
		tline[ll+1] = itoi[ch];
		ll++;
	} while(ch != '\n');

	line++;				/* Count all lines */
	if(list == YES) {
		if((mode == 0) && (length > 0)) fputs("     C", listfp);
		else fprintf(listfp, " %5d", line);
		for(i = -7; i <= 0; i++) tline[i] = ' ';
		if(mode != 0) tline[-7] = '"';
		tline[-8] = (UCHAR) (ll + 8);
		for(i = 0; i < tline[-8]; i++)
			fputc(tline[i-7], listfp);
	}
	if((freeformat == NO) && (ll > 73)) {
		tline[73] = '\n';
		ll = 73;
	}
	return(ll);
}


/*
 * Routine to open an include file.
 * The parameter 's' is the address of an IMP-style string describing
 * the required file.
 * Does not return if the file cannot be opened.
 *
 */

static VOID include(PUCHAR s)
{	INT i;
	UCHAR file[256];

	for(i = 1; i <= *s; i++)	/* Make local C-style copy */
		file[i-1] = s[i];
	file[--i] = '\0';		/* Add terminator */

	infp = fopen(file, "r");
	if(infp == (FILE *)  NULL) {
		fprintf(stderr, "%s: cannot open '%%include' file: %s\n",
			progname, file);
		faulty++;		/* To ensure failure message */
		iexit(4);
	}
}


/*
 * Routine to declare a name.
 * Parameter 'mode' is 0 for old name (already in dictionary) and
 * 1 for a new name.
 *
 * Global inputs:
 *   q - offset in 'cc' where the name starts
 *
 */

VOID pname(INT mode)
{	INT fq, j, k, l, len, s;
	UINT ch;
	static const INT hash[8] = {71, 47, 97, 79, 29, 37, 53, 59};

	hit = NO;
	fq = q;				/* Save starting point */
	ch = cc[q];			/* Get first character */
	if((trtab[ch] != 2) || (cc[q+1] == '"') || (cc[q+1] == '\''))
		return;			/* 1st character must be a letter */

	len = 1;			/* Initialise length counter */
	lett[next+1] = (UCHAR) ch;
				/* Leave space for length, store 1st char */

	/* Read and store the rest of the name, and generate a hash code */

	j = 71* (INT) ch;
	for(;;) {
		ch = cc[++q];		/* Get next character of name */
		if(trtab[ch] == 0) break;
					/* Stop if not a legal character */
		if(len <= 7) j = j + hash[len++];
		lett[next+len] = (UCHAR) ch;
					/* Store character of name */
	}
	lett[next] = (UCHAR) len;	/* Insert length at start */
	s = len + 1;
	if(next + s > dsize)		/* Dictionary overflow */
		fault(103, 0, 0);

	j = (j+113*len) & nnames;	/* Derive hash index */

	for(k = j; j != nnames; k++) {	/* Search for name or hole */
		l = word[k];
		if(l == 0) goto hole;	/* Name not known */
		if(eqstring(&lett[next], &lett[l]) == YES) goto fnd;
	}
	for(k = 0; k <= j; k++) {
		l = word[k];
		if(l == 0) goto hole;	/* Name not known */
		if(eqstring(&lett[next], &lett[l]) == YES) goto fnd;
	}
	fault(104, 0, 0);		/* Too many names */

hole:
	if(mode == 0) {			/* Old name */
		q = fq;			/* Restore 'q' to starting point */
		return;
	}

	word[k] = next;			/* Store pointer in hash table */
	next = next + s;		/* Update free pointer by item size */

fnd:
	lastat = fq;
	hit = YES;			/* Indicate name found */
	lastname = k;
	a[r] = (UCHAR) (lastname >> 8);
	a[r+1] = (UCHAR) (lastname & 0xff);
	r += 2;
	lastend = q;
}


/*
 * Routine to read and reconstruct an input line.
 * Items handled here are:
 *    Continuation lines (merged)
 *    {} comments (removed)
 *    Underlining (processed)
 * The parameter 'mode' is 0 when reading normal source, 1 when within
 * a text string.
 * The parameter 'char' is the string delimiter when mode is 1.
 *
 */

static VOID readline(INT mode, UCHAR ch)
{	INT i;				/* Current character */
	INT del = 0;			/* 0 normally, 128 if underlining on */
	INT ll = 0;			/* Length of current input line */
	INT lp = 0;			/* Input line buffer pointer */
	INT prev;			/* Previous character read */
	INT latc = -5;			/* Length of line at continuation */

	q = 1;				/* Initialise buffer pointer */
	length = 0;			/* Initialise buffer length */

	for(;;) {
		lp++;			/* Move to next character in buffer */
		if(lp > ll) {		/* Buffer exhausted */
			ll = getline(mode);
					/* Get new line, length to 'll' */
			lp = 1;		/* Reset buffer pointer */
		}
		i = tline[lp];		/* Get next character from buffer */
		if(mode == 0) {
			while(i == '{') {
				do {
					prev = i;
					i = tline[++lp];
				} while(!((prev == '}') || (i == '\n')));
			}
			if(i == '%') {
				del = 128;
				continue;
			}
			i = onecase[i];
			if(isalpha(i)) i |= del;
			else {
				del = 0;
				if(i == ' ') continue;
			}
			cc[++length] = (UCHAR) i;
			if((i == '\'') || (i == '\"')) {
				mode = 1;
					/* Now inside string */
				ch = (UCHAR) i;
					/* Record string delimiter */
			}
		} else {
			cc[++length] = (UCHAR) i;
			if(i == ch) mode = 0;
					/* End of string */
		}
		if(i != '\n') continue;
		if(length - 1 == latc) {
			length = latc;
			continue;	/* Null continuation is ignored */
		}
		i = cc[length-1];
		if(i == 'C'+128) {
			length -= 2;
			latc = length;
			continue;
		}
		if((mode == 0) && (i == ',')) {
			length--;
			latc = length;
			continue;
		}
		if(length > ccsize) fault(101, 0, 0);
					/* Too many continuations */
		break;			/* Line complete */
	}
}


/*
 * Routine to process text between double quotes.
 * Stores in either ISO or EBCDIC depending on the setting
 * of the parameter. NO implies ISO, YES implies EBCDIC.
 * The parameter 'xs' is set to the position in 'a' where the text is
 * stored, unless it is NULL.
 *
 */

static VOID texttext(INT ebcdic, PINT xs)
{	INT i, j;
	INT ii;
	INT s;

	i = cc[q];			/* Obtain current character */
	s = r + 4;
	r = r + 5;
	hit = 0;
	if(i != '"') return;		/* Fail unless initial quote */
	q++;
	for(;;) {
		i = cc[q];		/* Get next character */
		if(ebcdic == YES) ii = itoetab[i];
		else ii = i;
		a[r++] = (UCHAR) ii;
		if(i == '"') {
			q++;
			if(cc[q] != '"') break;
		}
		if(i == '\n') readline(1, '"');
		else q++;
		if(r - s > 256) fault(106, 0, 0);
					/* String constant too long */
	}
	r--;
	j = r - s - 1;
	a[s] = (UCHAR) j;
	if(xs != (PINT) NULL) *xs = s;	/* Pass back position */
	hit = 1;
}


/*
 * Routine to syntax check and evaluate all forms of IMP constant.
 * 'mode' is zero for integer constants, and nonzero for any sort of
 * constant. 'xs' points to an integer which is to be set by any calls
 * to 'texttext'.
 *
 */

static VOID xconst(INT mode, PINT xs)
{	UINT cprec, t, zz;
	UCHAR mchs[8];
	double cvalue;
	INT dummy;
	INT rr;
	INT dotseen;
	INT ebcdic;
	INT fs;
	INT i;
	long double radixv;
	INT s;
	INT ss;
	double x;
	INT z;

	cprec = 5;
	rr = r++;
	dotseen = NO;
	hit = NO;
	cvalue = 0;
	fs = cc[q];			/* Obtain current character */
	s = 0;
	if(isdigit(fs)) goto n;		/* Number */

	if((fs == '.') && (mode == 0) && isdigit(cc[q+1])) goto dot;
	ctype = 1;
	ebcdic = NO;			/* Assume ISO initially */
	if(fs == '\'') goto quote;	/* Single character constant */
	if(fs == '"') goto str2;	/* String constant */
	if(cc[q+1] != '\'') goto notquote;
					/* Not numeric constant */
	q += 2;				/* Move to start of constant body */
	if(fs == 'X') goto hex;		/* Hexadecimal constant */
	if(fs == 'M') goto mult;	/* Multiple character constant */
	if(fs == 'B') goto bin;		/* Binary constant */
	if((fs == 'R') && (mode == 0)) goto rhex;
					/* Hexadecimal real constant */
	if(fs == 'K') goto oct;		/* Octal constant */
	if(fs == 'C') {			/* Single character EBCDIC constant */
		ebcdic = YES;
		goto mult;
	}
	q -= 2;				/* Back off again */
	return;

quote:					/* Single character constant */
	s = cc[q+1];			/* Obtain the character */
	q += 2;				/* Point beyond character */
	if(s == '\n') {			/* Literal newline */
		readline(1, '\'');
		q = 1;
	}
	if(cc[q] == '\'') {
		q++;
		if(s != '\'') goto iend;
		if(cc[q] == '\'') {
			q++;
			goto iend;
		}
	}
	return;				/* Not valid */

notquote:				/* Check for E"...." */
	if((fs != 'E') || (cc[q+1] != '"')) return;
	ebcdic = YES;
	q++;

str2:					/* Double quoted string */
	a[rr] = 0x35;			/* cprec=3, ctype=5 */
	texttext(ebcdic, xs);
	ctype = 5;
	return;

hex:
	t = 0;				/* Hexadecimal constants */
	for(;;) {
		i = cc[q++];
		if(i == '\'') break;
		t++;
		if(!(isxdigit(i) && (t < 17))) return;
		if(t == 9) {
			ss = s;
			s = 0;
		}
		s = (s<<4) + (i - '0') + 9*(i>>6);
	}
	if(t > 8) {
		zz = 4*(t-8);
		s = s|(ss<<zz);
		ss = ss >> (32-zz);
		cprec = 6;
	}

iend:
	if(cprec == 6) {
		toar4(r, ss);
		r += 4;
	}
	if((cprec == 5) && (0 <= s) && (s <= 0x7fff)) {
		cprec = 4;		/* Positive halfinteger */
		toar2(r, s);
		r += 2;
	} else {
		toar4(r, s);
		r += 4;
	}
	if(!((mode == 0) && (cprec == 6))) hit = YES;
	a[rr] = (UCHAR) ((cprec<<4) | ctype);
	return;

rhex:					/* Real hexadecimal constants */
	t = 0;
	for(;;) {
		i = cc[q++];
		if(((t & 7) == 0) && (t != 0)) {
			toar4(r, s);
			r += 4;
			s = 0;
		}
		if(i == '\'') break;
		t++;
		if(!(isxdigit(i))) return;
		s = (s<<4) + (i & 0xf) + 9*(i>>6);
	}
	if((t != 8) && (t != 16) && (t != 32)) return;
	if(t == 32) cprec = 7;
	else cprec = 4 + t/8;
	a[rr] = (UCHAR) ((cprec<<4) | 2);
	hit = YES;
	return;

oct:					/* Octal constants */
	t = 0;
	for(;;) {
		i = cc[q++];
		t++;
		if(i == '\'') break;
		if(!(('0' <= i) && (i <= '7') && (t < 12))) return;
		s = (s<<3) | (i & 7);
	}
	goto iend;

mult:					/* Multiple character constants */
	t = 0;
	for(;;) {
		i = cc[q++];
		if(i == '\'') {
			if(cc[q] != '\'') break;
			else q++;
		}
		if(ebcdic == YES) i = itoetab[i];
		mchs[t++] = (UCHAR) i;
		if(t >= 8) return;
	}
	ss = (mchs[0] << 24) | (mchs[1] << 16) | (mchs[2] << 8) | mchs[3];
	s = (mchs[4] << 24) | (mchs[5] << 16) | (mchs[6] << 8) | mchs[7];
	if(ss != 0) cprec = 6;
	goto iend;

bin:					/* Binary constants */
	t = 0;
	for(;;) {
		i = cc[q++];
		t++;
		if(i == '\'') break;
		if(((i != '0') && (i != '1')) || (t > 32)) return;
		s = (s<<1) | (i & 1);
	}
	goto iend;

radix:					/* Base_value constants */
	t = 0;				/* s already set to base */
	radixv = 0;
	q++;
	for(;;) {
		i = cc[q];
		if(!(isdigit(i)|| isalpha(i))) break;
		if(i <= '9') i -= '0';
		else i = i - ('A'-10);
		if(i >= s) break;	/* Must be less than base */
		t++;
		q++;
		radixv = radixv*s + i;
	}
	if(t == 0) return;		/* No valid digits */
	ss = (INT) (radixv / ULONG_MAX);
	s = (INT) (radixv - ss);
	ctype = 1;
	if(ss != 0) cprec = 6;
	goto iend;

n:					/* Constant starts with digit */
	i = cc[q];
	do {
		cvalue = 10.0*cvalue + (i - '0');
		i = cc[++q];		/* On to next character */
	} while(isdigit(i));
	if((i == '_') && (cvalue < 33)) {
		s = (INT) cvalue;
		goto radix;
	}
	if(!((mode == 0) && (i == '.'))) goto alpha;

dot:					/* Constant has decimal point */
	q++;
	x = 10.0;
	dotseen = YES;
	i = cc[q];
	while(isdigit(i)) {
		cvalue = cvalue + (i - '0')/x;
		x = 10.0*x;
		i = cc[++q];
	}

alpha:					/* Test for exponent */
	if((mode == 0) && (cc[q] == '@')) {
		q++;
		x = cvalue;
		z = 1;
		i = cc[q];
		if(i == '-') z = -1;
		if((i == '+') || (i == '-')) q++;
		xconst(2, &dummy);	/* Evaluate exponent recursively */
		if(hit == NO) return;	/* Invalid exponent */
		hit = NO;		/* Reset for our own result */
		dotseen = YES;		/* @ implies real in IMP80 */
		r = rr + 1;		/* Reset to start of work area */
		if((a[r]>>4) != 4) return;
					/* Exponent must be halfinteger */
		s = fromar2(r+1)*z;
		if(s == -99) cvalue = 0;
		else {
			while(s > 0) {
				s--;
				cvalue = cvalue*10.0;
			}
			while((s < 0) && (cvalue != 0)) {
				s++;
				cvalue = cvalue/10.0;
			}
		}
	}

	if((dotseen == YES) || (cvalue > imax)) ctype = 2;
	else {
		ctype = 1;
		s = (INT) cvalue;
	}
	if(ctype == 1) goto iend;
	if(cprec == 5) cprec = 6;	/* No 32 bit real constants */
	toar8(r, (PUCHAR) &cvalue);
	r += 8;
	if(cprec == 7) {
		toar8(r, (PUCHAR) &cvalue);
		r += 8;
	}
	a[rr] = (UCHAR) ((cprec<<4) + ctype);
	hit = YES;

/* fail:; */
}


/*
 * End of file: pass1.c
 *
 */