      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      CALL INITI0
10000 IF((SYMBOL.EQ.2))GOTO 10001
        IF((SYMBOL.NE.3))GOTO 10002
          CALL GETSYM
          GOTO 10003
10002     IF((SYMBOL.NE.6))GOTO 10004
            CALL ENTER(TOKEN,1,LC)
            CALL GETSYM
            GOTO 10005
10004       CALL INSTR0
10005   CONTINUE
10003 GOTO 10000
10001 CALL CLEAN0
      CALL SWT
      END
      LOGICAL FUNCTION ALPHA(C)
      INTEGER C
      ALPHA=C.EQ.224.OR.C.EQ.223.OR.(225.LE.C.AND.C.LE.250).OR.(193.LE.C
     *.AND.C.LE.218)
      RETURN
      END
      SUBROUTINE BREXPR(VAL)
      INTEGER VAL
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER L,P
      INTEGER LOCAT0
      INTEGER DSGET
      IF((SYMBOL.EQ.4))GOTO 10006
        CALL ERRMSG('target of branch must be a label.')
        GOTO 10007
10006   L=LOCAT0(TOKEN)
        IF((SYMTYP(L).EQ.3))GOTO 10008
          VAL=SYMVAL(L)-LC-1
          IF(((VAL.LE.127).AND.(VAL.GE.-128)))GOTO 10009
            CALL ERRMSG('branch out of range.')
10009     GOTO 10010
10008     P=DSGET(2)
          MEM(P+1)=SYMBR0(L)
          MEM(P+0)=LC
          SYMBR0(L)=P
          VAL=0
10010   CALL GETSYM
10007 RETURN
      END
      SUBROUTINE CHAIN0(ADDR,VAL,TYPE)
      INTEGER ADDR,VAL,TYPE
      INTEGER P,NEXT
      P=ADDR
10011 IF((P.EQ.-1))GOTO 10012
        CALL PUTREL(TYPE,P)
        CALL XSEEK(P)
        CALL GETWO0(NEXT)
        CALL XSEEK(P)
        CALL PUTWO0(VAL)
        P=NEXT
      GOTO 10011
10012 IF((ADDR.EQ.-1))GOTO 10013
        CALL SEEKE0
10013 RETURN
      END
      SUBROUTINE CLEAN0
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER I,J,MAPLEN
      INTEGER LENGTH,CTOA
      CALL PUTBY0(2)
      MAPLEN=(LC+7)/8
      CALL PUTWO0(MAPLEN)
      I=1
      GOTO 10016
10014 I=I+1
10016 IF((I.GT.MAPLEN))GOTO 10015
        CALL PUTBY0(RMAP(I))
      GOTO 10014
10015 I=1
      GOTO 10019
10017 I=I+1
10019 IF((I.GT.SYMTOP))GOTO 10018
        IF((MEM(SYMSYM(I)).EQ.223))GOTO 10020
          CALL PUTBY0(3)
          CALL PUTWO0(LENGTH(MEM(SYMSYM(I)))+5)
          CALL PUTWO0(SYMTYP(I))
          CALL PUTWO0(SYMVAL(I))
          J=SYMSYM(I)
          GOTO 10023
10021     J=J+1
10023     IF((MEM(J).EQ.0))GOTO 10022
            CALL PUTBY0(CTOA(MEM(J)))
          GOTO 10021
10022     CALL PUTBY0(0)
10020 GOTO 10017
10018 CALL SEEK(1)
      CALL PUTWO0(LC)
      IF((LISTI0.NE.1))GOTO 10024
        CALL BUILD0
        CALL CLOSE(LIST)
        CALL CLOSE(LSOUR0)
10024 CALL CLOSE(CODE)
      RETURN
      END
      INTEGER FUNCTION COMPA0(STR1,STR2)
      INTEGER STR1(1),STR2(1)
      INTEGER I
      I=1
      GOTO 10027
10025 I=I+1
10027 IF((STR1(I).NE.STR2(I)))GOTO 10026
        IF((STR1(I).NE.0))GOTO 10028
          COMPA0=0
          RETURN
10028 GOTO 10025
10026 IF((STR1(I).LE.STR2(I)))GOTO 10029
        COMPA0=1
        GOTO 10030
10029   COMPA0=-1
10030 RETURN
      END
      SUBROUTINE COMPL0(MLINK,VAL)
      INTEGER MLINK,VAL
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER P,OFFSET,ADDRE0
      P=MLINK
10031 IF((P.EQ.-1))GOTO 10032
        ADDRE0=MEM(P+0)
        CALL XSEEK(ADDRE0)
        OFFSET=VAL-ADDRE0-1
        IF(((OFFSET.LE.127).AND.(OFFSET.GE.-128)))GOTO 10033
          CALL ERRMSG('a branch to this label is out of range.')
10033   CALL PUTBY0(OFFSET)
        ADDRE0=P
        P=MEM(P+1)
        CALL DSFREE(ADDRE0)
      GOTO 10031
