      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER A$BUF(200)
      INTEGER DEFN(400),T,TOKEN(102)
      INTEGER GETTOK
      INTEGER AP,ARGSTK(100),CALLST(20),NLB,PLEV(20)
      INTEGER LOOKUP,PUSH
      INTEGER TABLE(32000)
      COMMON /DS$MEM/TABLE
      INTEGER DEFTYP(2),INCTYP(2),SUBTYP(2),IFTYP(2),INCLT0(2),DIVTYP(2)
     *,DNLTYP(2),UNDEF0(2)
      INTEGER PARSCL
      INTEGER AAAAA0(5)
      INTEGER AAAAB0(18)
      INTEGER AAAAC0(7)
      INTEGER AAAAD0(5)
      INTEGER AAAAE0(7)
      INTEGER AAAAF0(7)
      INTEGER AAAAG0(5)
      INTEGER AAAAH0(7)
      INTEGER AAAAI0(4)
      INTEGER AAAAJ0(9)
      INTEGER AAAAK0(3)
      DATA DEFTYP/-10,0/,INCTYP/-12,0/,SUBTYP/-13,0/,IFTYP/-11,0/,INCLT0
     */-14,0/,DIVTYP/-15,0/,DNLTYP/-16,0/,UNDEF0/-17,0/
      DATA AAAAA0/219,173,229,221,0/
      DATA AAAAB0/213,243,225,231,229,186,160,237,225,227,242,239,160,21
     *9,173,229,221,0/
      DATA AAAAC0/228,229,230,233,238,229,0/
      DATA AAAAD0/233,238,227,242,0/
      DATA AAAAE0/243,245,226,243,244,242,0/
      DATA AAAAF0/233,230,229,236,243,229,0/
      DATA AAAAG0/233,238,227,236,0/
      DATA AAAAH0/228,233,246,229,242,244,0/
      DATA AAAAI0/228,238,236,0/
      DATA AAAAJ0/245,238,228,229,230,233,238,229,0/
      DATA AAAAK0/168,169,0/
      IF((PARSCL(AAAAA0,A$BUF).NE.-3))GOTO 10000
        CALL ERROR(AAAAB0)
10000 BP=0
      LASTP=0
      CALL DSINIT(32000)
      IFP=1
      IFST(IFP)=-10
      OFP=1
      OFST(OFP)=-11
      CALL INSTAL(AAAAC0,DEFTYP)
      CALL INSTAL(AAAAD0,INCTYP)
      CALL INSTAL(AAAAE0,SUBTYP)
      CALL INSTAL(AAAAF0,IFTYP)
      CALL INSTAL(AAAAG0,INCLT0)
      CALL INSTAL(AAAAH0,DIVTYP)
      CALL INSTAL(AAAAI0,DNLTYP)
      CALL INSTAL(AAAAJ0,UNDEF0)
      CP=0
      AP=1
      EP=1
      T=GETTOK(TOKEN,102)
      GOTO 10003
10001 T=GETTOK(TOKEN,102)
10003 IF((T.EQ.-1))GOTO 10002
        IF((T.NE.-100))GOTO 10004
          IF((LOOKUP(TOKEN,DEFN).NE.0))GOTO 10005
            CALL PUTTOK(TOKEN)
            GOTO 10006
10005       CP=CP+(1)
            IF((CP.LE.20))GOTO 10007
              CALL ERROR('call stack overflow.')
10007       CALLST(CP)=AP
            AP=PUSH(EP,ARGSTK,AP)
            CALL PUTTOK(DEFN)
            CALL PUTCHR(0)
            AP=PUSH(EP,ARGSTK,AP)
            CALL PUTTOK(TOKEN)
            CALL PUTCHR(0)
            AP=PUSH(EP,ARGSTK,AP)
            T=GETTOK(TOKEN,102)
            CALL PBSTR(TOKEN)
            IF((T.EQ.168))GOTO 10008
              CALL PBSTR(AAAAK0)
10008       PLEV(CP)=0
10006     GOTO 10009
10004     IF((T.NE.219))GOTO 10010
            NLB=1
10011         T=GETTOK(TOKEN,102)
              IF((T.NE.219))GOTO 10012
                NLB=NLB+(1)
                GOTO 10013
