/*
 * File: misc.c
 *
 * Miscellaneous routines for IMP80 compiler
 *
 * Bob Eager   August 2002
 *
 */

#include "imp.h"
#include "opcode.h"
#include "global.h"
#include "global2.h"

/* Prototypes */

static	INT		more_space(VOID);
static	VOID		print_use(VOID);

/*
 * Routine to insert a cell containing the values 's1', 's2' and 's3'
 * at the bottom of a list, updating top and bottom pointers appropriately.
 *
 */

VOID binsert(PINT top, PINT bot, INT s1, INT s2, INT s3)
{	INT i, j;
	LISTF *lcell;

	i = asl;
	if(i == 0) i = more_space();
	lcell = &aslist[i];
	asl = lcell->link;
	lcell->s1 = s1;
	lcell->s2 = s2;
	lcell->s3 = s3;
	lcell->link = 0;
	j = *bot;
	if(j == 0) {
		*bot = i;
		*top = *bot;
	} else {
		aslist[j].link = i;
		*bot = i;
	}
}


/*
 * Routine to check the asl and output the number of free cells.
 *
 */

#if	DEBUG
VOID check_asl(VOID)
{	INT num = 0;
	INT qq = asl;

	while(qq != 0) {
		num++;
		qq = aslist[qq].link;
	}

	fprintf(listfp, "\nFree cells after line %d = %d", line, num);
}
#endif


/*
 * Routine to throw away a complete list (which may be null), and
 * reset the listhead.
 *
 */

VOID clear_list(PINT ophead)
{	INT i, j;

	i = *ophead;
	j = i;
	while(i != 0) {
		j = i;
		i = aslist[j].link;
	}
	if(j != 0) {
		aslist[j].link = asl;
		asl = *ophead;
		*ophead = 0;
	}
}


/*
 * Function to compare two IMP-style strings.
 *
 */

INT eqstring(PUCHAR s1, PUCHAR s2)
{	UINT len;

	len = s1[0];
	if((len != s2[0]) || (strncmp(&s1[1], &s2[1], len) != 0))
		return(NO);

	return(YES);
}


/*
 * Routine to set up an error message - this is sent to the listing
 * and optionally to the terminal
 *
 */

VOID fault(INT n, UINT data, UINT ident)
{	INT i, j, t, ll, s;
	UINT info;
	FILE *fp;
	PUCHAR sp;
	PUCHAR datap = (PUCHAR) data;
	UCHAR mess1[256];
	UCHAR mess2[256];
	UCHAR temp[256];
	UCHAR name[256];
	UCHAR c;

	mess1[0] = '\0';
	mess2[0] = '\0';
	faulty++;

	if(n == 100) {			/* Syntax faults are special */
		sprintf(mess1, "\n*    Failed to analyse line %d\n     ", line);
		if(line != oldline) {
			strcat(mess1,
		"Text mode failure - erroneous source line not available\n");
		} else {
			ll = j = s = t = 0;
			do {
				i = j;
				j = datap[q];
				if((j > 128) && (i < 128)) {
					mess2[ll++] = ' ';
					mess2[ll++] = '%';
					t += 2;
				}
				if((i > 128) && (j < 128))
					mess2[t++, ll++] = ' ';
				mess2[ll++] = (UCHAR) (j & 0x7f);
				t++;
				if(q == qmax) s = t;
				q++;
				if(t >= 250) break;
			} while (!(((j == ';') &&
				 (q > qmax)) || (q == length)));
			if(q == qmax) s = t;
			mess2[ll] = '\0';
        	}
	} else {
		sprintf(mess1, "\n* %4d   Fault %d", line, n);
		parmopt = YES;
		if(parmlet == NO) inhcode = YES;
					/* Stop generating code */
		message(mess2, n);

		sp = strpbrk(mess2, "#&");
		if((sp != (PUCHAR) NULL)) {
			c = *sp;
			*sp++ = '\0';	/* Terminate first part */
			if(c == '#') {
				if(*sp == '#') {
					sp++;
					/* Point to new tail */
					info = ident;
				} else info = data;
				sprintf(temp, "%s%d%s", mess2, info, sp);
			} else {	/* Must be '&' */
				if(*sp == '&') {
					sp++;
					/* Point to new tail */
					sprintf(temp, "%s%s%s",
						mess2,
						printname(name, (INT) data),
						sp);
				} else {
					sprintf(temp, "%s%s%s",
						mess2,
						printname(name, (INT) ident),
						sp);
					if(n > 100) strcat(mess2, " Disaster");
				}
			}
			strcpy(mess2, temp);
		}
	}

	fp = listfp;
	for(i = 1; i <= 2; i++) {
		fputs(mess1, fp);
		if(mess2[0] != '\0') fputs(mess2, fp);

		if((n == 100) && (s < 115)) {
			fputc('\n', fp);
			for(j = 1; j <= s + 4; j++) fputc(' ', fp);
			fputc('!', fp);
		}
		fputc('\n', fp);
		fp = stderr;		/* For second time around */
	}
	if(n > 100) iexit(EXIT_FAILURE);/* Fatal error */
}


