Usenet 1994 October/usenetsourcesnewsgroupsinfomagicoctober1994disk2.iso/misc/volume5/z80ad/part03

Internet Message Format | 1989-02-03 | 24.3 KB

Path: xanth!nic.MR.NET!hal!ncoast!allbery
From: [e-mail] (Keptin Comrade Dr. Bob)
Newsgroups: comp.sources.misc
Subject: v05i088: Z80 Assembler/Disassembler part 3 of 3
Message-ID: <[e-mail]>
Date: 19 Dec 88 01:11:22 GMT
Sender: [e-mail]
Reply-To: [e-mail] (Keptin Comrade Dr. Bob)
Organization: Reality Central
Lines: 1311
Approved: [e-mail]

Posting-number: Volume 5, Issue 88
Submitted-by: "Keptin Comrade Dr. Bob" <[e-mail]>
Archive-name: z80ad/part03

#!/bin/sh
# this is part 3 of an archive
# do not concatenate these parts, unpack them in order with /bin/sh
# file zmac/zmac.y continued
#
CurArch=3
if test ! -r ._seq_
then echo "Please unpack part 1 first!"
     exit 1; fi
( read Scheck
  if test "$Scheck" != $CurArch
  then echo "Please unpack part $Scheck next!"
       exit 1;
  else exit 0; fi
) < ._seq_ || exit 1
sed 's/^X//' << 'SHAR_EOF' >> zmac/zmac.y
X    '8',    '9',    0,    0,    0,    0,    0,    0,
X    0,    'A',    'B',    'C',    'D',    'E',    'F',    0,
X    'H',    0,    0,    0,    0,    0,    0,    'O',
X    0,    'Q',    0,    0,    0,    0,    0,    0,
X    0,    0,    0,    0,    0,    0,    0,    0,
X    0,    'a',    'b',    'c',    'd',    'e',    'f',    0,
X    'h',    0,    0,    0,    0,    0,    0,    'o',
X    0,    'q',    0,    0,    0,    0,    0,    0,
X    0,    0,    0,    0,    0,    0,    0,    0,
X    0};
X
X
X
X
X/*
X *  the following table is a list of assembler mnemonics;
X *  for each mnemonic the associated machine-code bit pattern
X *  and symbol type are given.
X */
Xstruct    item    keytab[] = {
X    "a",    7,    ACC,    0,
X    "adc",    1,    ARITHC,    0,
X    "add",    0,    ADD,    0,
X    "af",    060,    AF,    0,
X    "and",    4,    LOGICAL,    0,
X    "ascii",0,    DEFB,    0,
X    "b",    0,    REGNAME,    0,
X    "bc",    0,    RP,    0,
X    "bit",    0145500,BIT,    0,
X    "block",0,    DEFS,    0,
X    "byte",    0,    DEFB,    0,
X    "c",    1,    C,    0,
X    "call", 0315,    CALL,    0,
X    "ccf",    077,    NOOPERAND,    0,
X    "cmp",    7,    LOGICAL,    0,        /* -cdk */
X    "cp",    7,    LOGICAL,    0,
X    "cpd",    0166651,NOOPERAND,    0,
X    "cpdr",    0166671,NOOPERAND,    0,
X    "cpi",    0166641,NOOPERAND,    0,
X    "cpir",    0166661,NOOPERAND,    0,
X    "cpl",    057,    NOOPERAND,    0,
X    "d",    2,    REGNAME,    0,
X    "daa",    0047,    NOOPERAND,    0,
X    "de",    020,    RP,    0,
X    "dec",    1,    INCDEC,    0,
X    "defb",    0,    DEFB,    0,
X    "defl",0,    DEFL,    0,
X    "defs",    0,    DEFS,    0,
X    "defw",    0,    DEFW,    0,
X    "dephase",    0,    DEPHASE,    0,
X    "di",    0363,    NOOPERAND,    0,
X    "djnz",    020,    DJNZ,    0,
X    "e",    3,    REGNAME,    0,
X    "ei",    0373,    NOOPERAND,    0,
X    "eject",1,    LIST,    0,
X    "elist",3,    LIST,    0,
X    "end",    0,    END,    0,
X    "endif",0,    ENDIF,    0,
X    "endm", 0,    ENDM,    0,
X    "equ",    0,    EQU,    0,
X    "ex",    0,    EX,    0,
X    "exx",    0331,    NOOPERAND,    0,
X    "f",    0,    F,    0,
X    "flist",4,    LIST,    0,
X    "glist",5,    LIST,    0,
X    "h",    4,    REGNAME,    0,
X    "halt",    0166,    NOOPERAND,    0,
X    "hl",    040,    HL,    0,
X    "i",    0,    MISCREG,    0,
X    "if",    0,    IF,    0,
X    "im",    0166506,IM,    0,
X    "in",    0333,    IN,    0,
X    "inc",    0,    INCDEC,    0,
X    "include", 3,    ARGPSEUDO,    0,
X    "ind",    0166652,NOOPERAND,    0,
X    "indr",    0166672,NOOPERAND,    0,
X    "ini",    0166642,NOOPERAND,    0,
X    "inir",    0166662,NOOPERAND,    0,
X    "ix",    0156440,INDEX,    0,
X    "iy",    0176440,INDEX,    0,
X    "jmp",    0303,    JP,    0,        /* -cdk */
X    "jp",    0303,    JP,    0,
X    "jr",    040,    JR,    0,
X    "l",    5,    REGNAME,    0,
X    "ld",    0,    LD,    0,
X    "ldd",    0166650,NOOPERAND,    0,
X    "lddr",    0166670,NOOPERAND,    0,
X    "ldi",    0166640,NOOPERAND,    0,
X    "ldir",    0166660,NOOPERAND,    0,
X    "list",    0,    LIST,    0,
X    "m",    070,    COND,    0,
X    "macro",0,    MACRO,    0,
X    "max",    1,    MINMAX,    0,
X    "min",    0,    MINMAX,    0,
X    "mlist",6,    LIST,    0,
X    "mod",    0,    MOD,    0,
X    "nc",    020,    SPCOND,    0,
X    "neg",    0166504,NOOPERAND,    0,
X    "nolist",-1,    LIST,    0,
X    "nop",    0,    NOOPERAND,    0,
X    "not",    0,    NOT,    0,
X    "nv",    040,    COND,    0,
X    "nz",    0,    SPCOND,    0,
X    "or",    6,    LOGICAL,    0,
X    "org",    0,    ORG,    0,
X    "otdr",0166673,NOOPERAND,    0,
X    "otir",0166663,NOOPERAND,    0,
X    "out",    0323,    OUT,    0,
X    "outd",    0166653,NOOPERAND,    0,
X    "outi",    0166643,NOOPERAND,    0,
X    "p",    060,    COND,    0,
X    "pe",    050,    COND,    0,
X    "phase",    0,    PHASE,    0,
X    "po",    040,    COND,    0,
X    "pop",    0301,    PUSHPOP,    0,
X    "push", 0305,    PUSHPOP,    0,
X    "r",    010,    MISCREG,    0,
X    "res",    0145600,BIT,    0,
X    "ret",    0311,    RET,    0,
X    "reti",    0166515,NOOPERAND,    0,
X    "retn",    0166505,NOOPERAND,    0,
X    "rl",    2,    SHIFT,    0,
X    "rla",    027,    NOOPERAND,    0,
X    "rlc",    0,    SHIFT,    0,
X    "rlca",    07,    NOOPERAND,    0,
X    "rld",    0166557,NOOPERAND,    0,
X    "rr",    3,    SHIFT,    0,
X    "rra",    037,    NOOPERAND,    0,
X    "rrc",    1,    SHIFT,    0,
X    "rrca",    017,    NOOPERAND,    0,
X    "rrd",    0166547,NOOPERAND,    0,
X    "rst",    0307,    RST,    0,
X    "rsym",    1,    ARGPSEUDO,    0,
X    "sbc",    3,    ARITHC,    0,
X    "scf",    067,    NOOPERAND,    0,
X    "set",    0145700,BIT,    0,
X    "shl",    0,    SHL,    0,
X    "shr",    0,    SHR,    0,
X    "sla",    4,    SHIFT,    0,
X    "sp",    060,    SP,    0,
X    "space",2,    LIST,    0,
X    "sra",    5,    SHIFT,    0,
X    "srl",    7,    SHIFT,    0,
X    "sub",    2,    LOGICAL,    0,
X    "title",0,    ARGPSEUDO,    0,
X    "v",    050,    COND,    0,
X    "word",    0,    DEFW,    0,
X    "wsym",    2,    ARGPSEUDO,    0,
X    "xor",    5,    LOGICAL,    0,
X    "z",    010,    SPCOND,    0,
X};
X
X/*
X *  user-defined items are tabulated in the following table.
X */
X
Xstruct item    itemtab[ITEMTABLESIZE];
Xstruct item    *itemmax = &itemtab[ITEMTABLESIZE];
X
X
X
X
X
X/*
X *  lexical analyser, called by yyparse.
X */
Xyylex()
X{
X    register char    c;
X    register char *p;
X    register int    radix;
X    int  limit;
X
X    if (arg_flag)
X        return(getarg());
Xloop switch(charclass[c = nextchar()]) {
X    case F_END:
X        if (expptr) {
X            popsi();
X            continue;
X        } else return(0);
X
X    case SPACE:
X        break;
X    case LETTER:
X    case STARTER:
X        p = tempbuf;
X        do {
X            if (p >= tempmax)
X                error(symlong);
X            *p++ = (c >= 'A' && c <= 'Z') ? c + 'a' - 'A' : c;
X            while    ((c = nextchar()) == '$')
X                ;
X        } while    (charclass[c]==LETTER || charclass[c]==DIGIT);
X        if (p - tempbuf > MAXSYMBOLSIZE)
X            p = tempbuf + MAXSYMBOLSIZE;
X        *p++ = '\0';
X        peekc = c;
X        return(tokenofitem(UNDECLARED));
X    case DIGIT:
X        if (*ifptr) return(skipline(c));
X        p = tempbuf;
X        do    {
X            if (p >= tempmax)
X                error(symlong);
X            *p++ = (c >= 'A' && c <= 'Z') ? c + 'a' - 'A' : c;
X            while    ((c = nextchar()) == '$');
X            }
X            while(numpart[c]);
X        peekc = c;
X        *p-- = '\0';
X        switch(*p)    {
X            case 'o':
X            case 'q':
X                radix = 8;
X                limit = 020000;
X                *p = '\0';
X                break;
X            case 'd':
X                radix = 10;
X                limit = 3276;
X                *p = '\0';
X                break;
X            case 'h':
X                radix = 16;
X                limit = 010000;
X                *p = '\0';
X                break;
X            case 'b':
X                radix = 2;
X                limit = 077777;
X                *p = '\0';
X                break;
X            default:
X                radix = 10;
X                limit = 3276;
X                p++;
X                break;
X            }
X
X        /*
X         *  tempbuf now points to the number, null terminated
X         *  with radix 'radix'.
X         */
X        yylval.ival = 0;
X        p = tempbuf;
X        do    {
X            c = *p - (*p > '9' ? ('a' - 10) : '0');
X            if (c >= radix)
X                {
X                err[iflag]++;
X                yylval.ival = 0;
X                break;
X                }
X            if (yylval.ival < limit ||
X                (radix == 10 && yylval.ival == 3276 && c < 8) ||
X                (radix == 2 && yylval.ival == limit))
X                yylval.ival = yylval.ival * radix + c;
X            else {
X                err[vflag]++;
X                yylval.ival = 0;
X                break;
X                }
X            }
X            while(*++p != '\0');
X        return(NUMBER);
X    default:
X        if (*ifptr)
X            return(skipline(c));
X        switch(c) {
X        case ';':
X            return(skipline(c));
X        case '\'':
X            if (quoteflag) return('\'');
X            p = tempbuf;
X            p[1] = 0;
X            do    switch(c = nextchar())    {
X            case '\0':
X            case '\n':
X                err[bflag]++;
X                goto retstring;
X            case '\'':
X                if ((c = nextchar()) != '\'') {
X                retstring:
X                    peekc = c;
X                    *p = '\0';
X                    if ((p-tempbuf) >2) {
X                        yylval.cval = tempbuf;
X                        return(STRING);
X                    } else if (p-tempbuf == 2)    {
X                        p = tempbuf;
X                        yylval.ival = *p++ ;
X                        yylval.ival |= *p<<8;
X                        return(TWOCHAR);
X                    } else    {
X                        p = tempbuf;
X                        yylval.ival = *p++;
X                        return(ONECHAR);
X                    }
X                }
X            default:
X                *p++ = c;
X            } while (p < tempmax);
X            /*
X             *  if we break out here, our string is longer than
X             *  our input line
X             */
X            error("string buffer overflow");
X        default:
X            return(c);
X        }
X    }
X}
X
X/*
X *  return the token associated with the string pointed to by
X *  tempbuf.  if no token is associated with the string, associate
X *  deftoken with the string and return deftoken.
X *  in either case, cause yylval to point to the relevant
X *  symbol table entry.
X */
X
Xtokenofitem(deftoken)
Xint    deftoken;
X{
X    register  char *p;
X    register struct item *    ip;
X    register  i;
X    int  r, l, u, hash;
X
X
X#ifdef T_DEBUG
X    fputs("'tokenofitem entry'    ", stderr) ;
X    fputs(tempbuf, stderr) ;
X#endif
X    /*
X     *  binary search
X     */
X    l = 0;
X    u = (sizeof keytab/sizeof keytab[0])-1;
X    while (l <= u) {
X        i = (l+u)/2;
X        ip = &keytab[i];
X        if ((r = strcmp(tempbuf, ip->i_string)) == 0)
X            goto found;
X        if (r < 0)
X            u = i-1;
X        else
X            l = i+1;
X    }
X
X    /*
X     *  hash into item table
X     */
X    hash = 0;
X    p = tempbuf;
X    while (*p) hash += *p++;
X    hash %= ITEMTABLESIZE;
X    ip = &itemtab[hash];
X
X    loop {
X        if (ip->i_token == 0)
X            break;
X        if (strcmp(tempbuf, ip->i_string) == 0)
X            goto found;
X        if (++ip >= itemmax)
X            ip = itemtab;
X    }
X
X    if (!deftoken) {
X        i = 0 ;
X        goto token_done ;
X    }
X    if (++nitems > ITEMTABLESIZE-20)
X        error("item table overflow");
X    ip->i_string = malloc(strlen(tempbuf)+1);
X    ip->i_token = deftoken;
X    ip->i_uses = 0 ;
X    strcpy(ip->i_string, tempbuf);
X
Xfound:
X    if (*ifptr) {
X        if (ip->i_token == ENDIF) {
X            i = ENDIF ;
X            goto token_done ;
X        }
X        if (ip->i_token == IF) {
X            if (ifptr >= ifstmax)
X                error("Too many ifs");
X            else *++ifptr = 1;
X        }
X        i = skipline(' ');
X        goto token_done ;
X    }
X    yylval.itemptr = ip;
X    i = ip->i_token;
Xtoken_done:
X#ifdef T_DEBUG
X    fputs("\t'tokenofitem exit'\n", stderr) ;
X#endif
X    return(i) ;
X}
X
X
X/*
X *  interchange two entries in the item table -- used by qsort
X */
Xinterchange(i, j)
X{
X    register  struct item *fp, *tp;
X    struct item temp;
X
X    fp = &itemtab[i];
X    tp = &itemtab[j];
X    temp.i_string = fp->i_string;
X    temp.i_value = fp->i_value;
X    temp.i_token = fp->i_token;
X    temp.i_uses = fp->i_uses;
X
X    fp->i_string = tp->i_string;
X    fp->i_value = tp->i_value;
X    fp->i_token = tp->i_token;
X    fp->i_uses = tp->i_uses;
X
X    tp->i_string = temp.i_string;
X    tp->i_value = temp.i_value;
X    tp->i_token = temp.i_token;
X    tp->i_uses = temp.i_uses;
X}
X
X
X
X/*
X *  quick sort -- used by putsymtab to sort the symbol table
X */
Xqsort(m, n)
X{
X    register  i, j;
X
X    if (m < n) {
X        i = m;
X        j = n+1;
X        loop {
X            do i++; while(strcmp(itemtab[i].i_string,
X                    itemtab[m].i_string) < 0);
X            do j--; while(strcmp(itemtab[j].i_string,
X                    itemtab[m].i_string) > 0);
X            if (i < j) interchange(i, j); else break;
X        }
X        interchange(m, j);
X        qsort(m, j-1);
X        qsort(j+1, n);
X    }
X}
X
X
X
X/*
X *  get the next character
X */
Xnextchar()
X{
X    register int c, ch;
X    static  char  *earg;
X    char *getlocal();
X
X    if (peekc != -1) {
X        c = peekc;
X        peekc = -1;
X        return(c);
X    }
X
Xstart:
X    if (earg) {
X        if (*earg)
X            return(addtoline(*earg++));
X        earg = 0;
X    }
X
X    if (expptr) {
X        if ((ch = getm()) == '\1') {    /*  expand argument  */
X            ch = getm() - 'A';
X            if (ch >= 0 && ch < PARMMAX && est[ch])
X                earg = est[ch];
X            goto start;
X        }
X        if (ch == '\2') {    /*  local symbol  */
X            ch = getm() - 'A';
X            if (ch >= 0 && ch < PARMMAX && est[ch]) {
X                earg = est[ch];
X                goto start;
X            }
X            earg = getlocal(ch, (int)est[TEMPNUM]);
X            goto start;
X        }
X
X        return(addtoline(ch));
X    }
X    ch = getc(now_file) ;
X    /* if EOF, check for include file */
X    if (ch == EOF) {
X        while (ch == EOF && now_in) {
X            fclose(fin[now_in]) ;
X            free(src_name[now_in]) ;
X            now_file = fin[--now_in] ;
X            ch = getc(now_file) ;
X        }
X        if (linein[now_in] < 0) {
X            lstoff = 1 ;
X            linein[now_in] = -linein[now_in] ;
X        } else {
X            lstoff = 0 ;
X        }
X        if (pass2 && iflist()) {
X            lineout() ;
X            fprintf(fout, "**** %s ****\n", src_name[now_in]) ;
X        }
X    }
X    if (ch == '\n')
X        linein[now_in]++ ;
X
X    return(addtoline(ch)) ;
X}
X
X
X/*
X *  skip to rest of the line -- comments and if skipped lines
X */
Xskipline(ac)
X{
X    register  c;
X
X    c = ac;
X    while (c != '\n' && c != '\0')
X        c = nextchar();
X    return('\n');
X}
X
X
X
Xmain(argc, argv)
Xchar  **argv;
X{
X    register  struct item *ip;
X    register  i;
X    int  files;
X#ifdef DBUG
X    extern  yydebug;
X#endif
X
X    fout = stdout ;
X    fin[0] = stdin ;
X    now_file = stdin ;
X    files = 0;
X
X    for (i=1; i<argc; i++) {
X        if (*argv[i] == '-') while (*++argv[i]) switch(*argv[i]) {
X
X        case 'b':    /*  no binary  */
X            bopt = 0;
X            continue;
X
X#ifdef DBUG
X        case 'd':    /*  debug  */
X            yydebug++;
X            continue;
X#endif
X
X        case 'e':    /*  error list only  */
X            eopt = 0;
X            edef = 0;
X            continue;
X
X        case 'f':    /*  print if skipped lines  */
X            fopt++;
X            fdef++;
X            continue;
X
X        case 'g':    /*  do not list extra code  */
X            gopt = 0;
X            gdef = 0;
X            continue;
X
X        case 'i':    /* do not list include files */
X            iopt = 1 ;
X            continue ;
X
X        case 'l':    /*  no list  */
X            lopt++;
X            continue;
X
X        case 'L':    /*  force listing of everything */
X            lston++;
X            continue;
X
X        case 'm':    /*  print macro expansions  */
X            mdef++;
X            mopt++;
X            continue;
X
X        case 'n':    /*  put line numbers off */
X            nopt-- ;
X            continue;
X
X        case 'o':    /*  list to standard output  */
X            oopt++;
X            continue;
X
X        case 'p':    /*  put out four \n's for eject */
X            popt-- ;
X            continue;
X
X        case 's':    /*  don't produce a symbol list  */
X            sopt++;
X            continue;
X
X        case 't':
X            topt = 0;
X            continue;
X
X        default:    /*  error  */
X            error("Unknown option");
X
X        } else if (files++ == 0) {
X            sourcef = argv[i];
X            strcpy(src, sourcef);
X            suffix(src,".z");
X            if ((now_file = fopen(src, "r")) == NULL)
X                error("Cannot open source file");
X            now_in = 0 ;
X            fin[now_in] = now_file ;
X            src_name[now_in] = src ;
X        } else if (files)
X            error("Too many arguments");
X    }
X
X
X    if (files == 0)
X        error("No source file");
X    strcpy(bin, sourcef);
X    suffix(bin,".hex");
X    if (bopt)
X#ifdef MSDOS
X        if (( fbuf = fopen(bin, "wb")) == NULL)
X#else
X        if (( fbuf = fopen(bin, "w")) == NULL)
X#endif
X            error("Cannot create binary file");
X    if (!lopt && !oopt) {
X        strcpy(listf, sourcef);
X        suffix(listf,".lst");
X        if ((fout = fopen(listf, "w")) == NULL)
X            error("Cannot create list file");
X    } else
X        fout = stdout ;
X    strcpy(mtmp, sourcef);
X    suffix(mtmp,".tmp");
X#ifdef MSDOS
X    mfile = mfopen(mtmp,"w+b") ;
X#else
X    mfile = mfopen(mtmp,"w+") ;
X#endif
X    if (mfile == NULL) {
X        error("Cannot create temp file");
X    }
X    /*unlink(mtmp);*/
X
X    /*
X     *  get the time
X     */
X    time(&now);
X    timp = ctime(&now);
X    timp[16] = 0;
X    timp[24] = 0;
X
X    title = sourcef;
X    /*
X     * pass 1
X     */
X#ifdef DEBUG
X    fputs("DEBUG-pass 1\n", stderr) ;
X#endif
X    setvars();
X    yyparse();
X    pass2++;
X    ip = &itemtab[-1];
X    while (++ip < itemmax) {
X        /* reset use count */
X        ip->i_uses = 0 ;
X
X        /* set macro names, equated and defined names */
X        switch    (ip->i_token) {
X        case MNAME:
X            ip->i_token = OLDMNAME;
X            break;
X
X        case EQUATED:
X            ip->i_token = WASEQUATED;
X            break;
X
X        case DEFLED:
X            ip->i_token = UNDECLARED;
X            break;
X        }
X    }
X    setvars();
X    fseek(now_file, (long)0, 0);
X
X#ifdef DEBUG
X    fputs("DEBUG- pass 2\n", stderr) ;
X#endif
X    yyparse();
X
X
X    if (bopt) {
X        flushbin();
X        putc(':', fbuf);
X        if (xeq_flag) {
X            puthex(0, fbuf);
X            puthex(xeq >> 8, fbuf);
X            puthex(xeq, fbuf);
X            puthex(1, fbuf);
X            puthex(255-(xeq >> 8)-xeq, fbuf);
X        } else
X            for    (i = 0; i < 10; i++)
X                putc('0', fbuf);
X        putc('\n', fbuf);
X        fflush(fbuf);
X    }
X
X    if (!lopt)
X        fflush(fout);
X    if (writesyms)
X        outsymtab(writesyms);
X    if (eopt)
X        erreport();
X    if (!lopt && !sopt)
X        putsymtab();
X    if (!lopt) {
X        eject();
X        fflush(fout);
X    }
X    exit(0);
X}
X
X
X/*
X *  set some data values before each pass
X */
Xsetvars()
X{
X    register  i;
X
X    peekc = -1;
X    linein[now_in] = linecnt = 0;
X    exp_number = 0;
X    emitptr = emitbuf;
X    lineptr = linebuf;
X    ifptr = ifstack;
X    expifp = expif;
X    *ifptr = 0;
X    dollarsign = 0;
X    olddollar = 0;
X    phaseflag = 0;
X    for (i=0; i<FLAGS; i++) err[i] = 0;
X}
X
X
X
X/*
X *  print out an error message and die
X */
Xerror(as)
Xchar *as;
X{
X
X    *linemax = 0;
X    fprintf(fout, "%s\n", linebuf);
X    fflush(fout);
X    fprintf(stderr, "%s\n", as) ;
X    exit(1);
X}
X
X
X
X/*
X *  output the symbol table
X */
Xputsymtab()
X{
X    register  struct item *tp, *fp;
X    int  i, j, k, t, rows;
X    char c, c1 ;
X
X    if (!nitems)
X        return;
X
X    /* compact the table so unused and UNDECLARED entries are removed */
X    tp = &itemtab[-1];
X    for (fp = itemtab; fp<itemmax; fp++) {
X        if (fp->i_token == UNDECLARED) {
X            nitems--;
X            continue;
X        }
X        if (fp->i_token == 0)
X            continue;
X        tp++;
X        if (tp != fp) {
X            tp->i_string = fp->i_string;
X            tp->i_value = fp->i_value;
X            tp->i_token = fp->i_token;
X            tp->i_uses = fp->i_uses ;
X        }
X    }
X
X    tp++;
X    tp->i_string = "{";
X
X    /*  sort the table */
X    qsort(0, nitems-1);
X
X    title = "**  Symbol Table  **";
X
X    rows = (nitems+3) / 4;
X    if (rows+5+line > 60)
X        eject();
X    lineout();
X    fprintf(fout,"\n\n\nSymbol Table:\n\n") ;
X    line += 4;
X
X    for (i=0; i<rows; i++) {
X        for(j=0; j<4; j++) {
X            k = rows*j+i;
X            if (k < nitems) {
X                tp = &itemtab[k];
X                t = tp->i_token;
X                c = ' ' ;
X                if (t == EQUATED || t == DEFLED)
X                    c = '=' ;
X                if (tp->i_uses == 0)
X                    c1 = '+' ;
X                else
X                    c1 = ' ' ;
X                fprintf(fout, "%-15s%c%4x%c    ",
X                    tp->i_string, c, tp->i_value & 0xffff, c1);
X            }
X        }
X        lineout();
X        putc('\n', fout);
X    }
X}
X
X
X
X
X/*
X *  put out error report
X */
Xerreport()
X{
X    register i, numerr;
X
X    if (line > 50) eject();
X    lineout();
X    numerr = 0;
X    for (i=0; i<FLAGS; i++) numerr += keeperr[i];
X    if (numerr) {
X        fputs("\n\n\nError report:\n\n", fout);
X        fprintf(fout, "%6d errors\n", numerr);
X        line += 5;
X    } else {
X        fputs("\n\n\nStatistics:\n", fout);
X        line += 3;
X    }
X
X    for (i=0; i<FLAGS; i++)
X        if (keeperr[i]) {
X            lineout();
X            fprintf(fout, "%6d %c -- %s error\n",
X                keeperr[i], errlet[i], errname[i]);
X        }
X
X    if (line > 55) eject();
X    lineout();
X    fprintf(fout, "\n%6d\tsymbols\n", nitems);
X    fprintf(fout, "%6d\tbytes\n", nbytes);
X    line += 2;
X    if (mfptr) {
X        if (line > 53) eject();
X        lineout();
X        fprintf(fout, "\n%6d\tmacro calls\n", exp_number);
X        fprintf(fout, "%6d\tmacro bytes\n", mfptr);
X        fprintf(fout, "%6d\tinvented symbols\n", invented/2);
X        line += 3;
X    }
X}
X
X
X/*
X *  lexical analyser for macro definition
X */
Xmlex()
X{
X    register  char  *p;
X    register  c;
X    int  t;
X
X    /*
X     *  move text onto macro file, changing formal parameters
X     */
X#ifdef    M_DEBUG
X    fprintf(stderr,"enter 'mlex'\t") ;
X#endif
X    inmlex++;
X
X    c = nextchar();
Xloop {
X    switch(charclass[c]) {
X
X    case DIGIT:
X        while (numpart[c]) {
X            putm(c);
X            c = nextchar();
X        }
X        continue;
X
X    case STARTER:
X    case LETTER:
X        t = 0;
X        p = tempbuf+MAXSYMBOLSIZE+2;
X        do {
X            if (p >= tempmax)
X                error(symlong);
X            *p++ = c;
X            if (t < MAXSYMBOLSIZE)
X                tempbuf[t++] = (c >= 'A' && c <= 'Z')  ?
X                    c+'a'-'A' : c;
X            c = nextchar();
X        } while (charclass[c]==LETTER || charclass[c]==DIGIT);
X
X        tempbuf[t] = 0;
X        *p++ = '\0';
X        p = tempbuf+MAXSYMBOLSIZE+2;
X        t = tokenofitem(0);
X        if (t != MPARM) while (*p) putm(*p++);
X        else {
X            if (*(yylval.itemptr->i_string) == '?') putm('\2');
X            else putm('\1');
X            putm(yylval.itemptr->i_value + 'A');
X        }
X        if (t == ENDM) goto done;
X        continue;
X
X    case F_END:
X        if (expptr) {
X            popsi();
X            c = nextchar();
X            continue;
X        }
X
X        goto done;
X
X    default:
X        if (c == '\n') {
X            linecnt++;
X        }
X        if (c != '\1') putm(c);
X        c = nextchar();
X    }
X}
X
X    /*
X     *  finish off the file entry
X     */
Xdone:
X    while(c != EOF && c != '\n' && c != '\0') c = nextchar();
X    linecnt++;
X    putm('\n');
X    putm('\n');
X    putm(0);
X
X    for (c=0; c<ITEMTABLESIZE; c++)
X        if (itemtab[c].i_token == MPARM) {
X            itemtab[c].i_token = UNDECLARED;
X        }
X    inmlex = 0;
X#ifdef    M_DEBUG
X    fprintf(stderr,"exit 'mlex'\n") ;
X#endif
X}
X
X
X
X/*
X *  lexical analyser for the arguments of a macro call
X */
Xgetarg()
X{
X    register int c;
X    register char *p;
X    static int comma;
X
X    *tempbuf = 0;
X    yylval.cval = tempbuf;
X    while(charclass[c = nextchar()] == SPACE);
X
X    switch(c) {
X
X    case '\0':
X        popsi();
X    case '\n':
X    case ';':
X        comma = 0;
X        return(skipline(c));
X
X    case ',':
X        if (comma) {
X            comma = 0;
X            return(',');
X        }
X        else {
X            comma++;
X            return(ARG);
X        }
X
X    case '\'':
X        p = tempbuf;
X        do switch (c = nextchar()) {
X            case '\0':
X            case '\n':
X                peekc = c;
X                *p = 0;
X                err[bflag]++;
X                return(ARG);
X            case '\'':
X                if ((c = nextchar()) != '\'') {
X                    peekc = c;
X                    *p = '\0';
X                    comma++;
X                    return(ARG);
X                }
X            default:
X                *p++ = c;
X        } while (p < tempmax);
X        error(symlong);
X
X    default:  /* unquoted string */
X        p = tempbuf;
X        peekc = c;
X        do switch(c = nextchar()) {
X            case '\0':
X            case '\n':
X            case '\t':
X            case ' ':
X            case ',':
X                peekc = c;
X                *p = '\0';
X                comma++;
X                return(ARG);
X            default:
X                *p++ = c;
X        } while (p < tempmax);
X    }
X}
X
X
X
X
X
X/*
X *  add a suffix to a string
X */
Xsuffix(str,suff)
Xchar *str,*suff;
X{
X    while(*str != '\0' && *str != '.')
X        *str++;
X    strcpy(str, suff);
X}
X
X
X
X
X/*
X *  put out a byte to the macro file, keeping the offset
X */
Xputm(c)
Xchar c ;
X{
X    mfptr++;
X    mfputc(c,mfile) ;
X}
X
X
X
X/*
X *  get a byte from the macro file
X */
Xgetm()
X{
X    int ch;
X
X    floc++;
X    ch = mfgetc(mfile) ;
X    if (ch == EOF) {
X        ch = 0;
X        fprintf(stderr,"bad macro read\n") ;
X    }
X    return(ch);
X}
X
X
X
X/*
X *  pop standard input
X */
Xpopsi()
X{
X    register  i;
X
X    for (i=0; i<PARMMAX; i++) {
X        if (est[i]) free(est[i]);
X    }
X    floc = est[FLOC];
X    free(est);
X    expptr--;
X    est = expptr ? (char **) expstack[expptr-1] : (char **) 0;
X    mfseek(mfile, (long)floc, 0);
X    if (lineptr > linebuf) lineptr--;
X}
X
X
X
X/*
X *  return a unique name for a local symbol
X *  c is the parameter number, n is the macro number.
X */
X
Xchar *
Xgetlocal(c, n)
Xint c,n;
X{
Xstatic char local_label[10];
X    invented++;
X    if (c >= 26)
X        c += 'a' - '0';
X    sprintf(local_label, "?%c%04d", c+'a', n) ;
X    return(local_label);
X}
X
X
X
X/*
X *  read in a symbol table
X */
Xinsymtab(name)
Xchar *name;
X{
X    register struct stab *t;
X    int  s, i, sfile;
X
X    t = (struct stab *) tempbuf;
X#ifdef MSDOS
X    if ((sfile = open(name, O_RDONLY | O_BINARY)) < 0)
X#else
X    if ((sfile = open(name, O_RDONLY)) < 0)
X#endif
X        return;
X    read(sfile, (char *)t, sizeof *t);
X    if (t->t_value != SYMMAJIC)
X        return;
X
X    s = t->t_token;
X    for (i=0; i<s; i++) {
X        read(sfile, (char *)t, sizeof *t);
X        if (tokenofitem(UNDECLARED) != UNDECLARED)
X            continue;
X        yylval.itemptr->i_token = t->t_token;
X        yylval.itemptr->i_value = t->t_value;
X        if (t->t_token == MACRO)
X            yylval.itemptr->i_value += mfptr;
X    }
X
X    while ((s = read(sfile, tempbuf, TEMPBUFSIZE)) > 0) {
X        mfptr += s;
X        mfwrite(tempbuf, 1, s, mfile) ;
X    }
X}
X
X
X
X/*
X *  write out symbol table
X */
Xoutsymtab(name)
Xchar *name;
X{
X    register struct stab *t;
X    register struct item *ip;
X    int  i, sfile;
X
X    t = (struct stab *) tempbuf;
X    if ((sfile = creat(name, 0644)) < 0)
X        return;
X    for (ip=itemtab; ip<itemmax; ip++) {
X        if (ip->i_token == UNDECLARED) {
X            ip->i_token = 0;
X            nitems--;
X        }
X    }
X
X    copyname(title, (char *)t);
X    t->t_value = SYMMAJIC;
X    t->t_token = nitems;
X    write(sfile, (char *)t, sizeof *t);
X
X    for (ip=itemtab; ip<itemmax; ip++) {
X        if (ip->i_token != 0) {
X            t->t_token = ip->i_token;
X            t->t_value = ip->i_value;
X            copyname(ip->i_string, (char *)t);
X            write(sfile, (char *)t, sizeof *t);
X        }
X    }
X
X    mfseek(mfile, (long)0, 0);
X    while((i = mfread(tempbuf, 1, TEMPBUFSIZE, mfile) ) > 0)
X        write(sfile, tempbuf, i);
X}
X
X
X
X/*
X *  copy a name into the symbol file
X */
Xcopyname(st1, st2)
Xchar *st1, *st2;
X{
X    register  char  *s1, *s2;
X    register  i;
X
X    i = (MAXSYMBOLSIZE+2) & ~01;
X    s1 = st1;
X    s2 = st2;
X
X    while(*s2++ = *s1++) i--;
X    while(--i > 0) *s2++ = '\0';
X}
X
X/* get the next source file */
Xnext_source(sp)
Xchar *sp ;
X{
X
X    if(now_in == NEST_IN -1)
X        error("Too many nested includes") ;
X    if ((now_file = fopen(sp, "r")) == NULL) {
X        char ebuf[100] ;
X        sprintf(ebuf,"Can't open include file: %s", sp) ;
X        error(ebuf) ;
X    }
X    if (pass2 && iflist()) {
X        lineout() ;
X        fprintf(fout, "**** %s ****\n",sp) ;
X    }
X
X    /* save the list control flag with the current line number */
X    if (lstoff)
X        linein[now_in] = - linein[now_in] ;
X
X    /* no list if include files are turned off */
X    lstoff |= iopt ;
X
X    /* save the new file descriptor. */
X    fin[++now_in] = now_file ;
X    /* start with line 0 */
X    linein[now_in] = 0 ;
X    /* save away the file name */
X    src_name[now_in] = malloc(strlen(sp)+1) ;
X    strcpy(src_name[now_in],sp) ;
X}
SHAR_EOF
chmod 0755 zmac/zmac.y
rm -f ._seq_
echo "You have unpacked the last part"
exit 0
--
"If I'd known it was harmless, I'd have killed it myself"  Phillip K. Dick
Bob Bownes, aka iii, aka captain comrade doktor bobwrench
3 A Pinehurst Ave,    Albany, New York, 12203, (518)-482-8798 voice
 [e-mail] {uunet!steinmetz,rutgers!brspyr1}!beowulf!bownesrm