10012           IF((T.NE.221))GOTO 10014
                  NLB=NLB-(1)
                  IF((NLB.NE.0))GOTO 10015
                    GOTO 10016
10015             GOTO 10017
10014             IF((T.NE.-1))GOTO 10018
                    CALL ERROR('EOF in string.')
10018           CONTINUE
10017         CONTINUE
10013         CALL PUTTOK(TOKEN)
            GOTO 10011
10016       GOTO 10019
10010       IF((CP.NE.0))GOTO 10020
              CALL PUTTOK(TOKEN)
              GOTO 10021
10020         IF((T.NE.168))GOTO 10022
                IF((PLEV(CP).LE.0))GOTO 10023
                  CALL PUTTOK(TOKEN)
10023           PLEV(CP)=PLEV(CP)+(1)
                GOTO 10024
10022           IF((T.NE.169))GOTO 10025
                  PLEV(CP)=PLEV(CP)-(1)
                  IF((PLEV(CP).LE.0))GOTO 10026
                    CALL PUTTOK(TOKEN)
                    GOTO 10027
10026               CALL PUTCHR(0)
                    CALL EVAL(ARGSTK,CALLST(CP),AP-1)
                    AP=CALLST(CP)
                    EP=ARGSTK(AP)
                    CP=CP-(1)
10027             GOTO 10028
10025             IF((T.NE.172))GOTO 10029
                  IF((PLEV(CP).NE.1))GOTO 10029
                    CALL PUTCHR(0)
                    AP=PUSH(EP,ARGSTK,AP)
                    GOTO 10030
10029               IF((T.NE.192))GOTO 10031
                    IF((A$BUF(229-225+1).EQ.0))GOTO 10031
                      CALL NGETC(T)
                      CALL PUTCHR(T)
                      GOTO 10032
10031                 CALL PUTTOK(TOKEN)
10032             CONTINUE
10030           CONTINUE
10028         CONTINUE
10024       CONTINUE
10021     CONTINUE
10019   CONTINUE
10009 GOTO 10001
10002 IF((CP.EQ.0))GOTO 10033
        CALL ERROR('unexpected EOF.')
10033 GOTO 10036
10034 OFP=OFP-(1)
10036 IF((OFP.LE.1))GOTO 10035
        CALL CLOSE(OFST(OFP))
      GOTO 10034
10035 GOTO 10039
10037 IFP=IFP-(1)
10039 IF((IFP.LE.1))GOTO 10038
        CALL CLOSE(IFST(IFP))
      GOTO 10037
10038 CALL SWT
      END
      INTEGER FUNCTION GETTOK(TOKEN,TOKSIZ)
      INTEGER TOKSIZ
      INTEGER TOKEN(TOKSIZ)
      INTEGER I
      INTEGER NGETC,TYPE
      I=1
      GOTO 10042
10040 I=I+(1)
10042 IF((I.GE.TOKSIZ))GOTO 10041
        GETTOK=TYPE(NGETC(TOKEN(I)))
        IF((GETTOK.EQ.225))GOTO 10043
        IF((GETTOK.EQ.176))GOTO 10043
        IF((GETTOK.EQ.223))GOTO 10043
          GOTO 10041
10043 GOTO 10040
10041 IF((I.LT.TOKSIZ))GOTO 10044
        CALL ERROR('token too long.')
10044 IF((I.LE.1))GOTO 10045
        CALL PUTBAK(TOKEN(I))
        I=I-(1)
        GETTOK=-100
10045 TOKEN(I+1)=0
      RETURN
      END
      INTEGER FUNCTION LOOKUP(NAME,DEFN)
      INTEGER NAME(102),DEFN(400)
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER I,J,K
      INTEGER TABLE(32000)
      COMMON /DS$MEM/TABLE
      I=LASTP
      GOTO 10048
10046 I=I-(1)
10048 IF((I.LE.0))GOTO 10047
        J=NAMPTR(I)
        K=1
        GOTO 10051
10049   K=K+(1)
10051   IF((NAME(K).NE.TABLE(J)))GOTO 10050
        IF((NAME(K).EQ.0))GOTO 10050
          J=J+(1)
        GOTO 10049