10032 IF((MLINK.EQ.-1))GOTO 10034
        CALL SEEKE0
10034 RETURN
      END
      SUBROUTINE CPUTB0(VAL,RELOC)
      INTEGER VAL,RELOC
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      CALL PUTBY0(VAL)
      CALL PUTREL(RELOC,LC)
      LC=LC+1
      RETURN
      END
      SUBROUTINE CPUTW0(VAL,RELOC)
      INTEGER VAL,RELOC
      CALL CPUTB0(RS(VAL,8),RELOC)
      CALL CPUTB0(RT(VAL,8),0)
      RETURN
      END
      INTEGER FUNCTION CTOA(C)
      INTEGER C
      CTOA=RT(C,7)
      RETURN
      END
      SUBROUTINE DOMACH(OP)
      INTEGER OP
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER VAL,RELOC,BASE,MASK,BASEOP(108),ADDRM0(108)
      DATA BASEOP/:33,:211,:311,:213,:313,:204,:304,72,72,88,71,71,87,36
     *,37,39,44,46,34,133,197,47,35,45,43,38,42,32,141,40,41,17,12,14,79
     *,79,95,10,129,193,67,67,83,140,25,74,74,90,52,9,136,200,76,76,92,4
     *9,8,78,141,134,198,142,206,68,68,84,64,64,80,1,138,202,54,55,50,51
     *,73,73,89,70,70,86,59,57,16,130,194,13,15,11,135,199,143,207,128,1
     *92,63,15,22,6,23,7,77,77,93,48,53,62/
      DATA ADDRM0/:4,:270,:270,:270,:270,:270,:270,:30,:4,:4,:30,:4,:4,:
     *2,:2,:2,:2,:2,:2,:270,:270,:2,:2,:2,:2,:2,:2,:2,:2,:2,:2,:4,:4,:4,
     *:30,:4,:4,:4,:270,:270,:30,:4,:4,:170,:4,:30,:4,:4,:4,:4,:270,:270
     *,:30,:4,:4,:4,:4,:30,:30,:270,:270,:170,:170,:30,:4,:4,:30,:4,:4,:
     *4,:270,:270,:4,:4,:4,:4,:30,:4,:4,:30,:4,:4,:4,:4,:4,:270,:270,:4,
     *:4,:4,:70,:70,:70,:70,:270,:270,:4,:10,:4,:4,:4,:4,:30,:4,:4,:4,:4
     *,:4/
      BASE=BASEOP(OP)
      MASK=ADDRM0(OP)
      CALL GETSYM
      IF((SYMBOL.NE.5))GOTO 10035
        CALL GETSYM
        IF((AND(MASK,:200).EQ.0))GOTO 10036
          CALL CPUTB0(BASE+0,0)
          CALL EXPR(VAL,RELOC)
          IF((((RELOC.NE.1).AND.(VAL.GE.-128)).AND.(VAL.LE.255)))GOTO 10
     *037
            CALL ERRMSG('value relocatable or larger than 1 byte.')
10037     CALL CPUTB0(VAL,0)
          GOTO 10038
10036     IF((AND(MASK,:100).EQ.0))GOTO 10039
            CALL CPUTB0(BASE+0,0)
            CALL EXPR(VAL,RELOC)
            CALL CPUTW0(VAL,RELOC)
            GOTO 10040
10039       CALL ERRMSG('immediate addressing not allowed.')
10040   CONTINUE
10038   GOTO 10041
10035   IF((SYMBOL.NE.7))GOTO 10042
          CALL GETSYM
          IF((AND(MASK,:20).EQ.0))GOTO 10043
            CALL CPUTB0(BASE+32,0)
            CALL EXPR(VAL,RELOC)
            IF((((RELOC.NE.1).AND.(VAL.GE.0)).AND.(VAL.LE.255)))GOTO 100
     *44
              CALL ERRMSG('value is not a valid index.')
10044       CALL CPUTB0(VAL,0)
            IF((SYMBOL.NE.0))GOTO 10045
              CALL GETSYM
              GOTO 10046
10045         CALL ERRMSG('missing '']''.')
10046       GOTO 10047
10043       CALL ERRMSG('indexed addressing not permissible.')
10047     GOTO 10048
10042     IF((AND(MASK,:4).EQ.0))GOTO 10049
            CALL CPUTB0(BASE+0,0)
            GOTO 10050
10049       IF((AND(MASK,:2).EQ.0))GOTO 10051
              CALL CPUTB0(BASE+0,0)
              CALL BREXPR(VAL)
              CALL CPUTB0(VAL,0)
              GOTO 10052
10051         IF((AND(MASK,:10).EQ.0))GOTO 10053
                CALL CPUTB0(BASE+48,0)
                CALL EXPR(VAL,RELOC)
                CALL CPUTW0(VAL,RELOC)
                GOTO 10054
