      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
      COMMON /CCOM/LC,CODE
      CALL INITI0
10000 IF((SYMBOL.EQ.2))GOTO 10001
        IF((SYMBOL.NE.3))GOTO 10002
          CALL GETSYM
          GOTO 10003
10002     IF((SYMBOL.NE.5))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 CHAIN0(ADDR,VAL,TYPE)
      INTEGER ADDR,VAL,TYPE
      INTEGER P,NEXT
      P=ADDR
10006 IF((P.EQ.-1))GOTO 10007
        CALL PUTREL(TYPE,P)
        CALL XSEEK(P)
        CALL GETWO0(NEXT)
        CALL XSEEK(P)
        CALL PUTWO0(VAL)
        P=NEXT
      GOTO 10006
10007 IF((ADDR.EQ.-1))GOTO 10008
        CALL SEEKE0
10008 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
      COMMON /CCOM/LC,CODE
      INTEGER I,J,MAPLEN
      INTEGER LENGTH,CTOA
      CALL PUTBY0(2)
      MAPLEN=(LC+7)/8
      CALL PUTWO0(MAPLEN)
      I=1
      GOTO 10011
10009 I=I+1
10011 IF((I.GT.MAPLEN))GOTO 10010
        CALL PUTBY0(RMAP(I))
      GOTO 10009
10010 I=1
      GOTO 10014
10012 I=I+1
10014 IF((I.GT.SYMTOP))GOTO 10013
        IF(((MEM(SYMSYM(I)).EQ.223).OR.(SYMTYP(I).EQ.4)))GOTO 10015
          CALL PUTBY0(3)
          CALL PUTWO0(LENGTH(MEM(SYMSYM(I)))+5)
          CALL PUTWO0(SYMTYP(I))
          CALL PUTWO0(SYMVAL(I))
          J=SYMSYM(I)
          GOTO 10018
10016     J=J+1
10018     IF((MEM(J).EQ.0))GOTO 10017
            CALL PUTBY0(CTOA(MEM(J)))
          GOTO 10016
10017     CALL PUTBY0(0)
10015 GOTO 10012
10013 CALL SEEK(1)
      CALL PUTWO0(LC)
      CALL CLOSE(CODE)
      RETURN
      END
      INTEGER FUNCTION COMPA0(STR1,STR2)
      INTEGER STR1(1),STR2(1)
      INTEGER I
      I=1
      GOTO 10021
10019 I=I+1
10021 IF((STR1(I).NE.STR2(I)))GOTO 10020
        IF((STR1(I).NE.0))GOTO 10022
          COMPA0=0
          RETURN
10022 GOTO 10019
10020 IF((STR1(I).LE.STR2(I)))GOTO 10023
        COMPA0=1
        GOTO 10024
10023   COMPA0=-1
10024 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
      COMMON /CCOM/LC,CODE
      CALL PUTBY0(VAL)
      CALL PUTREL(RELOC,LC)
      LC=LC+1
      RETURN
      END
      SUBROUTINE CPUTW0(VAL,RELOC)
      INTEGER VAL,RELOC
      CALL CPUTB0(RT(VAL,8),RELOC)
      CALL CPUTB0(RS(VAL,8),0)
      RETURN
      END
      INTEGER FUNCTION CTOA(C)
      INTEGER C
      CTOA=RT(C,7)
      RETURN
      END
      SUBROUTINE DOMACH(OP)
      INTEGER OP,EXPR
      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
      COMMON /CCOM/LC,CODE
      INTEGER RELOC,V(83)
      INTEGER IOV1,IOV2,ITYP,MCODE,I,JUNK
      DATA V/8011,5206,2136,2128,5198,2160,5230,7205,7220,0047,0063,2184
     *,7252,7212,7196,7244,7236,5254,7228,7204,0039,1009,1005,1011,0243,
     *0251,8013,0118,5219,1004,1003,7218,7250,7195,7210,7194,7242,7234,7
     *226,7202,7058,1010,7042,6001,3064,4006,0000,2176,8000,5246,5211,02
     *33,1193,1197,0023,0031,0216,0201,0007,0248,0208,0192,0240,0232,022
     *4,0015,1199,0200,2152,5222,8002,7034,0249,7050,1002,0055,2144,5214
     *,0235,2168,5238,0227,-1/
      ITYP=V(OP)/1000
      MCODE=V(OP)-ITYP*1000
      I=ITYP+1
      GOTO 10025