10050   IF((NAME(K).NE.TABLE(J)))GOTO 10052
          CALL SCOPY(TABLE,J+1,DEFN,1)
          LOOKUP=1
          RETURN
10052 GOTO 10046
10047 LOOKUP=0
      RETURN
      END
      SUBROUTINE INSTAL(NAME,DEFN)
      INTEGER NAME(102),DEFN(400)
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER TABLE(32000)
      COMMON /DS$MEM/TABLE
      INTEGER NLEN
      INTEGER LENGTH
      INTEGER P
      INTEGER DSGET
      CALL UNINS0(NAME)
      IF((LASTP.LT.500))GOTO 10053
        CALL PUTLIN(NAME,-15)
        CALL REMARK(': too many definitions.')
        RETURN
10053 NLEN=LENGTH(NAME)+1
      P=DSGET(NLEN+LENGTH(DEFN)+1)
      LASTP=LASTP+1
      NAMPTR(LASTP)=P
      CALL SCOPY(NAME,1,TABLE,P)
      CALL SCOPY(DEFN,1,TABLE,P+NLEN)
      RETURN
      END
      INTEGER FUNCTION PUSH(EP,ARGSTK,AP)
      INTEGER EP,ARGSTK(100),AP
      IF((AP.LE.100))GOTO 10054
        CALL ERROR('arg stack overflow.')
10054 ARGSTK(AP)=EP
      PUSH=AP+1
      RETURN
      END
      SUBROUTINE PUTTOK(STR)
      INTEGER STR(102)
      INTEGER I
      I=1
      GOTO 10057
10055 I=I+(1)
10057 IF((STR(I).EQ.0))GOTO 10056
        CALL PUTCHR(STR(I))
      GOTO 10055
10056 RETURN
      END
      SUBROUTINE PUTCHR(C)
      INTEGER C
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      IF((CP.NE.0))GOTO 10058
        CALL PUTCH(C,OFST(OFP))
        GOTO 10059
10058   IF((EP.LE.2000))GOTO 10060
          CALL ERROR('evaluation stack overflow.')
10060   EVALST(EP)=C
        EP=EP+(1)
10059 RETURN
      END
      SUBROUTINE EVAL(ARGSTK,I,J)
      INTEGER ARGSTK(100),I,J
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER ARGNO,K,M,N,T
      INTEGER INDEX,LENGTH
      INTEGER AAAAL0
      INTEGER AAAAM0
      INTEGER AAAAN0(11)
      DATA AAAAN0/176,177,178,179,180,181,182,183,184,185,0/
      T=ARGSTK(I)
      AAAAL0=EVALST(T)
      GOTO 10061
10062   CALL DODEF(ARGSTK,I,J)
      GOTO 10063
10064   CALL DOINCR(ARGSTK,I,J)
      GOTO 10063
10065   CALL DOSUB(ARGSTK,I,J)
      GOTO 10063
10066   CALL DOIF(ARGSTK,I,J)
      GOTO 10063
10067   CALL DOINC0(ARGSTK,I,J)
      GOTO 10063
10068   CALL DODIV0(ARGSTK,I,J)
      GOTO 10063
10069   CALL DODNL
      GOTO 10063
10070   CALL DOUND0(ARGSTK,I,J)
      GOTO 10063
10061 AAAAM0=AAAAL0+18
      GOTO(10070,10069,10068,10067,10065,10064,10066,10062),AAAAM0
        K=T+LENGTH(EVALST(T))-1
        GOTO 10073
10071   K=K-(1)
10073   IF((K.LE.T))GOTO 10072
          IF((EVALST(K-1).EQ.164))GOTO 10074
            CALL PUTBAK(EVALST(K))
            GOTO 10075
10074       IF((EVALST(K).NE.164))GOTO 10076
              CALL PUTBAK(164)
              K=K-(1)
              GOTO 10077
10076         ARGNO=INDEX(AAAAN0,EVALST(K))-1
              IF((ARGNO.LT.0))GOTO 10078
              IF((ARGNO.GE.J-I))GOTO 10078
                N=I+ARGNO+1
                M=ARGSTK(N)
                CALL PBSTR(EVALST(M))