10053           CALL ERRMSG('in do_mach: can''t happen.')
10054       CONTINUE
10052     CONTINUE
10050   CONTINUE
10048 CONTINUE
10041 RETURN
      END
      SUBROUTINE DOPSE0(OP)
      INTEGER OP
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER VAL,RELOC,I
      INTEGER LOCAT0
      INTEGER SUBST(33)
      CALL GETSYM
      IF((OP.NE.0))GOTO 10055
        CALL EXPR(VAL,RELOC)
        IF((((RELOC.NE.1).AND.(VAL.LE.255)).AND.(VAL.GE.-128)))GOTO 1005
     *6
          CALL ERRMSG('value relocatable or larger than 1 byte.')
10056   CALL CPUTB0(VAL,0)
        GOTO 10057
10055   IF((OP.NE.1))GOTO 10058
          IF((SYMBOL.EQ.4))GOTO 10059
            CALL ERRMSG('def usage is ''def alias real''.')
            GOTO 10060
10059       CALL SCOPY(TOKEN,1,SUBST,1)
            CALL GETSYM
            IF((SYMBOL.EQ.4))GOTO 10061
              CALL ERRMSG('def usage is ''def alias real''.')
              GOTO 10062
10061         CALL ENTER(SUBST,2,LOCAT0(TOKEN))
              CALL GETSYM
10062     CONTINUE
10060     GOTO 10063
10058     IF((OP.NE.2))GOTO 10064
            CALL EXPR(VAL,RELOC)
            CALL CPUTW0(VAL,RELOC)
            GOTO 10065
10064       IF((OP.NE.3))GOTO 10066
              CALL EXPR(VAL,RELOC)
              IF((RELOC.NE.1))GOTO 10067
                CALL ERRMSG('value must not be relocatable.')
10067         I=1
              GOTO 10070
10068         I=I+1
10070         IF((I.GT.VAL))GOTO 10069
                CALL CPUTB0(0,0)
              GOTO 10068
10069         GOTO 10071
10066         IF((OP.NE.4))GOTO 10072
                CALL EXPR(VAL,RELOC)
                IF((RELOC.NE.1))GOTO 10073
                  CALL ERRMSG('value must not be relocatable.')
10073           IF((VAL.GE.LC))GOTO 10074
                  CALL ERRMSG('backward origin not permitted.')
10074           CONTINUE
10075           IF((LC.GE.VAL))GOTO 10076
                  CALL CPUTB0(0,0)
                GOTO 10075
10076         CONTINUE
10072       CONTINUE
10071     CONTINUE
10065   CONTINUE
10063 CONTINUE
10057 RETURN
      END
      SUBROUTINE ENTER(SYM,TYPE,VAL)
      INTEGER SYM(1)
      INTEGER TYPE,VAL
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER L
      INTEGER LOCAT0
      L=LOCAT0(SYM)
      IF((SYMTYP(L).EQ.3))GOTO 10077
        CALL ERRMSG('symbol redefined.')
        GOTO 10078
10077   CALL CHAIN0(SYMVAL(L),VAL,TYPE)
        CALL COMPL0(SYMBR0(L),VAL)
        SYMTYP(L)=TYPE
        SYMVAL(L)=VAL
10078 RETURN
      END
      SUBROUTINE ERRMSG(MSG)
      INTEGER MSG(1)
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      CALL PRINT(-15,'*4i: *p*n.',LCNT,MSG)
      RETURN
      END
      SUBROUTINE EXPR(VAL,RELOC)
      INTEGER VAL,RELOC
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER L
      INTEGER LOCAT0
      IF((SYMBOL.NE.1))GOTO 10079
        VAL=CONST0
        RELOC=0
        CALL GETSYM
        GOTO 10080
10079   IF((SYMBOL.NE.4))GOTO 10081
          L=LOCAT0(TOKEN)
          IF((SYMTYP(L).NE.3))GOTO 10082
            VAL=SYMVAL(L)
            SYMVAL(L)=LC
            RELOC=0
            GOTO 10083
10082       VAL=SYMVAL(L)
            RELOC=SYMTYP(L)
10083     CALL GETSYM
          GOTO 10084
10081     CALL ERRMSG('missing expression.')
          VAL=0
          RELOC=0
10084 CONTINUE
10080 RETURN
      END
      SUBROUTINE GETBY0(B)
      INTEGER B
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER JUNK
      INTEGER MAPFD
      CALL PRWF$$(:1,MAPFD(CODE),LOC(B),1,INTL(0),JUNK,JUNK)
      RETURN
      END
      SUBROUTINE GETSYM
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER C
      LOGICAL ALPHA
10085   CALL INCHAR(C)
      IF(((C.EQ.160).OR.(C.EQ.137)))GOTO 10085
      IF((.NOT.ALPHA(C)))GOTO 10086
        CALL PUSHB0(C)
        CALL SCANID
        GOTO 10087