10027   CALL CPUTB0(MCODE,0)
        CALL GETSYM
        GOTO 10026
10028   IF((EXPR(IOV1,JUNK).NE.-3))GOTO 10127
          RETURN
10127   CALL CPUTB0(MCODE+MOD(IABS(IOV1),8)*8,0)
        GOTO 10026
10029   IF((EXPR(IOV1,JUNK).NE.-3))GOTO 10128
          RETURN
10128   CALL CPUTB0(MCODE+MOD(IABS(IOV1),8),0)
        GOTO 10026
10030   IF((EXPR(IOV1,JUNK).NE.-3))GOTO 10129
          RETURN
10129   IF((EXPR(IOV2,RELOC).NE.-3))GOTO 10130
          RETURN
10130   CALL CPUTB0(MCODE+MOD(IABS(IOV1),8)*8+MOD(IOV2,8),0)
        GOTO 10026
10031   IF((EXPR(IOV1,JUNK).NE.-3))GOTO 10131
          RETURN
10131   CALL CPUTB0(MCODE+MOD(IABS(IOV1),8)*8,0)
        IF((EXPR(IOV2,RELOC).NE.-3))GOTO 10132
          RETURN
10132   CALL CPUTB0(RT(IOV2,8),RELOC)
        GOTO 10026
10032   CALL CPUTB0(MCODE,0)
        IF((EXPR(IOV1,RELOC).NE.-3))GOTO 10133
          RETURN
10133   CALL CPUTB0(RT(IOV1,8),RELOC)
        GOTO 10026
10033   IF((EXPR(IOV1,JUNK).NE.-3))GOTO 10134
          RETURN
10134   CALL CPUTB0(MCODE+MOD(IABS(IOV1),8)*8,0)
        IF((EXPR(IOV2,RELOC).NE.-3))GOTO 10135
          RETURN
10135   CALL CPUTW0(IOV2,RELOC)
        GOTO 10026
10034   CALL CPUTB0(MCODE,0)
        IF((EXPR(IOV1,RELOC).NE.-3))GOTO 10136
          RETURN
10136   CALL CPUTW0(IOV1,RELOC)
        GOTO 10026
10035 CONTINUE
10025 GOTO(10027,10028,10029,10030,10031,10032,10033,10034),I
10026 IF((SYMBOL.EQ.3))GOTO 10137
        CALL ERRMSG('end of line expected.')
10138   IF((SYMBOL.EQ.3))GOTO 10139
          CALL GETSYM
        GOTO 10138
10139 CONTINUE
10137 RETURN
      END
      SUBROUTINE DOPSE0(OP)
      INTEGER OP,EXPR
      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
      COMMON /CCOM/LC,CODE
      INTEGER VAL,RELOC
      INTEGER LOCAT0
      INTEGER SUBST(33)
      IF((OP.NE.0))GOTO 10140
        IF((EXPR(VAL,RELOC).NE.-3))GOTO 10141
          RETURN
10141   IF((((RELOC.NE.1).AND.(VAL.LE.255)).AND.(VAL.GE.-128)))GOTO 1014
     *2
          CALL PRINT(-11,'reloc = *i; val = *i*n.',RELOC,VAL)
10142   CALL CPUTB0(VAL,0)
        GOTO 10143
10140   IF((OP.NE.1))GOTO 10144
          CALL GETSYM
          IF((SYMBOL.EQ.4))GOTO 10145
            CALL ERRMSG('def usage is ''def alias real''.')
            GOTO 10146
10145       CALL SCOPY(TOKEN,1,SUBST,1)
            CALL GETSYM
            IF((SYMBOL.EQ.4))GOTO 10147
              CALL ERRMSG('def usage is ''def alias real''.')
              GOTO 10148
