Frankenstein Cross Assemblers, Base source, Part 2 of 3
Mark Zenier
markz at ssc.UUCP
Tue Dec 4 18:48:06 AEST 1990
---- 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
More information about the Alt.sources
mailing list