10086   IF(((176.GT.C).OR.(C.GT.185)))GOTO 10088
          CALL PUSHB0(C)
          CALL SCAND0
          GOTO 10089
10088     IF((C.NE.164))GOTO 10090
            CALL SCANH0
            GOTO 10091
10090       IF((C.NE.165))GOTO 10092
              CALL SCANC0
              GOTO 10093
10092         IF((C.NE.219))GOTO 10094
                SYMBOL=7
                GOTO 10095
10094           IF((C.NE.221))GOTO 10096
                  SYMBOL=0
                  GOTO 10097
10096             IF((C.NE.163))GOTO 10098
                    SYMBOL=5
                    GOTO 10099
10098               IF((C.NE.187))GOTO 10100
                      SYMBOL=3
                      GOTO 10101
10100                 IF((C.NE.138))GOTO 10102
                        SYMBOL=3
                        LCNT=LCNT+1
                        GOTO 10103
10102                   IF((C.NE.-1))GOTO 10104
                          SYMBOL=2
10104                 CONTINUE
10103               CONTINUE
10101             CONTINUE
10099           CONTINUE
10097         CONTINUE
10095       CONTINUE
10093     CONTINUE
10091   CONTINUE
10089 CONTINUE
10087 RETURN
      END
      SUBROUTINE GETWO0(W)
      INTEGER W
      INTEGER HI,LO
      CALL GETBY0(HI)
      CALL GETBY0(LO)
      W=OR(LS(HI,8),LO)
      RETURN
      END
      SUBROUTINE INCHAR(C)
      INTEGER C
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER GETCH
      IF((IBP.LE.0))GOTO 10105
        C=INBUF(IBP)
        GOTO 10106
10105   IBP=1
        INBUF(IBP)=GETCH(C,-10)
        IF((LISTI0.NE.1))GOTO 10107
          CALL PUTCH(C,LSOUR0)
10107 CONTINUE
10106 IF((C.EQ.-1))GOTO 10108
        IBP=IBP-1
10108 RETURN
      END
      SUBROUTINE INITI0
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER CODEF(3)
      INTEGER I
      INTEGER CREATE,GETARG,MKTEMP
      INTEGER ARG(128)
      DATA CODEF/174,239,0/
      CODE=CREATE(CODEF,3)
      IF((CODE.NE.-3))GOTO 10109
        CALL ERROR('can''t open output file.')
10109 LISTI0=0
      DIREC0=.FALSE.
      IF((GETARG(1,ARG,128).EQ.-1))GOTO 10110
      IF((ARG(1).NE.173))GOTO 10110
        I=2
        GOTO 10113
10111   I=I+(1)
10113   IF((ARG(I).EQ.0))GOTO 10112
          IF((ARG(I).EQ.236))GOTO 10115
          IF((ARG(I).EQ.204))GOTO 10115
          GOTO 10114
10115       LISTI0=1
            LIST=MKTEMP(3)
            IF((LIST.NE.-3))GOTO 10116
              CALL ERROR('can''t open listing temporary file.')
10116       LSOUR0=MKTEMP(3)
            IF((LSOUR0.NE.-3))GOTO 10117
              CALL ERROR('can''t open source temporary file.')
10117       GOTO 10118
10114       IF((ARG(I).EQ.228))GOTO 10120
            IF((ARG(I).EQ.196))GOTO 10120
            GOTO 10119
10120         DIREC0=.TRUE.
              GOTO 10121
10119         CALL ERROR('Usage: as6800 [-{l|d}].')
10121     CONTINUE
10118   GOTO 10111
10112 CONTINUE
10110 LCNT=1
      LC=0
      SYMTOP=0
      IBP=0
      CALL DSINIT(10000)
      CALL GETSYM
      CALL PUTBY0(1)
      I=2
      GOTO 10124
10122 I=I+1
10124 IF((I.GT.3))GOTO 10123
        CALL PUTBY0(0)
      GOTO 10122
10123 RETURN
      END
      SUBROUTINE INSTR0
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER OP
      INTEGER PSEUD0,MACHOP
      IF((LISTI0.NE.1))GOTO 10125
        CALL PRINT(LIST,'*8,i*8,i*n.',LC,LCNT)
10125 IF((PSEUD0(TOKEN,OP).NE.1))GOTO 10126
        CALL DOPSE0(OP)
        GOTO 10127
10126   IF((MACHOP(TOKEN,OP).NE.1))GOTO 10128
          CALL DOMACH(OP)
          GOTO 10129
10128     CALL ERRMSG('unrecognized symbol in op field.')
          CALL GETSYM
10129 CONTINUE
10127 RETURN
      END
      INTEGER FUNCTION LOCAT0(SYM)
      INTEGER SYM(1)
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER I
      INTEGER EQUAL
      INTEGER SDUP
      I=1
      GOTO 10132
10130 I=I+1
10132 IF((I.GT.SYMTOP))GOTO 10131
        IF((EQUAL(SYM,MEM(SYMSYM(I))).NE.1))GOTO 10133
          IF((SYMTYP(I).NE.2))GOTO 10134
            LOCAT0=SYMVAL(I)
            GOTO 10135
