Path: utzoo!utgpu!cs.utexas.edu!uunet!pilchuck!ssc!markz
From: markz@ssc.UUCP (Mark Zenier)
Newsgroups: alt.sources
Subject: Frankenstein Cross Assemblers, Base source, Part 2 of 3
Message-ID: <593@ssc.UUCP>
Date: 4 Dec 90 07:48:06 GMT
Organization: SSC, Inc., Seattle, WA
Lines: 2555
Archive-name: Frankasm/Base02
Submitted-by: markz@ssc.uucp

---- Cut Here and feed the following to sh ----
#!/bin/sh
# This is part 02 of Frankasm/Base
# ============= fraosub.c ==============
if test -f 'fraosub.c' -a X"$1" != X"-c"; then
	echo 'x - skipping fraosub.c (File already exists)'
else
echo 'x - extracting fraosub.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'fraosub.c' &&
X/*
XHEADER: 	;
XTITLE: 		Frankenstein Cross Assemblers;
XVERSION: 	2.0;
XDESCRIPTION: "	Reconfigurable Cross-assembler producing Intel (TM)
X		Hex format object records.  ";
XSYSTEM: 	UNIX, MS-Dos ;
XFILENAME: 	fraosub.c;
XWARNINGS: 	"This software is in the public domain.  
X		Any prior copyright claims are relinquished.  
X
X		This software is distributed with no warranty whatever.  
X		The author takes no responsibility for the consequences 
X		of its use."  ;
XSEE-ALSO: 	frasmain.c;
XAUTHORS: 	Mark Zenier;
X*/
X
X/*
X	description	output pass utility routines
X	history		September 27, 1987
X			March 15, 1988   release 1.1 WIDTH
X			September 14, 1990  Dosify, 6 char unique names
X*/
X
X
X#include <stdio.h>
X#include "frasmdat.h"
X#include "fragcon.h"
X
X#define OUTRESULTLEN 256
X#define NUMHEXPERL 16
X#define SOURCEOFFSET 24
X#define NUMHEXSOURCE 6
X
Xint linenumber = 0;
Xchar lineLbuff[INBUFFSZ];
Xint lineLflag = FALSE;
X
Xstatic unsigned char	outresult[OUTRESULTLEN];
Xstatic int	nextresult;
Xstatic long 	genlocctr, resultloc;
X
Xstatic char	*oeptr;
X
X#define	MAXIMPWID	24
X
Xstatic long widthmask[MAXIMPWID+1] =
X{
X/* 0 */		1L,
X/* 1 */		1L,
X/* 2 */		(1L <<  2 ) -1,
X/* 3 */		(1L <<  3 ) -1,
X/* 4 */		(1L <<  4 ) -1,
X/* 5 */		(1L <<  5 ) -1,
X/* 6 */		(1L <<  6 ) -1,
X/* 7 */		(1L <<  7 ) -1,
X/* 8 */		(1L <<  8 ) -1,
X/* 9 */		(1L <<  9 ) -1,
X/* 10 */	(1L <<  10 ) -1,
X/* 11 */	(1L <<  11 ) -1,
X/* 12 */	(1L <<  12 ) -1,
X/* 13 */	(1L <<  13 ) -1,
X/* 14 */	(1L <<  14 ) -1,
X/* 15 */	(1L <<  15 ) -1,
X/* 16 */	(1L <<  16 ) -1,
X/* 17 */	(1L <<  17 ) -1,
X/* 18 */	(1L <<  18 ) -1,
X/* 19 */	(1L <<  19 ) -1,
X/* 20 */	(1L <<  20 ) -1,
X/* 21 */	(1L <<  21 ) -1,
X/* 22 */	(1L <<  22 ) -1,
X/* 23 */	(1L <<  23 ) -1,
X/* 24 */	(1L <<  24 ) -1
X};
X	
X
Xstatic long dgethex()
X/*
X	description	convert the character string pointed to by
X			the output expression pointer to a long integer
X	globals		oeptr, the output expression pointer
X	return		the value
X*/
X{
X	long rv = 0;
X
X	while( *oeptr != '\0')
X	{
X		switch(*oeptr)
X		{
X		case '0':
X		case '1':
X		case '2':
X		case '3':
X		case '4':
X		case '5':
X		case '6':
X		case '7':
X		case '8':
X		case '9':
X			rv = (rv << 4) + ((*oeptr) - '0');
X			break;
X
X		case 'a':
X		case 'b':
X		case 'c':
X		case 'd':
X		case 'e':
X		case 'f':
X			rv = (rv << 4) + ((*oeptr) - 'a' + 10);
X			break;
X		
X		case 'A':
X		case 'B':
X		case 'C':
X		case 'D':
X		case 'E':
X		case 'F':
X			rv = (rv << 4) + ((*oeptr) - 'A' + 10);
X			break;
X
X		default:
X			return rv;
X		}
X
X		oeptr++;
X	}
X
X	return rv;
X}
X	
X
Xoutphase()
X/*
X	description	process all the lines in the intermediate file
X	globals		the input line
X			the output expression pointer
X			line number
X			file name
X			the binary output array and counts
X*/
X{
X	int firstchar;
X
X	for(;;)
X	{
X		if((firstchar = fgetc(intermedf)) == EOF)
X			break;
X
X		if(firstchar == 'L')
X		{
X			if(listflag)
X				flushlisthex();
X
X			if( fgets(&lineLbuff[1], INBUFFSZ-1, intermedf) 
X			 == (char *)NULL)
X			{
X		frp2error( "error or premature end of intermediate file");
X				break;
X			}
X
X			lineLflag = TRUE;
X		}
X		else
X		{
X			finbuff[0] = firstchar;
X			if(fgets( &finbuff[1], INBUFFSZ-1, intermedf) 
X			 == (char *)NULL)
X			{
X		frp2error("error or premature end of intermediate file");
X				break;
X			}
X		}
X	
X		switch(firstchar)
X		{
X		case 'E': /* error */
X			if(listflag)
X			{
X				flushsourceline();
X				fputs(&finbuff[2], loutf);
X			}
X			else
X			{
X				fprintf(loutf, "%s - line %d - %s", 
X					currentfnm, linenumber, &finbuff[2]);
X			}
X			break;
X
X		case 'L': /* listing */
X			linenumber++;
X			break;
X
X		case 'C': /* comment / uncounted listing */
X			if(listflag)
X			{
X				char *stuff = strchr(finbuff, '\n');
X
X				if(stuff != NULL)
X					*stuff = '\0';
X
X				fprintf(loutf,"%-*.*s", 
X				 SOURCEOFFSET, SOURCEOFFSET, &finbuff[2]);
X				if(lineLflag)
X				{
X					fputs(&lineLbuff[2], loutf);
X					lineLflag = FALSE;
X				}
X				else
X				{
X					fputc('\n', loutf);
X				}
X			}
X			break;
X
X		case 'P': /* location set */
X			oeptr = &finbuff[2];
X			currseg = dgethex();
X			oeptr++;
X			genlocctr = locctr = dgethex();
X			break;
X		
X		case 'D': /* data */
X			oeptr = &finbuff[2];
X			nextresult = 0;
X			resultloc = genlocctr;
X			outeval();
X			if(hexflag)
X				outhexblock();
X			if(listflag)
X				listhex();
X			break;
X		
X		case 'F': /* file start */
X			{
X				char *tp;
X				if( (tp = strchr(finbuff,'\n')) != (char *)NULL)
X					*tp = '\0';
X				strncpy(currentfnm, &finbuff[2], 100);
X				currentfnm[99] = '\0';
X			}
X			lnumstk[currfstk++] = linenumber;
X			linenumber = 0;
X			break;
X		
X		case 'X': /* file resume */
X			{
X				char *tp;
X				if( (tp = strchr(finbuff,'\n')) != (char *)NULL)
X					*tp = '\0';
X				strncpy(currentfnm, &finbuff[2], 100);
X				currentfnm[99] = '\0';
X			}
X			linenumber = lnumstk[--currfstk];
X			break;
X
X		default:
X			frp2error("unknown intermediate file command");
X			break;
X		}
X	}
X
X	if(hexflag)
X		flushhex();
X
X	if(listflag)
X		flushlisthex();
X}
X
Xouteval()
X/*
X	description	convert the polish form character string in the 
X			intermediate file 'D' line to binary values in the
X			output result array.
X	globals		the output expression pointer
X			the output result array
X*/
X{
X	register long etop = 0;
X
X	register struct evstkel *estkm1p = &estk[0];
X
X	while( *oeptr != '\0')
X	{
X		switch(*oeptr)
X		{
X		case '0':
X		case '1':
X		case '2':
X		case '3':
X		case '4':
X		case '5':
X		case '6':
X		case '7':
X		case '8':
X		case '9':
X			etop = (etop << 4) + ((*oeptr) - '0');
X			break;
X
X		case 'a':
X		case 'b':
X		case 'c':
X		case 'd':
X		case 'e':
X		case 'f':
X			etop = (etop << 4) + ((*oeptr) - 'a' + 10);
X			break;
X		
X		case 'A':
X		case 'B':
X		case 'C':
X		case 'D':
X		case 'E':
X		case 'F':
X			etop = (etop << 4) + ((*oeptr) - 'A' + 10);
X			break;
X
X#include "fraeuni.h"
X#include "fraebin.h"
X		case IFC_SYMB:
X			{
X				struct symel *tsy;
X
X				tsy = symbindex[etop];
X				if(tsy -> seg <= 0)
X				{
X					frp2undef(tsy);
X					etop = 0;
X				}
X				else
X				{
X					if(tsy -> seg == SSG_EQU ||
X					   tsy -> seg == SSG_SET)
X					{
X			frp2warn( "forward reference to SET/EQU symbol");
X					}
X					etop = tsy -> value;
X				}
X			}
X			break;
X
X		case IFC_CURRLOC: 
X			etop = genlocctr;
X			break;
X
X		case IFC_PROGCTR:
X			etop = locctr;
X			break;
X
X		case IFC_DUP:
X			if(estkm1p >= &estk[PESTKDEPTH-1])
X			{
X				frp2error("expression stack overflow");
X			}
X			else
X			{
X				(++estkm1p)->v = etop;
X			}
X			break;
X
X		case IFC_LOAD:
X			if(estkm1p >= &estk[PESTKDEPTH-1])
X			{
X				frp2error("expression stack overflow");
X			}
X			else
X			{
X				(++estkm1p)->v = etop;
X			}
X			etop = 0;
X			break;
X
X		case IFC_CLR:
X			etop = 0;
X			break;
X
X		case IFC_CLRALL:
X			etop = 0;
X			estkm1p = &estk[0];
X			break;
X
X		case IFC_POP:
X			etop = (estkm1p--)->v;
X			break;
X
X		case IFC_TESTERR:
X			if(etop)
X			{
X				frp2error(
X			"expression fails validity test");
X			}
X			break;
X
X		case IFC_SWIDTH:
X			if( etop > 0 && etop <= MAXIMPWID)
X			{
X				if( estkm1p->v < -(widthmask[etop-1]+1) ||
X				    estkm1p->v > widthmask[etop-1] )
X				{
X					frp2error(
X				"expression exceeds available field width");
X				}
X				etop = ((estkm1p--)->v)  & widthmask[etop];
X			}
X			else
X				frp2error("unimplemented width");
X			break;
X
X		case IFC_WIDTH:
X			if( etop > 0 && etop <= MAXIMPWID)
X			{
X				if( estkm1p->v < -(widthmask[etop-1]+1) ||
X				    estkm1p->v > widthmask[etop] )
X				{
X					frp2error(
X				"expression exceeds available field width");
X				}
X				etop = ((estkm1p--)->v)  & widthmask[etop];
X			}
X			else
X				frp2error("unimplemented width");
X			break;
X
X		case IFC_IWIDTH:
X			if( etop > 0 && etop <= MAXIMPWID)
X			{
X				if( estkm1p->v < 0 ||
X				    estkm1p->v > widthmask[etop] )
X				{
X					frp2error(
X				"expression exceeds available field width");
X				}
X				etop = ((estkm1p--)->v)  & widthmask[etop];
X			}
X			else
X				frp2error("unimplemented width");
X			break;
X
X		case IFC_EMU8:
X			if( etop >= -128 && etop <= 255)
X			{
X				outresult[nextresult++] = etop & 0xff;
X			}
X			else
X			{
X				outresult[nextresult++] = 0;
X				frp2error(
X			"expression exceeds available field width");
X			}
X			genlocctr ++;
X			etop = 0;
X			break;
X
X		case IFC_EMS7:
X			if(etop >= -128 && etop <= 127)
X			{
X				outresult[nextresult++] = etop & 0xff;
X			}
X			else
X			{
X				outresult[nextresult++] = 0;
X				frp2error(
X			"expression exceeds available field width");
X			}
X			genlocctr ++;
X			etop = 0;
X			break;
X
X		case IFC_EM16:
X			if(etop >= -32768L && etop <= 65535L)
X			{
X				outresult[nextresult++] = (etop >> 8) & 0xff;
X				outresult[nextresult++] = etop & 0xff;
X			}
X			else
X			{
X				outresult[nextresult++] = 0;
X				outresult[nextresult++] = 0;
X				frp2error(
X			"expression exceeds available field width");
X			}
X			genlocctr += 2;
X			etop = 0;
X			break;
X
X		case IFC_EMBR16:
X			if(etop >= -32768L && etop <= 65535L)
X			{
X				outresult[nextresult++] = etop & 0xff;
X				outresult[nextresult++] = (etop >> 8) & 0xff;
X			}
X			else
X			{
X				outresult[nextresult++] = 0;
X				outresult[nextresult++] = 0;
X				frp2error(
X			"expression exceeds available field width");
X			}
X			genlocctr += 2;
X			etop = 0;
X			break;
X
X		default:
X			break;
X		}
X		oeptr++;
X	}
X}
X
Xstatic long lhaddr, lhnextaddr;
Xstatic int lhnew, lhnext = 0;
Xstatic unsigned char listbuffhex[NUMHEXPERL];
X
Xflushlisthex()
X/*
X	description	output the residue of the hexidecimal values for
X			the previous assembler statement.
X	globals		the new hex list flag
X*/
X{
X	listouthex();
X	lhnew = TRUE;
X}
X
Xlisthex()
X/*
X	description	buffer the output result to block the hexidecimal 
X			listing on the output file to NUMHEXPERL bytes per
X			listing line.
X	globals		The output result array and count
X			the hex line buffer and counts
X*/
X{
X	register int cht;
X	register long inhaddr = resultloc;
X
X	if(lhnew)
X	{
X		lhaddr = lhnextaddr = resultloc;
X		lhnew = FALSE;
X	}
X
X	for(cht = 0; cht < nextresult; cht++)
X	{
X		if(lhnextaddr != inhaddr 
X		 || lhnext >= (lineLflag ? NUMHEXSOURCE : NUMHEXPERL ) )
X		{
X			listouthex();
X			lhaddr = lhnextaddr = inhaddr;
X		}
X		listbuffhex[lhnext++] = outresult[cht];
X		lhnextaddr ++;
X		inhaddr ++;
X	}
X}
X
Xlistouthex()
X/*
X	description	print a line of hexidecimal on the listing
X	globals		the hex listing buffer
X*/
X{
X	register int cn;
X	register int tc;
X
X	if(lhnext > 0)
X	{
X		fputc(hexch((int)lhaddr>>12), loutf);
X		fputc(hexch((int)lhaddr>>8), loutf);
X		fputc(hexch((int)lhaddr>>4), loutf);
X		fputc(hexch((int)lhaddr), loutf);
X		fputc(' ', loutf);
X
X		for(cn = 0; cn < lhnext; cn++)
X		{
X			fputc(hexch((int)(tc = listbuffhex[cn])>>4), loutf);
X			fputc(hexch(tc), loutf);
X			fputc(' ', loutf);
X		}
X
X		if( ! lineLflag)
X			fputc('\n', loutf);
X	}
X
X	if(lineLflag)
X	{
X		if(lineLbuff[2] != '\n')
X		{
X			switch(lhnext)
X			{
X			case 0:
X				fputs("\t\t\t",loutf);
X				break;
X			case 1:
X			case 2:
X			case 3:
X				fputs("\t\t",loutf);
X				break;
X			case 4:
X			case 5:
X			case 6:
X				fputs("\t",loutf);
X			default:
X				break;
X			}
X
X			fputs(&lineLbuff[2], loutf);
X			lineLflag = FALSE;
X		}
X		else
X		{
X			fputc('\n', loutf);
X		}
X	}
X		
X	lhnext = 0;
X}
X
X#define INTELLEN 32
X
Xstatic long nextoutaddr, blockaddr;
Xstatic int hnextsub;
Xstatic char hlinebuff[INTELLEN];
X
X
Xouthexblock()
X/*
X	description	buffer the output result to group adjacent output
X			data into longer lines.
X	globals		the output result array
X			the intel hex line buffer
X*/
X{
X	long inbuffaddr = resultloc;
X	static int first = TRUE;
X
X	int loopc;
X
X	if(first)
X	{
X		nextoutaddr = blockaddr = resultloc;
X		hnextsub = 0;
X		first = FALSE;
X	}
X
X	for(loopc = 0; loopc < nextresult; loopc++)
X	{
X		if(nextoutaddr != inbuffaddr || hnextsub >= INTELLEN)
X		{
X			intelout(0, blockaddr, hnextsub, hlinebuff);
X			blockaddr = nextoutaddr = inbuffaddr;
X			hnextsub = 0;
X		}
X		hlinebuff[hnextsub++] = outresult[loopc];
X		nextoutaddr++;
X		inbuffaddr++;
X	}
X}
X
Xflushhex()
X/*
X	description	flush the intel hex line buffer at the end of
X			the second pass
X	globals		the intel hex line buffer
X*/
X{
X	if(hnextsub > 0)
X		intelout(0, blockaddr, hnextsub, hlinebuff);
X	if(endsymbol != SYMNULL && endsymbol -> seg > 0)
X		intelout(1, endsymbol -> value, 0, "");
X	else
X		intelout(1, 0L, 0, "");
X		
X}
X
X
Xintelout(type, addr, count, data)
X	int type;
X	long addr;
X	int count;
X	char data[];
X/*
X	description	print a line of intel format hex data to the output
X			file
X	parameters	see manual for record description
X*/
X{
X	register int temp, checksum;
X
X	fputc(':', hexoutf);
X	fputc(hexch(count>>4),hexoutf);
X	fputc(hexch(count),hexoutf);
X	fputc(hexch((int)addr>>12),hexoutf);
X	fputc(hexch((int)addr>>8),hexoutf);
X	fputc(hexch((int)addr>>4),hexoutf);
X	fputc(hexch((int)addr),hexoutf);
X	fputc(hexch(type>>4),hexoutf);
X	fputc(hexch(type),hexoutf);
X
X	checksum = ((addr >> 8) & 0xff) + (addr & 0xff) + (count & 0xff);
X	checksum += type & 0xff;
X
X	for(temp = 0; temp < count; temp ++)
X	{
X		checksum += data[temp] & 0xff;
X		fputc(hexch(data[temp] >> 4), hexoutf);
X		fputc(hexch(data[temp]), hexoutf);
X	}
X
X	checksum = (-checksum) & 0xff;
X	fputc(hexch(checksum>>4), hexoutf);
X	fputc(hexch(checksum), hexoutf);
X	fputc('\n',hexoutf);
X}
X
X
Xfrp2undef(symp)
X	struct symel * symp;
X/*
X	description	second pass - print undefined symbol error message on
X			the output listing device.  If the the listing flag
X			is false, the output device is the standard output, and
X			the message format is different.
X	parameters	a pointer to a symbol table element
X	globals		the count of errors
X*/
X{
X	if(listflag)
X	{
X		flushsourceline();
X		fprintf(loutf," ERROR -  undefined symbol %s\n", symp ->symstr);
X	}
X	else
X		fprintf(loutf, "%s - line %d - ERROR - undefined symbol  %s\n", 
X			currentfnm, linenumber, symp -> symstr);
X	errorcnt++;
X}
X
Xfrp2warn(str)
X	char * str;
X/*
X	description	second pass - print a warning message on the listing
X			file, varying the format for console messages.
X	parameters	the message
X	globals		the count of warnings
X*/
X{
X	if(listflag)
X	{
X		flushsourceline();
X		fprintf(loutf, " WARNING - %s\n", str);
X	}
X	else
X		fprintf(loutf, "%s - line %d - WARNING - %s\n", 
X			currentfnm, linenumber, str);
X	warncnt++;
X}
X
X
Xfrp2error(str)
X	char * str;
X/*
X	description	second pass - print a message on the listing file
X	parameters	message
X	globals		count of errors
X*/
X{
X	if(listflag)
X	{
X		flushsourceline();
X		fprintf(loutf, " ERROR - %s\n", str);
X	}
X	else
X		fprintf(loutf, "%s - line %d - ERROR - %s\n", 
X			currentfnm, linenumber, str);
X	errorcnt++;
X}
X
Xflushsourceline()
X/*
X	description	flush listing line buffer before an error for
X			that line is printed
X*/
X{
X	if(listflag && lineLflag)
X	{
X		fputs("\t\t\t", loutf);
X		fputs(&lineLbuff[2], loutf);
X		lineLflag = FALSE;
X	}
X}
SHAR_EOF
true || echo 'restore of fraosub.c failed'
fi
# ============= frapsub.c ==============
if test -f 'frapsub.c' -a X"$1" != X"-c"; then
	echo 'x - skipping frapsub.c (File already exists)'