10147         CALL ENTER(SUBST,2,LOCAT0(TOKEN))
              CALL GETSYM
10148     CONTINUE
10146     GOTO 10149
10144     IF((EXPR(VAL,RELOC).NE.-3))GOTO 10150
            RETURN
10150     CALL CPUTW0(VAL,RELOC)
10149 CONTINUE
10143 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
      COMMON /CCOM/LC,CODE
      INTEGER L
      INTEGER LOCAT0
      L=LOCAT0(SYM)
      IF((SYMTYP(L).EQ.3))GOTO 10151
        CALL ERRMSG('symbol redefined.')
        GOTO 10152
10151   CALL CHAIN0(SYMVAL(L),VAL,TYPE)
        SYMTYP(L)=TYPE
        SYMVAL(L)=VAL
10152 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
      COMMON /CCOM/LC,CODE
      CALL PRINT(-15,'*4i: *p*n.',LCNT,MSG)
      RETURN
      END
      INTEGER FUNCTION 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
      COMMON /CCOM/LC,CODE
      INTEGER L,VAL2,OPERA0
      INTEGER LOCAT0,CALLE0
      IF((SYMBOL.NE.3))GOTO 10153
        EXPR=-3
        CALL ERRMSG('expression expected.')
        VAL=0
        RELOC=0
        RETURN
10153 EXPR=-2
      CALL GETSYM
      IF((SYMBOL.NE.1))GOTO 10154
        VAL=CONST0
        CALL GETSYM
        IF(((SYMBOL.LT.6).OR.(SYMBOL.GT.7)))GOTO 10155
          OPERA0=SYMBOL
          EXPR=CALLE0(VAL2,RELOC)
          IF((OPERA0.NE.6))GOTO 10156
            VAL=OR(VAL,VAL2)
            GOTO 10157
10156       IF((OPERA0.NE.7))GOTO 10158
              VAL=AND(VAL,VAL2)
10158     CONTINUE
10157   CONTINUE
10155   RELOC=0
        GOTO 10159
10154   IF((SYMBOL.NE.4))GOTO 10160
          L=LOCAT0(TOKEN)
          IF((SYMTYP(L).NE.3))GOTO 10161
            VAL=SYMVAL(L)
            SYMVAL(L)=LC
            RELOC=0
            GOTO 10162
10161       VAL=SYMVAL(L)
            RELOC=SYMTYP(L)
10162     CALL GETSYM
          GOTO 10163
10160     EXPR=-3
          CALL ERRMSG('missing expression.')
          VAL=0
          RELOC=0
10164     IF((SYMBOL.EQ.3))GOTO 10165
            CALL GETSYM
          GOTO 10164
10165   CONTINUE
10163 CONTINUE
10159 RETURN
      END
      INTEGER FUNCTION CALLE0(VAL,RELOC)
      INTEGER VAL,RELOC
      INTEGER EXPR
      CALLE0=EXPR(VAL,RELOC)
      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
      COMMON /CCOM/LC,CODE
      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
      COMMON /CCOM/LC,CODE
      INTEGER C
      LOGICAL ALPHA
10166   CALL INCHAR(C)
      IF(((C.EQ.160).OR.(C.EQ.137)))GOTO 10166
      IF((.NOT.ALPHA(C)))GOTO 10167
        CALL PUSHB0(C)
        CALL SCANID
        GOTO 10168
10167   IF(((176.GT.C).OR.(C.GT.185)))GOTO 10169
          CALL PUSHB0(C)
          CALL SCAND0
          GOTO 10170
10169     IF((C.NE.164))GOTO 10171
            CALL SCANH0
            GOTO 10172
10171       IF((C.NE.163))GOTO 10173
              CALL SCANC0
              GOTO 10174
10173         IF(((C.NE.187).AND.(C.NE.138)))GOTO 10175
                IF((C.NE.138))GOTO 10176
                  LCNT=LCNT+1
