Source Code 1992 March/Source_Code_CD-ROM_Walnut_Creek_March_1992.iso/usenet/altsrcs/2/2183

Internet Message Format | 1990-12-28 | 49.2 KB

From: [e-mail] (Mark Zenier)
Newsgroups: alt.sources
Subject: Frankenstein Cross Assemblers, Base source, Part 2 of 3
Message-ID: <[e-mail]>
Date: 4 Dec 90 07:48:06 GMT

---- 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