#!/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