10078         K=K-(1)
10077     CONTINUE
10075   GOTO 10071
10072   IF((K.NE.T))GOTO 10079
          CALL PUTBAK(EVALST(K))
10079 CONTINUE
10063 RETURN
      END
      SUBROUTINE DODEF(ARGSTK,I,J)
      INTEGER ARGSTK(100),I,J
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER A2,A3
      IF((J-I.LE.2))GOTO 10080
        A2=ARGSTK(I+2)
        A3=ARGSTK(I+3)
        CALL INSTAL(EVALST(A2),EVALST(A3))
10080 RETURN
      END
      SUBROUTINE DOINCR(ARGSTK,I,J)
      INTEGER ARGSTK(100),I,J
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER K
      INTEGER CTOI
      K=ARGSTK(I+2)
      CALL PBNUM(CTOI(EVALST,K)+1)
      RETURN
      END
      SUBROUTINE PBNUM(N)
      INTEGER N
      INTEGER M,NUM
      INTEGER MOD
      INTEGER DIGITS(11)
      DATA DIGITS/176,177,178,179,180,181,182,183,184,185,0/
      NUM=N
10081   M=MOD(NUM,10)
        CALL PUTBAK(DIGITS(M+1))
        NUM=NUM/10
      IF((NUM.NE.0))GOTO 10081
      RETURN
      END
      SUBROUTINE DOSUB(ARGSTK,I,J)
      INTEGER ARGSTK(100),I,J
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER AP,FC,K,NC
      INTEGER CTOI,LENGTH,MIN0
      IF((J-I.GE.3))GOTO 10082
        RETURN
10082 IF((J-I.GE.4))GOTO 10083
        NC=102
        GOTO 10084
10083   K=ARGSTK(I+4)
        NC=CTOI(EVALST,K)
10084 K=ARGSTK(I+3)
      AP=ARGSTK(I+2)
      FC=AP+CTOI(EVALST,K)-1
      IF((FC.LT.AP))GOTO 10085
      IF((FC.GE.AP+LENGTH(EVALST(AP))))GOTO 10085
        K=FC+MIN0(NC,LENGTH(EVALST(FC)))-1
        GOTO 10088
10086   K=K-(1)
10088   IF((K.LT.FC))GOTO 10087
          CALL PUTBAK(EVALST(K))
        GOTO 10086
10087 CONTINUE
10085 RETURN
      END
      SUBROUTINE DOIF(ARGSTK,I,J)
      INTEGER ARGSTK(100),I,J
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER A2,A3,A4,A5
      INTEGER EQUAL
      IF((J-I.GE.5))GOTO 10089
        RETURN
10089 A2=ARGSTK(I+2)
      A3=ARGSTK(I+3)
      A4=ARGSTK(I+4)
      A5=ARGSTK(I+5)
      IF((EQUAL(EVALST(A2),EVALST(A3)).NE.1))GOTO 10090
        CALL PBSTR(EVALST(A4))
        GOTO 10091
10090   CALL PBSTR(EVALST(A5))
10091 RETURN
      END
      INTEGER FUNCTION NGETC(C)
      INTEGER C
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER GETCH
      IF((BP.LE.0))GOTO 10092
        C=BUF(BP)
        GOTO 10093
10092   BP=1
10094     BUF(BP)=GETCH(C,IFST(IFP))
          IF((IFP.EQ.1))GOTO 10096
          IF((C.NE.-1))GOTO 10096
          GOTO 10095
10096       GOTO 10097
10095     CALL CLOSE(IFST(IFP))
          IFP=IFP-(1)
        GOTO 10094
10097 CONTINUE
10093 IF((C.EQ.-1))GOTO 10098
        BP=BP-(1)
10098 NGETC=C
      RETURN
      END
      SUBROUTINE PBSTR(IN)
      INTEGER IN(102)
      INTEGER I
      INTEGER LENGTH
      I=LENGTH(IN)
      GOTO 10101
10099 I=I-(1)
10101 IF((I.LE.0))GOTO 10100
        CALL PUTBAK(IN(I))
      GOTO 10099