/*
 * Routine to scan the list 'list' looking for 'lab' in the 's2' field,
 * returning the corresponding cell number.
 * This is used for more than just scanning label lists.
 *
 */

INT find(INT lab, INT list)
{	while(list != 0) {
		if(lab == aslist[list].s2)
			return(list);
		list = aslist[list].link;
	}
	return(-1);
}


/*
 * Routine to return the 's1' and 's2' values from the
 * cell 'cell'.
 *
 */

VOID from12(INT cell, PINT s1, PINT s2)
{	LISTF *lcell = &aslist[cell];

	*s1 = lcell->s1;
	*s2 = lcell->s2;
}


/*
 * Routine to return the 's1', 's2' and 's3' values from the
 * cell 'cell'.
 *
 */

VOID from123(INT cell, PINT s1, PINT s2, PINT s3)
{	LISTF *lcell = &aslist[cell];

	*s1 = lcell->s1;
	*s2 = lcell->s2;
	*s3 = lcell->s3;
}


/*
 * Function to return the 2-byte value at 'a[ptr]'.
 *
 */

INT fromar2(INT ptr)
{	INT value;

	value = a[ptr];
	value = value | (a[ptr+1] << 8);
	return(value);
}


/*
 * Function to return the 4-byte value at 'a[ptr]'.
 *
 */

INT fromar4(INT ptr)
{	INT res = 0;
	INT i;

	for(i = 0; i <= 3; i++)
		res = res | (a[ptr+i] << ((3-i)*8));
	return(res);
}


/*
 * Routine to find or create a temporary variable of 'size' words.
 *
 */

VOID getwsp(INT place, INT size)
{	size = 0;		/* Protem */
	place = 0;		/* Protem */
	return;
}


/*
 * Routine to convert an IMP-style string to a C-style string.
 *
 */

VOID imptoc(PUCHAR cs, PUCHAR imps)
{	UINT len = imps[0];

	strncpy(&cs[0], &imps[1], len);
	cs[len] = '\0';
}


/*
 * Routine to add a cell to the bottom of the list headed by 'cell'.
 *
 */

VOID insert_at_end(PINT cell, INT s1, INT s2, INT s3)
{	INT i, j, nn;
	LISTF *lcell;

	i = *cell;
	j = i;
	while(i != 0) {
		j = i;
		i = aslist[j].link;
	}
	nn = asl;
	if(nn == 0) nn = more_space();
	lcell = &aslist[nn];
	asl = lcell->link;
	if(j == 0) *cell = nn; else aslist[j].link = nn;
	lcell->s1 = s1;
	lcell->s2 = s2;
	lcell->s3 = s3;
	lcell->link = 0;
}


/*
 * Routine to return the next cell in a list.
 *
 */

VOID mlink(PINT cell)
{	*cell = aslist[*cell].link;
}


/*
 * Routine to format up some more of the asl.
 *
 */