10176           SYMBOL=3
                GOTO 10177
10175           IF((C.NE.252))GOTO 10178
                  SYMBOL=6
                  GOTO 10179
10178             IF((C.NE.166))GOTO 10180
                    SYMBOL=7
                    GOTO 10181
10180               IF((C.NE.-1))GOTO 10182
                      SYMBOL=2
10182             CONTINUE
10181           CONTINUE
10179         CONTINUE
10177       CONTINUE
10174     CONTINUE
10172   CONTINUE
10170 CONTINUE
10168 RETURN
      END
      SUBROUTINE GETWO0(W)
      INTEGER W
      INTEGER HI,LO
      CALL GETBY0(LO)
      CALL GETBY0(HI)
      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
      COMMON /CCOM/LC,CODE
      INTEGER GETCH
      IF((IBP.LE.0))GOTO 10183
        C=INBUF(IBP)
        GOTO 10184
10183   IBP=1
        INBUF(IBP)=GETCH(C,-10)
10184 IF((C.EQ.-1))GOTO 10185
        IBP=IBP-1
10185 RETURN
      END
      SUBROUTINE INITI0
      INTEGER CREATE
      INTEGER S(4,26)
      INTEGER I,V(26)
      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
      COMMON /CCOM/LC,CODE
      INTEGER CODEF(3)
      DATA CODEF/174,239,0/
      DATA S/225,0,0,0,226,227,0,0,226,0,0,0,227,0,0,0,228,229,0,0,228,0
     *,0,0,229,0,0,0,232,236,0,0,232,0,0,0,236,0,0,0,237,0,0,0,240,243,2
     *47,0,243,240,0,0,193,0,0,0,194,195,0,0,194,0,0,0,195,0,0,0,196,197
     *,0,0,196,0,0,0,197,0,0,0,200,204,0,0,200,0,0,0,204,0,0,0,205,0,0,0
     *,208,211,215,0,211,208,0,0/
      DATA V/7,0,0,1,2,2,3,4,4,5,6,6,6,7,0,0,1,2,2,3,4,4,5,6,6,6/
      CODE=CREATE(CODEF,3)
      IF((CODE.NE.-3))GOTO 10186
        CALL ERROR('can''t open output file.')
10186 LCNT=1
      LC=0
      SYMTOP=0
      IBP=0
      CALL DSINIT(10000)
      CALL GETSYM
      CALL PUTBY0(1)
      I=2
      GOTO 10189
10187 I=I+1
10189 IF((I.GT.3))GOTO 10188
        CALL PUTBY0(0)
      GOTO 10187
10188 I=1
      GOTO 10192
10190 I=I+1
10192 IF((I.GT.26))GOTO 10191
        CALL ENTER(S(1,I),4,V(I))
      GOTO 10190
10191 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
      COMMON /CCOM/LC,CODE
      INTEGER MAPDN
      INTEGER OP,I
      INTEGER PSEUD0,MACHOP
      I=1
      GOTO 10195
10193 I=I+1
10195 IF((TOKEN(I).EQ.0))GOTO 10194
        TOKEN(I)=MAPDN(TOKEN(I))
      GOTO 10193
10194 IF((PSEUD0(TOKEN,OP).NE.1))GOTO 10196
        CALL DOPSE0(OP)
        GOTO 10197
10196   IF((MACHOP(TOKEN,OP).NE.1))GOTO 10198
          CALL DOMACH(OP)
          GOTO 10199
10198     CALL ERRMSG('unrecognized symbol in op field.')
          CALL GETSYM
10199 CONTINUE
10197 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
      COMMON /CCOM/LC,CODE
      INTEGER I
      INTEGER EQUAL
      INTEGER SDUP
      I=1
      GOTO 10202
10200 I=I+1
10202 IF((I.GT.SYMTOP))GOTO 10201
        IF((EQUAL(SYM,MEM(SYMSYM(I))).NE.1))GOTO 10203
          IF((SYMTYP(I).NE.2))GOTO 10204
            LOCAT0=SYMVAL(I)
            GOTO 10205