10100 RETURN
      END
      SUBROUTINE PUTBAK(C)
      INTEGER C
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      BP=BP+(1)
      IF((BP.LE.500))GOTO 10102
        CALL ERROR('too many characters pushed back.')
10102 BUF(BP)=C
      RETURN
      END
      SUBROUTINE DOINC0(ARGSTK,I,J)
      INTEGER I,J,ARGSTK(100)
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER FD,NM
      INTEGER OPEN
      IF((J-I.GE.2))GOTO 10103
        RETURN
10103 NM=ARGSTK(I+2)
      FD=OPEN(EVALST(NM),1)
      IF((FD.NE.-3))GOTO 10104
        CALL PUTLIN(EVALST(NM),-15)
        CALL REMARK(': can''t open include.')
        GOTO 10105
10104   IFP=IFP+(1)
        IFST(IFP)=FD
10105 RETURN
      END
      SUBROUTINE DODIV0(ARGSTK,I,J)
      INTEGER I,J,ARGSTK(100)
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER FD,NM
      INTEGER OPEN,CREATE
      NM=ARGSTK(I+2)
      IF((EVALST(NM).NE.0))GOTO 10106
        IF((OFP.LE.1))GOTO 10107
          CALL CLOSE(OFST(OFP))
          OFP=OFP-(1)
10107   RETURN
10106 IF((OFP.LT.10))GOTO 10108
        CALL PUTLIN(EVALST(NM),-15)
        CALL REMARK(': too many output files.')
        RETURN
10108 IF((J-I.NE.2))GOTO 10109
        FD=CREATE(EVALST(NM),3)
        GOTO 10110
10109   FD=OPEN(EVALST(NM),3)
10110 IF((FD.NE.-3))GOTO 10111
        CALL PUTLIN(EVALST(NM),-15)
        CALL REMARK(': can''t open for output.')
        GOTO 10112
10111   CALL WIND(FD)
        OFP=OFP+(1)
        OFST(OFP)=FD
10112 RETURN
      END
      SUBROUTINE DODNL
      INTEGER C
      INTEGER NGETC
10113   C=NGETC(C)
      IF((C.EQ.160))GOTO 10113
      IF((C.EQ.137))GOTO 10113
      IF((C.EQ.138))GOTO 10114
        CALL PUTBAK(C)
10114 RETURN
      END
      SUBROUTINE UNINS0(NAME)
      INTEGER NAME(102)
      INTEGER TABLE(32000)
      COMMON /DS$MEM/TABLE
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER I,J,K
      INTEGER EQUAL
      I=LASTP
      GOTO 10117
10115 I=I-(1)
10117 IF((I.LE.0))GOTO 10116
        J=NAMPTR(I)
        IF((EQUAL(TABLE(J),NAME).NE.1))GOTO 10118
          CALL DSFREE(NAMPTR(I))
          K=I+1
          GOTO 10121
10119     K=K+(1)
10121     IF((K.GT.LASTP))GOTO 10120
            NAMPTR(K-1)=NAMPTR(K)
          GOTO 10119
10120     LASTP=LASTP-(1)
          RETURN
10118 GOTO 10115
10116 RETURN
      END
      SUBROUTINE DOUND0(ARGSTK,I,J)
      INTEGER I,J,ARGSTK(100)
      COMMON /CDEFIO/BP,BUF(500),IFP,IFST(10),OFP,OFST(10)
      INTEGER BP
      INTEGER BUF
      INTEGER IFP
      INTEGER IFST
      INTEGER OFP
      INTEGER OFST
      COMMON /CLOOK/LASTP,NAMPTR(500)
      INTEGER LASTP
      INTEGER NAMPTR
      COMMON /CMACRO/CP,EP,EVALST(2000)
      INTEGER CP
      INTEGER EP
      INTEGER EVALST
      INTEGER NAM
      NAM=ARGSTK(I+2)
      CALL UNINS0(EVALST(NAM))
      RETURN
      END
C ---- Long Name Map ----
C doundef                        dound0
C uninstal                       unins0
C undeftyp                       undef0
C incltyp                        inclt0
C doinclude                      doinc0
C dodivert                       dodiv0