static INT more_space(VOID)
{	INT i, nn, cl;
	INT amount;

	nn = aslcurbtm - 1;		/* Top of free space */
	amount = (nnames + 1)/8;	/* One eighth of 'nnames' */
	i = aslcurbtm - ((const_ptr + 8)/4);
					/* Gap between consts and asl */
	if(i/2 < amount) {
		amount = i/2;
		aslwarn = 1;		/* Half the gap max */
	}
	if(amount < 20) amount = 0;
	aslcurbtm -= amount;		/* Move down to make space */
	if(aslcurbtm < 1) aslcurbtm = 1;
	cl = sizeof(INT)*aslcurbtm - 8;	/* New constant limit */
	if((aslcurbtm >= nn) || (const_ptr > cl)) {
		aslcurbtm = nn + 1;	/* As you were */
		for(i = 1; i <= 12; i++) {
			if(dvheads[i] != 0)
				clear_list(&dvheads[i]);
		}
		if(asl != 0) return(asl);
		fault(102, (UINT) wkfilek, 0);	/* Workfile too small */
	} else const_limit = cl;	/* New value with bigger asl */
	for(i = aslcurbtm; i < nn; i++)
		aslist[i+1].link = i;	/* Format the new piece */
	aslist[aslcurbtm].link = 0;
	asl = nn;
	return(nn);
}


/*
 * Routine to output register usage.
 *
 */

static VOID print_use(VOID)
{
	return;
}


/*
 * Routine to copy the information from the top cell of list 'cell'
 * into 's1', 's2' and 's3, and then pop the list up one cell.
 * Returns -1s if list empty.
 *
 */

VOID pop(PINT cell, VOID *s1, VOID *s2, VOID *s3)
{	INT i;
	LISTF *lcell;

	i = *cell;
	lcell = &aslist[i];
	*((PINT) s1) = lcell->s1;
	*((PINT) s2) = lcell->s2;
	*((PINT) s3) = lcell->s3;
	if(i != 0) {
		*cell = lcell->link;
		lcell->link = asl;
		asl = i;
	}
}


/*
 * Routine to output the contents of the cells in the list headed by 'head'.
 *
 */

#if	DEBUG
VOID print_list(INT head)
{	INT i, j, k;

	fprintf(listfp, "\nPrint of list %d\n", head);

	while(head != 0) {
		from123(head, &i, &j, &k);
		fprintf(listfp,
			"%3d   %08X   %08X   %08X\n", head, i, j, k);
		mlink(&head);
		head &= 0xffff;		/* Extra link in tags list!! */
	}
}
#endif


/*
 * Function to return a string representing a name in the dictionary.
 * The string is returned in the parameter 's', and the result is also
 * a pointer to 's'.
 *
 */

PCHAR printname(PCHAR s, INT n)
{	INT v, k;

	strcpy(s, "???");		/* In case nothing found */

	if(0 <= n && n <= nnames) {
		v = word[n];
		k = dictbase[v];
		if(k != 0)
			strcpy(s, (PCHAR)(dictbase+v));
	}
	return(s);
}


/*
 * Routine to push a cell containing the values 's1', 's2' and 's3'
 * onto the top of the list pointed to by 'cell'.
 *
 */

VOID push(PINT cell, INT s1, INT s2, INT s3)
{	INT i;
	LISTF *lcell;

	i = asl;
	if(i == 0) i = more_space();
	lcell = &aslist[i];
	asl = lcell->link;
	lcell->link = *cell;
	*cell = i;
	lcell->s1 = s1;
	lcell->s2 = s2;
	lcell->s3 = s3;
}


/*
 * Routine to set the 's1', 's2' and 's3' values in the cell 'cell'.
 *
 */

VOID replace123(INT cell, INT s1, INT s2, INT s3)
{	LISTF *lcell = &aslist[cell];

	lcell->s1 = s1;
	lcell->s2 = s2;
	lcell->s3 = s3;
}


/*
 * Returns workspace to ordered free list. Addressable cells are put at
 * the top, non-addressable on the back.
 *
 */

VOID returnwsp(INT place, INT size)
{	place = 0;		/* Protem */
	size = 0;		/* Protem */
	return;
}


/*
 * Routine to put the 2-byte value 'value' into 'a' at 'ptr'.
 *
 */

VOID toar2(INT ptr, INT value)
{	a[ptr] = (UCHAR) (value & 0xff);
	a[ptr+1] = (UCHAR) (value >> 8);
}