10204       LOCAT0=I
10205     RETURN
10203 GOTO 10200
10201 IF((SYMTOP.LT.2000))GOTO 10206
        CALL ERRMSG('too many symbols --- assembly stopped.')
        CALL SWT
10206 SYMTOP=SYMTOP+1
      SYMSYM(SYMTOP)=SDUP(SYM)
      SYMTYP(SYMTOP)=3
      SYMVAL(SYMTOP)=-1
      LOCAT0=SYMTOP
      RETURN
      END
      INTEGER FUNCTION MACHOP(TOKEN,OP)
      INTEGER TOKEN(1)
      INTEGER OP
      INTEGER INSTS0(5,83)
      INTEGER TOP,BOTTOM,MIDDLE,COMP
      INTEGER COMPA0
      DATA INSTS0/0,0,0,0,0,225,227,233,0,0,225,228,227,0,0,225,228,228,
     *0,0,225,228,233,0,0,225,238,225,0,0,225,238,233,0,0,227,225,236,23
     *6,0,227,227,0,0,0,227,237,225,0,0,227,237,227,0,0,227,237,240,0,0,
     *227,237,0,0,0,227,238,227,0,0,227,238,250,0,0,227,240,0,0,0,227,24
     *0,229,0,0,227,240,233,0,0,227,240,239,0,0,227,250,0,0,0,228,225,22
     *5,0,0,228,225,228,0,0,228,227,242,0,0,228,227,248,0,0,228,233,0,0,
     *0,229,233,0,0,0,232,229,248,0,0,232,236,244,0,0,233,238,0,0,0,233,
     *238,242,0,0,233,238,248,0,0,234,227,0,0,0,234,237,0,0,0,234,237,24
     *0,0,0,234,238,227,0,0,234,238,250,0,0,234,240,0,0,0,234,240,229,0,
     *0,234,240,239,0,0,234,250,0,0,0,236,228,225,0,0,236,228,225,248,0,
     *236,232,236,228,0,236,248,233,0,0,237,239,246,0,0,237,246,233,0,0,
     *238,239,240,0,0,239,242,225,0,0,239,242,231,0,0,239,242,233,0,0,23
     *9,245,244,0,0,240,227,232,236,0,240,239,240,0,0,240,245,243,232,0,
     *242,225,236,0,0,242,225,242,0,0,242,227,0,0,0,242,229,244,0,0,242,
     *236,227,0,0,242,237,0,0,0,242,238,227,0,0,242,238,250,0,0,242,240,
     *0,0,0,242,240,229,0,0,242,240,239,0,0,242,242,227,0,0,242,243,244,
     *0,0,242,250,0,0,0,243,226,226,0,0,243,226,233,0,0,243,229,244,0,0,
     *243,232,236,228,0,243,240,232,236,0,243,244,225,0,0,243,244,225,24
     *8,0,243,244,227,0,0,243,245,226,0,0,243,245,233,0,0,248,227,232,23
     *1,0,248,242,225,0,0,248,242,233,0,0,248,244,232,236,0,-1,-1,-1,-1,
     *-1/
      TOP=1
      BOTTOM=83
10207   MIDDLE=RS(TOP+BOTTOM,1)
        COMP=COMPA0(TOKEN,INSTS0(1,MIDDLE))
        IF((COMP.LT.0))GOTO 10208
          TOP=MIDDLE+1
10208   IF((COMP.GT.0))GOTO 10209
          BOTTOM=MIDDLE-1
10209 CONTINUE
      IF((TOP.LE.BOTTOM))GOTO 10207
      IF((COMP.NE.0))GOTO 10210
        MACHOP=1
        OP=MIDDLE
        GOTO 10211
10210   MACHOP=0
10211 RETURN
      END
      INTEGER FUNCTION PSEUD0(TOKEN,OP)
      INTEGER TOKEN(1)
      INTEGER OP
      INTEGER BYTEOP(5)
      INTEGER DEFOP(4)
      INTEGER WORDOP(5)
      INTEGER EQUAL
      DATA BYTEOP/226,249,244,229,0/
      DATA DEFOP/228,229,230,0/
      DATA WORDOP/247,239,242,228,0/
      PSEUD0=1
      IF((EQUAL(TOKEN,BYTEOP).NE.1))GOTO 10212
        OP=0
        GOTO 10213