10134       LOCAT0=I
10135     RETURN
10133 GOTO 10130
10131 IF((SYMTOP.LT.2000))GOTO 10136
        CALL ERRMSG('too many symbols --- assembly stopped.')
        CALL SWT
10136 SYMTOP=SYMTOP+1
      SYMSYM(SYMTOP)=SDUP(SYM)
      SYMTYP(SYMTOP)=3
      SYMVAL(SYMTOP)=-1
      SYMBR0(SYMTOP)=-1
      LOCAT0=SYMTOP
      RETURN
      END
      INTEGER FUNCTION MACHOP(TOKEN,OP)
      INTEGER TOKEN(1)
      INTEGER OP
      INTEGER INSTS0(5,108)
      INTEGER TOP,BOTTOM,MIDDLE,COMP
      INTEGER COMPA0
      DATA INSTS0/225,226,225,2*0,225,228,227,225,0,225,228,227,226,0,22
     *5,228,228,225,0,225,228,228,226,0,225,238,228,225,0,225,238,228,22
     *6,0,225,243,236,2*0,225,243,236,225,0,225,243,236,226,0,225,243,24
     *2,2*0,225,243,242,225,0,225,243,242,226,0,226,227,227,2*0,226,227,
     *243,2*0,226,229,241,2*0,226,231,229,2*0,226,231,244,2*0,226,232,23
     *3,2*0,226,233,244,225,0,226,233,244,226,0,226,236,229,2*0,226,236,
     *243,2*0,226,236,244,2*0,226,237,233,2*0,226,238,229,2*0,226,240,23
     *6,2*0,226,242,225,2*0,226,243,242,2*0,226,246,227,2*0,226,246,243,
     *2*0,227,226,225,2*0,227,236,227,2*0,227,236,233,2*0,227,236,242,2*
     *0,227,236,242,225,0,227,236,242,226,0,227,236,246,2*0,227,237,240,
     *225,0,227,237,240,226,0,227,239,237,2*0,227,239,237,225,0,227,239,
     *237,226,0,227,240,248,2*0,228,225,225,2*0,228,229,227,2*0,228,229,
     *227,225,0,228,229,227,226,0,228,229,243,2*0,228,229,248,2*0,229,23
     *9,242,225,0,229,239,242,226,0,233,238,227,2*0,233,238,227,225,0,23
     *3,238,227,226,0,233,238,243,2*0,233,238,248,2*0,234,237,240,2*0,23
     *4,243,242,2*0,236,228,225,225,0,236,228,225,226,0,236,228,243,2*0,
     *236,228,248,2*0,236,243,242,2*0,236,243,242,225,0,236,243,242,226,
     *0,238,229,231,2*0,238,229,231,225,0,238,229,231,226,0,238,239,240,
     *2*0,239,242,225,225,0,239,242,225,226,0,240,243,232,225,0,240,243,
     *232,226,0,240,245,236,225,0,240,245,236,226,0,242,239,236,2*0,242,
     *239,236,225,0,242,239,236,226,0,242,239,242,2*0,242,239,242,225,0,
     *242,239,242,226,0,242,244,233,2*0,242,244,243,2*0,243,226,225,2*0,
     *243,226,227,225,0,243,226,227,226,0,243,229,227,2*0,243,229,233,2*
     *0,243,229,246,2*0,243,244,225,225,0,243,244,225,226,0,243,244,243,
     *2*0,243,244,248,2*0,243,245,226,225,0,243,245,226,226,0,243,247,23
     *3,2*0,243,249,243,2*0,244,225,226,2*0,244,225,240,2*0,244,226,225,
     *2*0,244,240,225,2*0,244,243,244,2*0,244,243,244,225,0,244,243,244,
     *226,0,244,243,248,2*0,244,248,243,2*0,247,225,233,2*0/
      TOP=1
      BOTTOM=108
10137   MIDDLE=RS(TOP+BOTTOM,1)
        COMP=COMPA0(TOKEN,INSTS0(1,MIDDLE))
        IF((COMP.LT.0))GOTO 10138
          TOP=MIDDLE+1
10138   IF((COMP.GT.0))GOTO 10139
          BOTTOM=MIDDLE-1
10139 CONTINUE
      IF((TOP.LE.BOTTOM))GOTO 10137
      IF((COMP.NE.0))GOTO 10140
        MACHOP=1
        OP=MIDDLE
        GOTO 10141