else
echo 'x - extracting frapsub.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'frapsub.c' &&
X/*
XHEADER: 	;
XTITLE: 		Frankenstein Cross Assemblers;
XVERSION: 	2.0;
XDESCRIPTION: "	Reconfigurable Cross-assembler producing Intel (TM)
X		Hex format object records.  ";
XSYSTEM: 	UNIX, MS-Dos ;
XFILENAME: 	frapsub.c ;
XWARNINGS: 	"This software is in the public domain.  
X		Any prior copyright claims are relinquished.  
X
X		This software is distributed with no warranty whatever.  
X		The author takes no responsibility for the consequences 
X		of its use.  "  ;
XSEE-ALSO: 	frasmain.c;
XAUTHORS: 	Mark Zenier;
X*/
X
X/*
X	description	Parser phase utility routines
X	History		September 1987
X			September 14, 1990 Dosify, 6 char unique names
X*/
X
X#include "fragcon.h"
X#include <stdio.h>
X#include "frasmdat.h"
X
X#define STRALLOCSZ 4096
X
X	local char *currstr;
X
Xchar * savestring(stx, len)
X	char *stx;
X	int len;
X/*
X	description	save a character string in permanent (interpass) memory
X	parameters	the string and its length
X	globals 	the string pool
X	return		a pointer to the saved string
X*/
X{
X	char * rv;
X	static int savestrleft = 0;
X
X	if( savestrleft < (len+1))
X	{
X		if((currstr = malloc(STRALLOCSZ)) == (char *)NULL)
X		{
X			frafatal("cannot allocate string storage");
X		}
X		savestrleft = STRALLOCSZ;
X	}
X
X	savestrleft -= (len+1);
X
X	rv = currstr;
X	for(; len > 0; len--)
X		*currstr++ = *stx++;
X	*currstr++ = '\0';
X
X	return rv;
X}
X
X/* expression node operations */
X
X/* expression tree element */
Xstruct etelem
X{
X	int	evs;
X	int	op;
X	int	left, right;
X	long	val;
X	struct symel *sym;
X};
X
X#define NUMENODE INBUFFSZ
Xstruct etelem enode[NUMENODE];
X
Xlocal int nextenode = 1;
X
X/* non general, one exprlist or stringlist per line */
Xint nextexprs = 0;
Xint nextstrs = 0;
X
Xclrexpr()
X/*
X	description	clear out the stuff used for each line
X			the temporary string pool
X			the expression tree storage pool
X			the string and expression lists
X*/
X{
X	nextenode = 1;
X	nextexprs = nextstrs = 0;
X}
X
Xexprnode(swact, left, op, right, value, symbol)
X	int swact, left, op, right;
X	long value;
X	struct symel * symbol;
X/*
X	description	add an element to the expression tree pool
X	parameters	swact, the action performed by the switch in
X				the polish conversion routine, the category
X				of the expression node.
X			left, right  the subscripts of the decendent nodes
X					of the expression tree element
X			op, the operation to preform
X			value, a constant value (maybe)
X			symbol, a pointer to a symbol element (maybe)
X	globals		the next available table element
X	return		the subscript of the expression node
X*/
X{
X	if(nextenode >= NUMENODE)
X	{
X		frafatal("excessive number of subexpressions");
X	}
X
X	enode [nextenode].evs = swact;
X	enode [nextenode].left = left;
X	enode [nextenode].op = op;
X	enode [nextenode].right = right;
X	enode [nextenode].val = value;
X	enode [nextenode].sym = symbol;
X
X	return nextenode ++;
X}
X
Xint nextsymnum = 1;
X
Xlocal struct symel *syallob;
X#define SYELPB 512
Xlocal int nxtsyel = SYELPB;
X
Xstruct symel *allocsym()
X/*
X	description	allocate a symbol table element, and allocate
X			a block if the current one is empty.  A fatal
X			error if no more space can be gotten
X	globals		the pointer to the current symbol table block
X			the count of elements used in the block
X	return		a pointer to the symbol table element
X*/
X{
X
X	if(nxtsyel >= SYELPB)
X	{
X		if( (syallob = (struct symel *)calloc(
X			SYELPB , sizeof(struct symel)))
X		 == (struct symel *)NULL)
X		{
X			frafatal("cannot allocate symbol space");
X		}
X
X		nxtsyel = 0;
X	}
X
X	return &syallob[nxtsyel++];
X}
X
X
X#define SYHASHOFF 13
X#define SYHASHSZ 1023
X
Xint syhash(str)
X	register char *str;
X/*
X	description	produce a hash index from a character string for
X			the symbol table.
X	parameters 	a character string
X	return		an integer related in some way to the character string
X*/
X{
X	unsigned rv = 0;
X	register int offset = 1;
X	register int c;
X
X	while((c = *(str++)) > 0)
X	{
X		rv += (c - ' ') * offset;
X		offset *= SYHASHOFF;
X	}
X
X	return rv % SYHASHSZ;
X}
X
Xlocal struct symel * (shashtab[SYHASHSZ]);
X
Xstatic struct symel *getsymslot(str)
X	char * str;
X/*
X	description	find an existing symbol in the symbol table, or
X			allocate an new element if the symbol doen't exist.
X			action: hash the string
X				if there are no symbols for the hash value
X					create one for this string
X				otherwise
X				scan the linked list until the symbol is 
X				found or the end of the list is found
X				if the symbol was found
X					exit
X				if the symbol was not found, allocate and
X				add at the end of the linked list
X				fill out the symbol
X	parameters	the character string 
X	globals		all the symbol table
X	return		a pointer to the symbol table element for this
X			character string
X*/
X{
X	struct symel *currel, *prevel;
X	int hv;
X
X	if( (currel = shashtab[hv = syhash(str)])
X	    == (struct symel *)NULL)
X	{
X		shashtab[hv] = currel = allocsym();
X	}
X	else
X	{
X		do  {
X			if(strcmp(currel -> symstr, str) == 0)
X			{
X				return currel;
X			}
X			else
X			{
X				prevel = currel;
X				currel = currel -> nextsym;
X			}
X		} while( currel != (struct symel *)NULL);
X
X		prevel -> nextsym = currel = allocsym();
X	}
X
X	currel -> symstr = savestring(str, strlen(str));
X	currel -> nextsym = (struct symel *)NULL;
X	currel -> tok = 0;
X	currel -> value = 0;
X	currel -> seg = SSG_UNUSED;
X
X	return currel;
X}
X
Xstruct symel * symbentry(str,toktyp)
X	char * str;
X	int toktyp;
X/*
X	description	find or add a nonreserved symbol to the symbol table
X	parameters	the character string
X			the syntactic token type for this charcter string
X				(this is a parameter so the routine doesn't
X				have to be recompiled since the yacc grammer
X				provides the value)
X	globals		the symbol table in all its messy glory
X	return		a pointer to the symbol table element
X*/
X{
X	struct symel * rv;
X
X	rv = getsymslot(str);
X
X	if(rv -> seg == SSG_UNUSED)
X	{
X		rv -> tok = toktyp;
X		rv -> symnum = nextsymnum ++;
X		rv -> seg = SSG_UNDEF;
X	}
X
X	return rv;
X}
X
Xvoid reservedsym(str, tok, value)
X	char * str;
X	int tok;
X	int value;
X/*
X	description	add a reserved symbol to the symbol table.
X	parameters	the character string, must be a constant as
X			the symbol table does not copy it, only point to it.
X			The syntactic token value.
X			The associated value of the symbol.
X*/
X{
X	struct symel * tv;
X
X	tv = getsymslot(str);
X
X	if(tv -> seg != SSG_UNUSED)
X	{
X		frafatal("cannot redefine reserved symbol");
X	}
X
X	tv -> symnum = 0;
X	tv -> tok = tok;
X	tv -> seg = SSG_RESV;
X	tv -> value = value;
X
X}
X
Xbuildsymbolindex()
X/*
X	description	allocate and fill an array that points to each
X			nonreserved symbol table element, used to reference
X			the symbols in the intermediate file, in the output
X			pass.
X	globals		the symbol table
X*/
X{
X	int hi;
X	struct symel *curr;
X
X	if((symbindex = (struct symel **)calloc((unsigned)nextsymnum, 
X			sizeof (struct symel *))) == (struct symel **)NULL)
X	{
X		frafatal(" unable to allocate symbol index");
X	}
X
X	for(hi = 0; hi < SYHASHSZ; hi++)
X	{
X		if( (curr = shashtab[hi]) != SYMNULL)
X		{
X			do  {
X				if( curr -> symnum)
X					symbindex[curr -> symnum] = curr;
X
X				curr = curr -> nextsym;
X			}  while(curr != SYMNULL);
X		}
X	}
X}
X
X/* opcode symbol table */
X
X#define OPHASHOFF 13
X#define OPHASHSZ 1023
X
Xlocal int ohashtab[OPHASHSZ];
X
Xsetophash()
X/*
X	description	set up the linked list hash table for the
X			opcode symbols 
X	globals		the opcode hash table
X			the opcode table
X*/
X{
X	int opn, pl, hv;
X
X		/* optab[0] is reserved for the "invalid" entry */
X		/*  opcode subscripts range from 0 to numopcode - 1 */
X	for(opn = 1; opn < gnumopcode; opn++)
X	{
X		hv = opcodehash(optab[opn].opstr);
X
X		if( (pl = ohashtab[hv]) == 0)
X		{
X			ohashtab[hv] = opn;
X		}
X		else
X		{
X			while( ophashlnk[pl] != 0)
X			{
X				pl = ophashlnk[pl];
X			}
X
X			ophashlnk[pl] = opn;
X			ophashlnk[opn] = 0;
X		}
X	}
X}
X
X
Xint findop(str)
X	char *str;
X/*
X	description	find an opcode table subscript
X	parameters	the character string
X	globals		the opcode hash linked list table
X			the opcode table
X	return		0 if not found
X			the subscript of the matching element if found
X*/
X{
X	int ts;
X
X	if( (ts = ohashtab[opcodehash(str)]) == 0)
X	{
X		return 0;
X	}
X
X	do  {
X		if(strcmp(str,optab[ts].opstr) == 0)
X		{
X			return ts;
X		}
X		else
X		{
X			ts = ophashlnk[ts];
X		}
X	} while (ts != 0);
X
X	return 0;
X}
X
X
Xint opcodehash(str)
X	char *str;
X/*
X	description	hash a character string
X	return		an integer related somehow to the character string
X*/
X{
X	unsigned rv = 0;
X	int offset = 1, c;
X
X	while((c = *(str++)) > 0)
X	{
X		rv += (c - ' ') * offset;
X		offset *= OPHASHOFF;
X	}
X
X	return rv % OPHASHSZ;
X}
X
X
Xchar * findgen(op, syntax, crit)
X	int	op, syntax, crit;
X/*
X	description	given the subscript of the opcode table element,
X			find the instruction generation string for the
X			opcode with the given syntax and fitting the
X			given criteria.  This implement a sparse matrix
X			for  the dimensions [opcode, syntax] and then
X			points to a list of generation elements that
X			are matched to the criteria (binary set) that
X			are provided by the action in the grammer for that
X			specific syntax.
X	parameters	Opcode table subscript
X				note 0 is the value which points to an
X				syntax list that will accept anything
X				and gives the invalid instruction error
X			Syntax, a selector, a set member
X			Criteria, a integer used a a group of bit sets
X	globals		the opcode table, the opcode syntax table, the
X			instruction generation table
X	return		a pointer to a character string, either a
X			error message, or the generation string for the
X			instruction
X*/
X{
X	int	sys = optab[op].subsyn, stc, gsub = 0, dctr;
X
X	for(stc = optab[op].numsyn; stc > 0; stc--)
X	{
X		if( (ostab[sys].syntaxgrp & syntax) != 0)
X		{
X			gsub = ostab[sys].gentabsub;
X			break;
X		}
X		else
X			sys++;
X	}
X
X	if(gsub == 0)
X		return ignosyn;
X
X	for(dctr = ostab[sys].elcnt; dctr > 0; dctr--)
X	{
X		if( (igtab[gsub].selmask & crit) == igtab[gsub].criteria)
X		{
X			return igtab[gsub].genstr;
X		}
X		else
X		{
X			gsub++;
X		}
X	}
X
X	return ignosel;
X}
X
X
Xgenlocrec(seg, loc)
X	int seg;
X	long loc;
X/*
X	description	output to the intermediate file, a 'P' record
X			giving the current location counter.  Segment
X			is not used at this time.
X*/
X{
X	fprintf(intermedf, "P:%x:%lx\n", seg, loc);
X}
X
X#define GSTR_PASS 0
X#define GSTR_PROCESS 1
X
Xlocal char *goutptr, goutbuff[INBUFFSZ] = "D:";
X
Xvoid goutch(ch)
X	char ch;
X/*
X	description	put a character in the intermediate file buffer
X			for 'D' data records
X	globals		the buffer, its current position pointer
X*/
X{
X	if(goutptr < &goutbuff[INBUFFSZ-1])
X	{
X		*goutptr ++ = ch;
X	}
X	else
X	{
X		goutbuff[INBUFFSZ-1] = '\0';
X		goutptr = &goutbuff[INBUFFSZ]; 
X		fraerror("overflow in instruction generation");
X	}
X}
X
X
Xgout2hex(inv)
X	int inv;
X/*
X	description	output to the 'D' buffer, a byte in ascii hexidecimal
X*/
X{
X	goutch(hexch( inv>>4 ));
X	goutch(hexch( inv ));
X}
X
X
Xgoutxnum(num)
X	unsigned long num;
X/*
X	description	output to the 'D' record buffer a long integer in
X			hexidecimal
X*/
X{
X	if(num > 15)
X		goutxnum(num>>4);
X	goutch(hexch((int) num ));
X}
X
X
Xint geninstr(str)
X	register char * str;
X/*
X	description	Process an instruction generation string, from
X			the parser, into a polish form expression line
X			in a 'D' record in the intermediate file, after
X			merging in the expression results.
X	parameters	the instruction generation string
X	globals		the evaluation results 
X				evalr[].value	a numeric value known at
X						the time of the first pass
X				evalr[].exprstr  a polish form expression
X						derived from the expression
X						parse tree, to be evaluated in
X						the output phase.
X	return		the length of the instruction (machine code bytes)
X*/
X{
X	int len = 0;
X	int state = GSTR_PASS;
X	int innum = 0;
X
X	register char *exp;
X
X	goutptr = &goutbuff[2];
X
X	while( *str != '\0')
X	{
X		if(state == GSTR_PASS)
X		{
X			switch(*str)
X			{
X			case IG_START:
X				state = GSTR_PROCESS;
X				innum = 0;
X				str++;
X				break;
X
X			case IFC_EMU8:
X			case IFC_EMS7:
X				len++;
X				goutch(*str++);
X				break;
X
X			case IFC_EM16:
X			case IFC_EMBR16:
X				len += 2;
X				goutch(*str++);
X				break;
X
X			default:
X				goutch(*str++);
X				break;
X			}
X		}
X		else
X		{
X			switch(*str)
X			{
X			case IG_END:
X				state = GSTR_PASS;
X				str++;
X				break;
X			
X			case '0':
X			case '1':
X			case '2':
X			case '3':
X			case '4':
X			case '5':
X			case '6':
X			case '7':
X			case '8':
X			case '9':
X				innum = (innum << 4) + (*str++) - '0';
X				break;
X			
X			case 'a':
X			case 'b':
X			case 'c':
X			case 'd':
X			case 'e':
X			case 'f':
X				innum = (innum << 4) + (*str++) - 'a' + 10;
X				break;
X			
X			case 'A':
X			case 'B':
X			case 'C':
X			case 'D':
X			case 'E':
X			case 'F':
X				innum = (innum << 4) + (*str++) - 'A' + 10;
X				break;
X			
X			case IG_CPCON:
X				goutxnum((unsigned long)evalr[innum].value);
X				innum = 0;
X				str++;
X				break;
X
X			case IG_CPEXPR:
X				exp = &evalr[innum].exprstr[0];
X				innum = 0;
X				while(*exp != '\0')
X					goutch(*exp++);
X				str++;
X				break;
X			
X			case IG_ERROR:
X				fraerror(++str);
X				return 0;
X			
X			default:
X				fraerror(
X				"invalid char in instruction generation");
X				break;
X			}
X		}
X	}
X
X	if(goutptr > &goutbuff[2])
X	{
X		goutch('\n');
X		fwrite(goutbuff,sizeof (char), goutptr - &goutbuff[0], 
X			intermedf);
X	}
X
X	return len;
X}
X
Xint 	chtnxalph = 1, *chtcpoint = (int *)NULL, *chtnpoint = (int *)NULL;
X
Xint chtcreate()
X/*
X	description	allocate and initialize a character translate
X			table
X	return		0 for error, subscript into chtatab to pointer
X			to the allocated block
X*/
X{
X	int *trantab, cnt;
X
X	if(chtnxalph >= NUM_CHTA)
X		return 0; /* too many */
X
X	if( (trantab =  (int *)calloc(512, sizeof (int))) == (int *) NULL)
X		return 0;
X
X	for(cnt = 0; cnt < 512; cnt++)
X		trantab[cnt] = -1;
X	
X	chtatab[chtnxalph] = chtnpoint = trantab;
X
X	return chtnxalph++;
X}
X
X
Xint chtcfind(chtab, sourcepnt, tabpnt, numret)
X/*
X	description	find a character in a translate table
X	parameters	pointer to translate table
X			pointer to pointer to input string
X			pointer to return value integer pointer
X			pointer to numeric return
X	return		status of search
X*/
X	int *chtab;
X	char **sourcepnt; 
X	int **tabpnt;
X	int *numret;
X{
X	int numval, *valaddr;
X	char *sptr, cv;
X
X	sptr = *sourcepnt;
X
X	switch( cv = *sptr)
X	{
X	case '\0':
X		return CF_END;
X
X	default:
X		if( chtab == (int *)NULL)
X		{
X			*numret = *sptr;
X			*sourcepnt = ++sptr;
X			return CF_NUMBER;
X		}
X		else
X		{
X			valaddr = &(chtab[cv & 0xff]);
X			*sourcepnt = ++sptr;
X			*tabpnt = valaddr;
X			return (*valaddr == -1) ?
X				CF_UNDEF : CF_CHAR;
X		}
X		
X	case '\\':
X		switch(cv =  *(++sptr) )
X		{
X		case '\0':
X			*sourcepnt = sptr;
X			return CF_INVALID;
X		
X		case '\'':
X		case '\"':
X		case '\\':
X			if( chtab == (int *)NULL)
X			{
X				*numret = *sptr;
X				*sourcepnt = ++sptr;
X				return CF_NUMBER;
X			}
X			else
X			{
X				valaddr = &(chtab[(cv & 0xff) + 256]);
X				*sourcepnt = ++sptr;
X				*tabpnt = valaddr;
X				return (*valaddr == -1) ?
X					CF_UNDEF : CF_CHAR;
X			}
X
X
X		default:
X			if( chtab == (int *)NULL)
X			{
X				*sourcepnt = ++sptr;
X				return CF_INVALID;
X			}
X			else
X			{
X				valaddr = &(chtab[(cv & 0xff) + 256]);
X				*sourcepnt = ++sptr;
X				*tabpnt = valaddr;
X				return (*valaddr == -1) ?
X					CF_UNDEF : CF_CHAR;
X			}
X
X		case '0': case '1': case '2': case '3':
X		case '4': case '5': case '6': case '7':
X			{
X				numval = cv - '0';
X				cv =  *(++sptr);
X				if(cv >= '0' && cv <= '7')
X				{
X					numval = numval * 8 +
X						cv - '0';
X
X					cv = *(++sptr);
X					if(cv >= '0' && cv <= '7')
X					{
X						numval = numval * 8 +
X							cv - '0';
X						++sptr;
X					}
X				}
X				*sourcepnt = sptr;
X				*numret = numval & 0xff;
X				return CF_NUMBER;
X			}
X
X		case 'x':
X			switch(cv = *(++sptr))
X			{
X			case '0': case '1': case '2': case '3':
X			case '4': case '5': case '6': case '7':
X			case '8': case '9':
X				numval = cv - '0';
X				break;
X			
X			case 'a': case 'b': case 'c':
X			case 'd': case 'e': case 'f':
X				numval = cv - 'a' + 10; 
X				break;
X			
X			case 'A': case 'B': case 'C':
X			case 'D': case 'E': case 'F':
X				numval = cv - 'A' + 10;
X				break;
X			
X			default:
X				*sourcepnt = sptr;
X				return CF_INVALID;
X			}
X
X			switch(cv = *(++sptr))
X			{
X			case '0': case '1': case '2': case '3':
X			case '4': case '5': case '6': case '7':
X			case '8': case '9':
X				numval = numval * 16 + cv - '0';
X				++sptr;
X				break;
X			
X			case 'a': case 'b': case 'c': 
X			case 'd': case 'e': case 'f':
X				numval = numval * 16 + cv - 'a' + 10; 
X				++sptr;
X				break;
X			
X			case 'A': case 'B': case 'C':
X			case 'D': case 'E': case 'F':
X				numval = numval * 16 + cv - 'A' + 10;
X				++sptr;
X				break;
X			
X			default:
X				break;
X			}
X
X			*sourcepnt = sptr;
X			*numret = numval;
X			return CF_NUMBER;
X		}
X	}
X}
X
Xint chtran(sourceptr)
X	char **sourceptr;
X{
X	int numval;
X	int *retptr;
X	char *beforeptr = *sourceptr;
X
X	switch(chtcfind(chtcpoint, sourceptr, &retptr, &numval))
X	{
X	case CF_END:
X	default:
X		return 0;
X	
X	case CF_INVALID:
X		fracherror("invalid character constant", beforeptr, *sourceptr);
X		return 0;
X
X	case CF_UNDEF:
X		fracherror("undefined character value", beforeptr, *sourceptr);
X		return 0;
X
X	case CF_NUMBER:
X		return numval;
X
X	case CF_CHAR:
X		return *retptr;
X	}
X}
X
X
Xint genstring(str)
X	char *str;
X/*
X	description	Produce 'D' records for a ascii string constant
X			by chopping it up into lengths that will fit
X			in the intermediate file
X	parameters	a character string
X	return		the length of the string total (machine code bytes)
X*/
X{
X#define STCHPERLINE 20
X	int rvlen = 0, linecount;
X
X	while(*str != '\0')
X	{
X		goutptr = &goutbuff[2];
X
X		for( linecount = 0; 
X			linecount < STCHPERLINE && *str != '\0';
X			linecount++)
X		{
X			gout2hex(chtran(&str));
X			goutch(IFC_EMU8);
X			rvlen++;
X		}
X
X		if(goutptr > &goutbuff[2])
X		{
X			goutch('\n');
X			fwrite(goutbuff,sizeof (char), goutptr - &goutbuff[0], 
X				intermedf);
X		}
X	}
X
X	return rvlen;
X}
X	
Xstatic char *pepolptr;
Xstatic int pepolcnt;
Xstatic long etop;
Xstatic int	etopseg;
X#define STACKALLOWANCE 4 /* number of level used outside polish expr */
X
Xpevalexpr(sub, exn)
X	int sub, exn;
X/*
X	description	evaluate and save the results of an expression tree
X	parameters	the subscript to the evalr element to place the results
X			the subscript of the root node of a parser expression
X				tree
X	globals		the evaluation results array
X			the expression stack
X			the expression tree node array
X	return		in evalr[sub].seg == SSG_UNDEF if the polish expression
X			conversion overflowed, or any undefined symbols were
X			referenced.
X*/
X{
X	etop = 0;
X	etopseg = SSG_UNUSED;
X	estkm1p = &estk[0];
X
X	pepolptr = &evalr[sub].exprstr[0];
X	pepolcnt = PPEXPRLEN;
X
X	if(pepolcon(exn))
X	{
X		evalr[sub].seg = etopseg;
X		evalr[sub].value = etop;
X		polout('\0');
X	}
X	else
X	{
X		evalr[sub].exprstr[0] = '\0';
X		evalr[sub].seg = SSG_UNDEF;
X	}
X}
X
Xpolout(ch)
X	char ch;
X/*
X	description	output a character to a evar[?].exprstr array
X	globals		parser expression to polish pointer pepolptr
X*/
X{
X	if(pepolcnt > 1)
X	{
X		*pepolptr++ = ch;
X		pepolcnt --;
X	}
X	else
X	{
X		*pepolptr = '\0';
X		fraerror("overflow in polish expression conversion");
X	}
X}
X
Xpolnumout(inv)
X	unsigned long inv;
X/*
X	description	output a long constant to a polish expression
X*/
X{
X	if( inv > 15)
X		polnumout(inv >> 4);
X	polout(hexch((int) inv ));
X}
X
Xpepolcon(esub)
X	int esub;
X/*
X	description	convert an expression tree to polish notation
X			and do a preliminary evaluation of the numeric value
X			of the expression
X	parameters	the subscript of an expression node
X	globals		the expression stack
X			the polish expression string in an evalr element
X	return		False if the expression stack overflowed
X
X			The expression stack top contains the
X			value and segment for the result of the expression
X			which are propgated along as numeric operators are
X			evaluated.  Undefined references result in an
X			undefined result.
X*/
X{
X	switch(enode[esub].evs)
X	{
X	case  PCCASE_UN:
X		{
X			if( ! pepolcon(enode[esub].left))
X				return FALSE;
X
X			polout(enode[esub].op);
X
X			switch(enode[esub].op)
X			{
X#include "fraeuni.h"
X			}
X		}
X		break;
X
X	case  PCCASE_BIN:
X		{
X			if( ! pepolcon(enode[esub].left))
X				return FALSE;
X
X			polout(IFC_LOAD);
X
X			if(estkm1p >= &estk[PESTKDEPTH-1-STACKALLOWANCE])
X			{
X				fraerror("expression stack overflow");
X				return FALSE;
X			}
X
X			(++estkm1p)->v = etop;
X			estkm1p -> s = etopseg;
X			etopseg = SSG_UNUSED;	
X			etop = 0;
X
X			if( ! pepolcon(enode[esub].right))
X				return FALSE;
X
X			polout(enode[esub].op);
X
X			if(estkm1p -> s != SSG_ABS)
X				etopseg = estkm1p -> s;
X
X			switch(enode[esub].op)
X			{
X#include "fraebin.h"
X			}
X		}
X		break;
X
X	case  PCCASE_DEF:
X		if(enode[esub].sym -> seg > 0)
X		{
X			polnumout(1L);
X			etop = 1;
X			etopseg = SSG_ABS;
X		}
X		else
X		{
X			polnumout(0L);
X			etop = 0;
X			etopseg = SSG_ABS;
X		}
X		break;
X
X	case  PCCASE_SYMB:
X		etop = (enode[esub].sym) -> value;
X		etopseg = (enode[esub].sym) -> seg;
X		if(etopseg == SSG_EQU ||
X		   etopseg == SSG_SET ) 
X		{
X			etopseg = SSG_ABS;
X			polnumout((unsigned long)(enode[esub].sym) -> value);
X		}
X		else
X		{
X			polnumout((unsigned long)(enode[esub].sym) -> symnum);
X			polout(IFC_SYMB);
X		}
X		break;
X			
X	case  PCCASE_PROGC:
X		polout(IFC_PROGCTR);
X		etop = locctr;
X		etopseg = SSG_ABS;
X		break;
X			
X	case  PCCASE_CONS:
X		polnumout((unsigned long)enode[esub].val);
X		etop = enode[esub].val;
X		etopseg = SSG_ABS;
X		break;
X
X	}
X	return TRUE;
X}
SHAR_EOF
true || echo 'restore of frapsub.c failed'
fi
# ============= frasmain.c ==============
if test -f 'frasmain.c' -a X"$1" != X"-c"; then
	echo 'x - skipping frasmain.c (File already exists)'