10212   IF((EQUAL(TOKEN,DEFOP).NE.1))GOTO 10214
          OP=1
          GOTO 10215
10214     IF((EQUAL(TOKEN,WORDOP).NE.1))GOTO 10216
            OP=2
            GOTO 10217
10216       PSEUD0=0
10217   CONTINUE
10215 CONTINUE
10213 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
      COMMON /CCOM/LC,CODE
      IBP=IBP+1
      IF((IBP.LE.10))GOTO 10218
        CALL ERRMSG('too many characters pushed back.')
        GOTO 10219
10218   INBUF(IBP)=C
10219 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
      COMMON /CCOM/LC,CODE
      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
      COMMON /CCOM/LC,CODE
      INTEGER WORD,MASK
      WORD=ADDRE0/8+1
      MASK=LS(1,7-MOD(ADDRE0,8))
      IF((RELOC.NE.1))GOTO 10220
        RMAP(WORD)=OR(RMAP(WORD),MASK)
        GOTO 10221
10220   RMAP(WORD)=AND(RMAP(WORD),NOT(MASK))
10221 RETURN
      END
      SUBROUTINE PUTWO0(W)
      INTEGER W
      CALL PUTBY0(RT(W,8))
      CALL PUTBY0(RS(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
      COMMON /CCOM/LC,CODE
      INTEGER C
10222   CALL INCHAR(C)
      IF((C.NE.138))GOTO 10222
      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
      COMMON /CCOM/LC,CODE
      INTEGER DEC(11)
      INTEGER C
      INTEGER I
      INTEGER INDEX
      DATA DEC/176,177,178,179,180,181,182,183,184,185,0/
      CONST0=0
10223   CALL INCHAR(C)
        I=INDEX(DEC,C)
        IF((I.GE.1))GOTO 10224
          CALL PUSHB0(C)
          GOTO 10225
10224   CONST0=10*CONST0+I-1
      GOTO 10223
10225 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
      COMMON /CCOM/LC,CODE
      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
10226   CALL INCHAR(C)
        I=INDEX(HEX,MAPDN(C))
        IF((I.GE.1))GOTO 10227
          CALL PUSHB0(C)
          GOTO 10228
10227   CONST0=LS(CONST0,4)+I-1
      GOTO 10226
10228 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
      COMMON /CCOM/LC,CODE
      INTEGER I
      INTEGER C
      LOGICAL ALPHA
      I=1
10229   CALL INCHAR(C)
        IF((ALPHA(C).OR.((C.GE.176).AND.(C.LE.185))))GOTO 10230
          GOTO 10231
10230   TOKEN(I)=C
        I=I+1
      GOTO 10229
10231 TOKEN(I)=0
      IF((C.NE.186))GOTO 10232
        SYMBOL=5
        GOTO 10233
10232   CALL PUSHB0(C)
        SYMBOL=4
10233 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
      COMMON /CCOM/LC,CODE
      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
      COMMON /CCOM/LC,CODE
      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
      COMMON /CCOM/LC,CODE
      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
C ---- Long Name Map ----
C putbyte                        putby0
C symbrlist                      symbr0
C instruction                    instr0
C chainback                      chain0
C scancomment                    scanc0
C address                        addre0
C compare                        compa0
C constval                       const0
C cleanup                        clean0
C putword                        putwo0
C operator                       opera0
C scanhex                        scanh0
C pseudoop                       pseud0
C cputbyte                       cputb0
C getbyte                        getby0
C cputword                       cputw0
C pushback                       pushb0
C getword                        getwo0
C scandec                        scand0
C instructions                   insts0
C initialize                     initi0
C location                       locat0
C callexpr                       calle0
C seekend                        seeke0
C dopseudo                       dopse0