10140   MACHOP=0
10141 RETURN
      END
      INTEGER FUNCTION PSEUD0(TOKEN,OP)
      INTEGER TOKEN(1)
      INTEGER OP
      INTEGER BYTEOP(5)
      INTEGER DEFOP(4)
      INTEGER WORDOP(5)
      INTEGER RESOP(4)
      INTEGER ORGOP(4)
      INTEGER EQUAL
      DATA BYTEOP/226,249,244,229,0/
      DATA DEFOP/228,229,230,0/
      DATA WORDOP/247,239,242,228,0/
      DATA RESOP/242,229,243,0/
      DATA ORGOP/239,242,231,0/
      PSEUD0=1
      IF((EQUAL(TOKEN,BYTEOP).NE.1))GOTO 10142
        OP=0
        GOTO 10143
10142   IF((EQUAL(TOKEN,DEFOP).NE.1))GOTO 10144
          OP=1
          GOTO 10145
10144     IF((EQUAL(TOKEN,WORDOP).NE.1))GOTO 10146
            OP=2
            GOTO 10147
10146       IF((EQUAL(TOKEN,RESOP).NE.1))GOTO 10148
              OP=3
              GOTO 10149
10148         IF((EQUAL(TOKEN,ORGOP).NE.1))GOTO 10150
                OP=4
                GOTO 10151
10150           PSEUD0=0
10151       CONTINUE
10149     CONTINUE
10147   CONTINUE
10145 CONTINUE
10143 RETURN
      END
      SUBROUTINE PUSHB0(C)
      INTEGER C
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      IBP=IBP+1
      IF((IBP.LE.10))GOTO 10152
        CALL ERRMSG('too many characters pushed back.')
        GOTO 10153
10152   INBUF(IBP)=C
10153 RETURN
      END
      SUBROUTINE PUTBY0(B)
      INTEGER B
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER W,JUNK
      INTEGER MAPFD
      W=RT(B,8)
      CALL PRWF$$(:2,MAPFD(CODE),LOC(W),1,INTL(0),JUNK,JUNK)
      RETURN
      END
      SUBROUTINE PUTREL(RELOC,ADDRE0)
      INTEGER RELOC,ADDRE0
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER WORD,MASK
      WORD=ADDRE0/8+1
      MASK=LS(1,7-MOD(ADDRE0,8))
      IF((RELOC.NE.1))GOTO 10154
        RMAP(WORD)=OR(RMAP(WORD),MASK)
        GOTO 10155
10154   RMAP(WORD)=AND(RMAP(WORD),NOT(MASK))
10155 RETURN
      END
      SUBROUTINE PUTWO0(W)
      INTEGER W
      CALL PUTBY0(RS(W,8))
      CALL PUTBY0(RT(W,8))
      RETURN
      END
      SUBROUTINE SCANC0
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER C
10156   CALL INCHAR(C)
      IF((C.NE.138))GOTO 10156
      LCNT=LCNT+1
      SYMBOL=3
      RETURN
      END
      SUBROUTINE SCAND0
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER DEC(11)
      INTEGER C
      INTEGER I
      INTEGER INDEX
      DATA DEC/176,177,178,179,180,181,182,183,184,185,0/
      CONST0=0
10157   CALL INCHAR(C)
        I=INDEX(DEC,C)
        IF((I.GE.1))GOTO 10158
          CALL PUSHB0(C)
          GOTO 10159
10158   CONST0=10*CONST0+I-1
      GOTO 10157
10159 SYMBOL=1
      RETURN
      END
      SUBROUTINE SCANH0
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER HEX(17)
      INTEGER C
      INTEGER MAPDN
      INTEGER I
      INTEGER INDEX
      DATA HEX/176,177,178,179,180,181,182,183,184,185,225,226,227,228,2
     *29,230,0/
      CONST0=0
10160   CALL INCHAR(C)
        I=INDEX(HEX,MAPDN(C))
        IF((I.GE.1))GOTO 10161
          CALL PUSHB0(C)
          GOTO 10162
10161   CONST0=LS(CONST0,4)+I-1
      GOTO 10160
10162 SYMBOL=1
      RETURN
      END
      SUBROUTINE SCANID
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER I
      INTEGER C
      LOGICAL ALPHA
      I=1
10163   CALL INCHAR(C)
        IF((ALPHA(C).OR.((C.GE.176).AND.(C.LE.185))))GOTO 10164
          GOTO 10165
10164   TOKEN(I)=C
        I=I+1
      GOTO 10163
10165 TOKEN(I)=0
      IF((C.NE.186))GOTO 10166
        SYMBOL=6
        GOTO 10167
10166   CALL PUSHB0(C)
        SYMBOL=4