/*
 * Routine to put the 4-byte value 'value' into 'a' at 'ptr'.
 *
 */

VOID toar4(INT ptr, INT value)
{	INT i;

	for(i = 0; i <= 3; i++)
		a[ptr+i] = (UCHAR) ((value >> ((3-i)*8)) & 0xff);
}


/*
 * Routine to put the 8-byte value 'value' into 'a' at 'ptr'.
 *
 */

VOID toar8(INT ptr, PUCHAR value)
{	INT i;

	for(i = 0; i <= 7; i++)
		a[ptr+i] = value[i];
}


/*
 * Routine to output a warning message.
 *
 */

VOID warn(INT n, UINT v)
{	UCHAR s[121];
	UCHAR temp[256];
	UCHAR name[256];
	PUCHAR sp;

	message(s, n+200);
	sp = strpbrk(s, "&");
	if(sp != (PUCHAR) NULL) {
		*sp++ = '\0';		/* Split the message */
		sprintf(temp, "%s%s%s", s, printname(name, (INT) v), sp);
		strcpy(s, temp);
	}
	fprintf(listfp, "\n?  Warning :- %s at line No %d\n", s, line);
}


/*
 * Routine to call 'malloc' checking reply; if call fails then an error
 * message is displayed and the program exits.
 *
 */

PCHAR xalloc(INT n)
{	PUCHAR res;

	res = malloc((UINT) n);

	if(res == (PUCHAR) NULL) {
		fprintf(stderr, "%s: cannot allocate memory\n", progname);
		iexit(EXIT_FAILURE);
	}
	return(res);
}


/*
 * Routine to abort the compilation and output useful diagnostic
 * information.
 *
 */

VOID xabort(VOID)
{	static PCHAR stars = "**********";

	fprintf(stderr, "*** Abort ***\n");
	fprintf(listfp, "\n%s Abort %s Abort %s Abort %s\n",
			stars, stars, stars, stars);

#if	DEBUG
	if(ca != cabuf)
		ncode(&code[0], &code[ppcurr], (UINT) cabuf);
	print_use();
	abort();
#endif
}


/*********************************************************************
 *	Packing and unpacking routines for 'ptype'.                  *
 ********************************************************************/

/* Layout of 'ptype':
 *
 * 'ptype' requires 16 bits to define a variable, and can be regarded as
 * as two bytes:
 *	upper one(uptype)	:= litl<<6!rout<<4!nam<<2!arr
 *	lower one(ptype)	:= prec<<4!type
 *
 * Often (e.g. in 'expop') only the lower part is required, as functions
 * etc. are prefetched and stacked.
 *
 * litl		:= 1=const,2=external,3=extrinsic(or dynamic), 0=none of these
 * rout		:= 1 for routine or fn or map, =0 none of these
 * nam		:= 2 for maps and 'refrefs',=1 for names ,=0 directly addressed
 * arr		:= 1 for arrays =0 scalars
 * prec		   is descriptor size code for each precision:
 *			:=0 bits, =3 bytes, =5 words, =6 d-wrds, =7,quad wrds
 * type		:= the variable type 
 *			:=0 (type general), =1 integer, =2 real, =3 record
 *			:=4 (recordformat), =5 string,  =6 label/switch.
 *			:=7 not set
 *
 */


/*
 * Routine to unpack 'ptype' into its component parts.
 *
 */

VOID unpack(VOID)
{	litl = ptype >> 14;
	rout = (ptype >> 12) & 0x03;
	nam = (ptype >> 10) & 0x03;
	arr = (ptype >> 8) & 0x03;
	prec = (ptype >> 4) & 0x0f;
	type = ptype & 0x0f;
}


/*
 * Routine to pack a 'ptype' value, but into a place specified by the
 * parameter.
 *
 */

VOID pack(PINT ptype)
{	*ptype = ((litl & 0x03) << 14) |
		 ((rout & 0x03) << 12) |
	 	 ((nam  & 0x03) << 10) |
		 ((arr  & 0x03) <<  8) |
		 ((prec & 0x0f) <<  4) |
		 (type & 0x0f);
}

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