else
echo 'x - extracting frasmain.c (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'frasmain.c' &&
X/*
XHEADER: 	;
XTITLE: 		Frankenstein Cross Assemblers;
XVERSION: 	2.0;
XDESCRIPTION: "	Reconfigurable Cross-assembler producing Intel (TM)
X		Hex format object records.  ";
XKEYWORDS: 	cross-assemblers, 1805, 2650, 6301, 6502, 6805, 6809, 
X		6811, tms7000, 8048, 8051, 8096, z8, z80;
XSYSTEM: 	UNIX, MS-Dos ;
XFILENAME: 	frasmain.c;
XWARNINGS: 	"This software is in the public domain.  
X		Any prior copyright claims are relinquished.  
X
X		This software is distributed with no warranty whatever.  
X		The author takes no responsibility for the consequences 
X		of its use.
X
X		Yacc (or Bison) required to compile."  ;
XSEE-ALSO: 	base.doc, as*.doc (machine specific appendices) , 
X		as*.1 (man pages);
XAUTHORS: 	Mark Zenier;
XCOMPILERS: 	Microport Sys V/AT, ATT Yacc, Turbo C V1.5, Bison (CUG disk 285)
X		(previous versions Xenix, Unisoft 68000 Version 7, Sun 3);
X*/
X/*
X	description	Main file
X	usage		Unix, framework crossassembler
X	history		September 25, 1987
X			August 3, 1988    v 1.4
X			September 14, 1990  v 1.5  Dosified
X*/
X
X#define	Global
X
X#include <stdio.h>
X#include "frasmdat.h"
X
XFILE * intermedf = (FILE *) NULL;
Xchar *interfn = 
X#ifdef DOSTMP
X "frtXXXXXX";
X#else
X "/usr/tmp/frtXXXXXX";
X#endif
Xchar *hexfn, *loutfn;
Xint errorcnt = 0, warncnt = 0;
Xint listflag = FALSE, hexflag = FALSE, hexvalid = FALSE;
Xstatic int debugmode = FALSE;
Xstatic FILE *symbf;
Xstatic char *symbfn;
Xstatic int  symbflag = FALSE;
Xchar hexcva[17] = "0123456789abcdef";
X
X#ifdef NOGETOPT
X#include "getopt.h"
X#endif
Xmain(argc, argv)
X	int argc;
X	char *(argv[]);
X/*
X	description	top driver routine for framework cross assembler
X				set the cpu type if implemented in parser
X				process the command line parameters
X				setup the tables
X				call the first pass parser
X				print the symbol table
X				call the second pass
X				close down and delete the outputs if any errors
X	return		exit(2) for error, exit(0) for OK
X*/
X{
X	extern char *optarg;
X	extern int optind;
X	int grv;
X
X	grv = cpumatch(argv[0]);
X
X	while( (grv = getopt(argc, argv, "dh:o:l:s:p:")) != EOF)
X	{
X		switch(grv)
X		{
X		case 'o':
X		case 'h':
X			hexfn = optarg;
X			hexflag = hexvalid = TRUE;
X			break;
X		
X		case 'l':
X			loutfn = optarg;
X			listflag = TRUE;
X			break;
X
X		case 'd':
X			debugmode = TRUE;
X			break;
X
X		case 's':
X			symbflag = TRUE;
X			symbfn = optarg;
X			break;
X
X		case 'p':
X			if( ! cpumatch(optarg) )
X			{
X				fprintf(stderr, 
X		"%s: no match on CPU type %s, default used\n", 
X					argv[0], optarg);
X			}
X			break;
X
X		case '?':
X			break;
X		}
X	}
X
X	if(optind < argc)
X	{
X		if(strcmp(argv[optind], "-") == 0)
X		{
X			yyin = stdin;
X		}
X		else
X		{
X			if( (yyin = fopen(argv[optind], "r")) == (FILE *)NULL)
X			{
X				fprintf(stderr, 
X					"%s: cannot open input file %s\n",
X					argv[0], argv[optind]);
X				exit(1);
X			}
X		}
X	}
X	else
X	{
X		fprintf(stderr, "%s: no input file\n", argv[0]);
X		exit(1);
X	}
X
X	if(listflag)
X	{
X		if(strcmp(argv[optind], loutfn) == 0) 
X		{
X			fprintf(stderr, "%s: list file overwrites input %s\n",
X				argv[0], loutfn);
X			listflag = FALSE;
X		}
X		else if( (loutf = fopen(loutfn, "w")) == (FILE *) NULL)
X		{
X			fprintf(stderr, "%s: cannot open list file %s\n",
X				argv[0], loutfn);
X			listflag = FALSE;
X		}
X	}
X
X	if( ! listflag)
X	{
X		loutf = stdout;
X	}
X
X	mktemp(interfn);
X	if( (intermedf = fopen(interfn, "w")) == (FILE *) NULL)
X	{
X		fprintf(stderr, "%s: cannot open temp file %s\n",
X			argv[0], interfn);
X		exit(1);
X	}
X
X	setophash();
X	setreserved();
X	elseifstk[0] = endifstk[0] = If_Err;
X	fprintf(intermedf, "F:%s\n", argv[optind]);
X	infilestk[0].fpt = yyin;
X	infilestk[0].fnm = argv[optind];
X	currfstk = 0;
X	currseg = 0;
X	
X	yyparse();
X	
X	if(ifstkpt != 0)
X		fraerror("active IF at end of file");
X
X	buildsymbolindex();
X	if(listflag)
X		printsymbols();
X
X	if(symbflag)
X	{
X		if(strcmp(argv[optind], symbfn) == 0) 
X		{
X			fprintf(stderr, "%s: symbol file overwrites input %s\n",
X				argv[0], symbfn);
X		}
X		else if( (symbf = fopen(symbfn, "w")) == (FILE *) NULL)
X		{
X			fprintf(stderr, "%s: cannot open symbol file %s\n",
X				argv[0], symbfn);
X		}
X		else
X		{
X			filesymbols();
X			fclose(symbf);
X		}
X	}
X
X	
X	fclose(intermedf);
X	if( (intermedf = fopen(interfn, "r")) == (FILE *) NULL)
X	{
X		fprintf(stderr, "%s: cannot open temp file %s\n",
X			argv[0], interfn);
X		exit(1);
X	}
X
X	if(errorcnt > 0)
X		hexflag = FALSE;
X
X	if(hexflag)
X	{
X		if(strcmp(argv[optind], hexfn) == 0) 
X		{
X			fprintf(stderr, "%s: hex output overwrites input %s\n",
X				argv[0], hexfn);
X			hexflag = FALSE;
X		}
X		else if( (hexoutf = fopen(hexfn, "w")) == (FILE *) NULL)
X		{
X			fprintf(stderr, "%s: cannot open hex output %s\n",
X				argv[0], hexfn);
X			hexflag = FALSE;
X		}
X	}
X
X	currfstk = 0;
X	outphase();
X
X	if(errorcnt > 0)
X		hexvalid = FALSE;
X
X	fprintf(loutf, " ERROR SUMMARY - ERRORS DETECTED %d\n", errorcnt);
X	fprintf(loutf, "               -  WARNINGS       %d\n", warncnt);
X
X	if(listflag)
X	{
X		fprintf(stderr, " ERROR SUMMARY - ERRORS DETECTED %d\n", 
X			errorcnt);
X		fprintf(stderr, "               -  WARNINGS       %d\n", 
X			warncnt);
X	}
X
X	if(listflag)
X		fclose(loutf);
X	
X	if(hexflag)
X	{
X		fclose(hexoutf);
X		if( ! hexvalid)
X			unlink(hexfn);
X	}
X	
X	fclose(intermedf);
X	if( ! debugmode)
X		unlink(interfn);
X	else
X		abort();
X	
X	exit(errorcnt > 0 ? 2 : 0);
X}
X		
X
Xfrafatal(str)
X	char * str;
X/*
X	description	Fatal error subroutine, shutdown and quit right now!
X	parameters	message
X	globals		if debug mode is true, save intermediate file
X	return		exit(2)
X*/
X{
X	fprintf(stderr, "Fatal error - %s\n",str);
X
X	if( intermedf != (FILE *) NULL)
X	{
X		fclose(intermedf);
X		if( ! debugmode)
X			unlink(interfn);
X	}
X		
X	exit(2);
X}
X
Xfrawarn(str)
X	char * str;
X/*
X	description	first pass - generate warning message by writing line
X			to intermediate file
X	parameters	message
X	globals		the count of warnings
X*/
X{
X	fprintf(intermedf, "E: WARNING - %s\n",str);
X	warncnt++;
X}
X
Xfraerror(str)
X	char * str;
X/*
X	description	first pass - generate error message by writing line to
X			intermediate file
X	parameters	message
X	globals		count of errors
X*/
X{
X	fprintf(intermedf, "E: ERROR - %s\n",str);
X	errorcnt++;
X}
X
Xfracherror(str, start, beyond)
X	char * str, *start, *beyond;
X/*
X	description	first pass - generate error message by writing line to
X			intermediate file
X	parameters	message
X			pointer to bad character definition
X			pointer after bad definition
X	globals		count of errors
X*/
X{
X	char bcbuff[8];
X	int cnt;
X
X	for(cnt=0; start < beyond && *start != '\0' && cnt < 7; cnt++)
X	{
X		bcbuff[cnt] = *start++;
X	}
X	bcbuff[cnt] = '\0';
X
X	fprintf(intermedf, "E: ERROR - %s \'%s\'\n",str, bcbuff);
X	errorcnt++;
X}
X
X
Xprtequvalue(fstr, lv)
X	char * fstr;
X	long lv;
X/*
X	description	first pass - generate comment lines in intermediate file
X			for the value in a set, equate, or org statement, etc...
X	parameters	format string and a long integer value
X*/
X{
X	fprintf(intermedf, fstr, lv);
X}
X
X#define SYMPERLINE 3
X
Xprintsymbols()
X/*
X	description	print the symbols on the listing file, 3 symbols
X			across.  Only the first 15 characters are printed
X			though all are significant.  Reserved symbols are
X			not assigned symbol numbers and thus are not printed.
X	globals		the symbol index array and the symbol table elements.
X*/
X{
X	int syn, npl = 0;
X	struct symel *syp;
X
X	for(syn = 1; syn <nextsymnum; syn++)
X	{
X		if(npl >= SYMPERLINE)
X		{
X			fputc('\n', loutf);
X			npl = 0;
X		}
X
X		syp = symbindex[syn];
X
X		if(syp -> seg != SSG_UNDEF)
X			fprintf(loutf, "%8.8lx %-15.15s  ",syp -> value,
X				syp -> symstr);
X		else
X			fprintf(loutf, "???????? %-15.15s  ", syp -> symstr);
X		npl++;
X	}
X
X	if(npl > 0)
X		fputc('\n', loutf);
X
X	fputc('\f', loutf);
X}
X
X
Xfilesymbols()
X/*
X	description	print the symbols to the symbol table file
X	globals		the symbol index array and the symbol table elements.
X*/
X{
X	int syn;
X	struct symel *syp;
X
X	for(syn = 1; syn <nextsymnum; syn++)
X	{
X		syp = symbindex[syn];
X
X		if(syp -> seg != SSG_UNDEF)
X			fprintf(symbf, "%8.8lx %s\n",syp -> value,
X				syp -> symstr);
X		else
X			fprintf(symbf, "???????? %s\n", syp -> symstr);
X	}
X}
SHAR_EOF
true || echo 'restore of frasmain.c failed'
fi
# ============= frasmdat.h ==============
if test -f 'frasmdat.h' -a X"$1" != X"-c"; then
	echo 'x - skipping frasmdat.h (File already exists)'