10167 RETURN
      END
      INTEGER FUNCTION SDUP(STR)
      INTEGER STR(1)
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER P
      INTEGER LENGTH,DSGET
      P=DSGET(LENGTH(STR)+1)
      CALL SCOPY(STR,1,MEM,P)
      SDUP=P
      RETURN
      END
      SUBROUTINE SEEKE0
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER JUNK
      INTEGER MAPFD
      CALL PRWF$$(:3+:10,MAPFD(CODE),LOC(0),0,INTL(65536),JUNK,JUNK)
      RETURN
      END
      SUBROUTINE SEEK(POSN)
      INTEGER POSN
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER JUNK
      INTEGER MAPFD
      CALL PRWF$$(:3+:10,MAPFD(CODE),LOC(0),0,INTL(POSN),JUNK,JUNK)
      RETURN
      END
      SUBROUTINE XSEEK(POSN)
      INTEGER POSN
      CALL SEEK(POSN+3)
      RETURN
      END
      SUBROUTINE BUILD0
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER GETIN0,GETLIN
      INTEGER LASTL0,B1,B2,B3,LLC,NLC,LLCNT,NLCNT,LINE(102),LISTJ0,MULTI
     *0,COUNT
      CALL SEEK(1)
      CALL GETCO0(B1,B2,B3,2)
      LASTL0=LS(B1,8)+B2
      CALL XSEEK(0)
      CALL REWIND(LIST)
      CALL REWIND(LSOUR0)
      LLCNT=0
      LLC=0
      MULTI0=0
      LISTJ0=0
10168 IF((LISTJ0.EQ.-1))GOTO 10169
        IF((GETIN0(NLC,NLCNT).NE.-1))GOTO 10170
          NLC=LASTL0
          NLCNT=LLCNT+1
          LISTJ0=-1
10170   IF(((NLCNT-LLCNT).LE.1))GOTO 10171
          IF(((NLC-LLC).EQ.0))GOTO 10172
            IF((MULTI0.NE.1))GOTO 10173
              CALL GETCO0(B1,B2,B3,(NLC-LLC),NLC)
              CALL LISTK0(LLCNT,LLC,B1,B2,B3,(LLC-NLC),LINE)
              MULTI0=0
              GOTO 10174
10173         CALL GETCO0(B1,B2,B3,(NLC-LLC),NLC)
              IF((GETLIN(LINE,LSOUR0).NE.-1))GOTO 10175
                CALL ERROR('In build_listing: shouldn''t happen.')
10175         CALL LISTK0(LLCNT,LLC,B1,B2,B3,(NLC-LLC),LINE)
10174     CONTINUE
10172     COUNT=NLCNT-LLCNT-1
          GOTO 10178
10176     COUNT=COUNT-1
10178     IF((COUNT.LE.0))GOTO 10177
            IF((-1.NE.GETLIN(LINE,LSOUR0)))GOTO 10179
              CALL ERROR('in build_listing: shouldn''t happen.')
10179       CALL LISTK0(NLCNT-COUNT,LLC,0,0,0,0,LINE)
          GOTO 10176
10177     GOTO 10180
10171     IF((LLC.NE.NLC))GOTO 10181
          IF((LLC.NE.0))GOTO 10181
            LLCNT=NLCNT
            GOTO 10168
10181       IF((NLC.EQ.LLC))GOTO 10182
            IF((LLCNT.NE.NLCNT))GOTO 10182
              IF((MULTI0.NE.1))GOTO 10183
                CALL GETCO0(B1,B2,B3,NLC-LLC,NLC)
                CALL LISTK0(LLCNT,LLC,B1,B2,B3,(LLC-NLC),LINE)
                GOTO 10184
10183           MULTI0=1
                CALL GETCO0(B1,B2,B3,NLC-LLC,NLC)
                IF((-1.NE.GETLIN(LINE,LSOUR0)))GOTO 10185
                  CALL ERROR('In build_listing: shouldn''t happen.')
10185           CALL LISTK0(LLCNT,LLC,B1,B2,B3,(NLC-LLC),LINE)
10184         GOTO 10186
10182         CALL GETCO0(B1,B2,B3,NLC-LLC,NLC)
              IF((MULTI0.NE.1))GOTO 10187
                CALL LISTK0(LLCNT,LLC,B1,B2,B3,(NLC-LLC)*(-1),LINE)
                MULTI0=0
                GOTO 10188
10187           IF((-1.NE.GETLIN(LINE,LSOUR0)))GOTO 10189
                  CALL ERROR('in build_listing: can''t happen.')
10189           CALL LISTK0(LLCNT,LLC,B1,B2,B3,(NLC-LLC),LINE)
10188       CONTINUE
10186     CONTINUE
10180   LLC=NLC
        LLCNT=NLCNT
      GOTO 10168
10169 CONTINUE
10190 IF((GETLIN(LINE,LSOUR0).EQ.-1))GOTO 10191
        CALL LISTK0(LLCNT,LLC,B1,B2,B3,0,LINE)
        LLCNT=LLCNT+1
      GOTO 10190
10191 RETURN
      END
      SUBROUTINE LISTK0(LCNT,LC,B1,B2,B3,NBYTES,LINE)
      INTEGER LCNT,LC,B1,B2,B3,NBYTES
      INTEGER LINE(1)
      INTEGER AAAAA0
      INTEGER AAAAB0
      AAAAA0=NBYTES
      GOTO 10192
10193   CALL PRINT(-11,'         (*4,16,0j)  *2,16,0j*n.',LC,B1)
      GOTO 10194
10195   CALL PRINT(-11,'         (*4,16,0j)  *2,16,0j *2,16,0j*n.',LC,B1
     *,B2)
      GOTO 10194
10196   CALL PRINT(-11,'         (*4,16,0j)  *2,16,0j *2,16,0j *2,16,0j*
     *n.',LC,B1,B2,B3)
      GOTO 10194
10197   CALL PRINT(-11,'*5,i    (*4,16,0j)  *2,16,0j          *s.',LCNT,
     *LC,B1,LINE)
      GOTO 10194
10198   CALL PRINT(-11,'*5,i    (*4,16,0j)  *2,16,0j *2,16,0j       *s.'
     *,LCNT,LC,B1,B2,LINE)
      GOTO 10194
10199   CALL PRINT(-11,'*5,i    (*4,16,0j)  *2,16,0j *2,16,0j *2,16,0j
     *  *s.',LCNT,LC,B1,B2,B3,LINE)
      GOTO 10194
10192 AAAAB0=AAAAA0+4
      GOTO(10196,10195,10193,10200,10197,10198,10199),AAAAB0
10200   CALL PRINT(-11,'*5,i                        *s.',LCNT,LINE)
10194 RETURN
      END
      INTEGER FUNCTION GETIN0(LOCLC,LOCLC0)
      INTEGER LOCLC,LOCLC0
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER GETLIN,CTOI
      INTEGER I
      INTEGER LINE(102)
      IF((GETLIN(LINE,LIST).NE.-1))GOTO 10201
        GETIN0=-1
        RETURN
10201 I=1
      LOCLC=CTOI(LINE,I)
      LOCLC0=CTOI(LINE,I)
      GETIN0=-2
      RETURN
      END
      SUBROUTINE GETCO0(B1,B2,B3,BYTES,NLC)
      INTEGER B1,B2,B3,BYTES,NLC
      INTEGER MEM(10000)
      COMMON /DS$MEM/MEM
      INTEGER SYMBOL,LCNT,IBP,CONST0
      INTEGER TOKEN(33),INBUF(10)
      COMMON /PARCOM/SYMBOL,LCNT,IBP,TOKEN,INBUF,CONST0
      INTEGER SYMSYM(2000),SYMTYP(2000),SYMVAL(2000),SYMBR0(2000),SYMTOP
      COMMON /SYMTAB/SYMSYM,SYMTYP,SYMVAL,SYMBR0,SYMTOP
      INTEGER RMAP(4096)
      COMMON /RELMAP/RMAP
      INTEGER LC,CODE
      LOGICAL DIREC0
      COMMON /CCOM/LC,CODE,DIREC0
      INTEGER LIST,LISTI0,LSOUR0
      COMMON /LSTNG/LIST,LISTI0,LSOUR0
      INTEGER JUNK
      INTEGER MAPFD
      INTEGER AAAAC0
      AAAAC0=BYTES
      GOTO 10202
10203   CALL PRWF$$(:1,MAPFD(CODE),LOC(B1),1,INTL(0),JUNK,JUNK)
      GOTO 10204
10205   CALL PRWF$$(:1,MAPFD(CODE),LOC(B1),1,INTL(0),JUNK,JUNK)
        CALL PRWF$$(:1,MAPFD(CODE),LOC(B2),1,INTL(0),JUNK,JUNK)
      GOTO 10204
10206   CALL PRWF$$(:1,MAPFD(CODE),LOC(B1),1,INTL(0),JUNK,JUNK)
        CALL PRWF$$(:1,MAPFD(CODE),LOC(B2),1,INTL(0),JUNK,JUNK)
        CALL PRWF$$(:1,MAPFD(CODE),LOC(B3),1,INTL(0),JUNK,JUNK)
      GOTO 10204
10202 GOTO(10203,10205,10206),AAAAC0
        CALL XSEEK(NLC)
        B1=0
        B2=0
        B3=0
10204 RETURN
      END
C ---- Long Name Map ----
C putbyte                        putby0
C symbrlist                      symbr0
C instruction                    instr0
C directenabled                  direc0
C chainback                      chain0
C address                        addre0
C scancomment                    scanc0
C compare                        compa0
C constval                       const0
C cleanup                        clean0
C putword                        putwo0
C scanhex                        scanh0
C multiple                       multi0
C pseudoop                       pseud0
C cputbyte                       cputb0
C loclcnt                        loclc0
C addrmask                       addrm0
C getbyte                        getby0
C cputword                       cputw0
C pushback                       pushb0
C listing                        listk0
C getword                        getwo0
C scandec                        scand0
C lsource                        lsour0
C completebr                     compl0
C buildlisting                   build0
C instructions                   insts0
C getindex                       getin0
C listingend                     listj0
C initialize                     initi0
C location                       locat0
C lastlocation                   lastl0
C Listing                        listi0
C getcode                        getco0
C seekend                        seeke0
C dopseudo                       dopse0