else
echo 'x - extracting frasmdat.h (Text)'
sed 's/^X//' << 'SHAR_EOF' > 'frasmdat.h' &&
X
X/*
XHEADER: 	;
XTITLE: 		Frankenstein Cross Assemblers;
XVERSION: 	2.0;
XDESCRIPTION: "	Reconfigurable Cross-assembler producing Intel (TM)
X		Hex format object records.  ";
XFILENAME: 	frasmdat.h;
XSEE-ALSO: 	;
XAUTHORS: 	Mark Zenier;
X*/
X
X/*
X	description	structures and data used in parser and output phases
X	history		September 15, 1987
X			August 3, 1988   Global
X			September 14, 1990   6 char portable var
X*/
X
X#include <ctype.h>
X#define PRINTCTRL(char) ((char)+'@')
X
X#ifndef Global
X#define	Global	extern
X#endif
X
X#ifdef USEINDEX
X#define strchr index
X#endif
X
X#ifdef NOSTRING
Xextern char * strncpy();
Xextern char * strchr();
Xextern int strcmp();
Xextern int strlen();
X#else
X#include <string.h>
X#endif
X
X#define local 
X
X#define TRUE 1
X#define FALSE 0
X
X#define hexch(cv) (hexcva[(cv)&0xf])
Xextern char hexcva[];
X
X/* symbol table element */
Xstruct symel
X{
X	char	*symstr;
X	int	tok;
X	int	seg;
X	long	value;
X	struct	symel *nextsym;
X	int	symnum;
X};
X
X#define SSG_UNUSED 0
X#define SSG_UNDEF -1
X#define SSG_ABS 8
X#define SSG_RESV -2
X#define SSG_EQU 2
X#define SSG_SET 3
X
X#define SYMNULL (struct symel *) NULL
Xstruct symel * symbentry();
X
X/* opcode symbol table element */
X
Xstruct opsym
X{
X	char	*opstr;
X	int	token;
X	int	numsyn;
X	int	subsyn;
X};
X
Xstruct opsynt
X{
X	int	syntaxgrp;
X	int	elcnt;
X	int	gentabsub;
X};
X
Xstruct igel 
X{
X	int	selmask;
X	int	criteria;
X	char	* genstr;
X};
X	
X#define PPEXPRLEN 256
X
Xstruct evalrel
X{
X	int	seg;
X	long	value;
X	char	exprstr[PPEXPRLEN];
X};
X
X#define INBUFFSZ 258
Xextern char finbuff[INBUFFSZ];
X
Xextern int nextsymnum;
XGlobal struct symel **symbindex;
X
X#define EXPRLSIZE (INBUFFSZ/2)
Xextern int nextexprs;
XGlobal int	exprlist[EXPRLSIZE];
X
X#define STRLSIZE (INBUFFSZ/2)
Xextern int nextstrs;
XGlobal char *	stringlist[STRLSIZE];
X
Xextern struct opsym optab[];
Xextern int gnumopcode;
Xextern struct opsynt ostab[];
Xextern struct igel igtab[];
Xextern int ophashlnk[];
X
X#define NUMPEXP 6
XGlobal struct evalrel evalr[NUMPEXP];
X
X#define PESTKDEPTH 32
Xstruct evstkel
X{
X	long v;
X	int s;
X};
X
XGlobal struct evstkel	estk[PESTKDEPTH], *estkm1p;
X
XGlobal int	currseg; 
XGlobal long 	locctr; 
X
Xextern FILE *yyin;
Xextern FILE	*intermedf;
Xextern int	listflag;
Xextern int hexvalid, hexflag;
XGlobal FILE	*hexoutf, *loutf;
Xextern int errorcnt, warncnt;
X
Xextern int linenumber;
X
X#define IFSTKDEPTH 32
Xextern int	ifstkpt; 
XGlobal enum { If_Active, If_Skip, If_Err } 
X	elseifstk[IFSTKDEPTH], endifstk[IFSTKDEPTH];
X
X#define FILESTKDPTH 20
XGlobal int currfstk;
X#define nextfstk (currfstk+1)
XGlobal struct fstkel
X{
X	char *fnm;
X	FILE *fpt;
X} infilestk[FILESTKDPTH];
X
XGlobal int lnumstk[FILESTKDPTH];
XGlobal char currentfnm[100];
X
Xextern struct symel * endsymbol;
X
Xenum readacts
X{
X	Nra_normal, 
X	Nra_new, 
X	Nra_end 
X} ;
X
Xextern enum readacts nextreadact;
X
Xchar * savestring(), *findgen();
Xlong	strtol();
Xvoid	reservedsym();
Xchar	*calloc(), *malloc();
X
Xextern struct symel * endsymbol;
Xextern char ignosyn[] ;
Xextern char ignosel[] ;
X
X#define NUM_CHTA 6
Xextern int chtnxalph, *chtcpoint, *chtnpoint ;
XGlobal int *(chtatab[NUM_CHTA]);
Xint chtcreate(), chtcfind(), chtran();
X
X#define CF_END		-2
X#define CF_INVALID 	-1
X#define CF_UNDEF 	0
X#define CF_CHAR 	1
X#define CF_NUMBER 	2
X
SHAR_EOF
true || echo 'restore of frasmdat.h failed'
fi
true || echo 'restore of fryylex.c failed'
echo End of part 2, continue with part 3
exit 0


Brought to you by Super Global Mega Corp .com