SUBROUTINE MAIN
      LOGICAL*1 GTOKEN
      LOGICAL*1 DEFN(200), T, TOKEN(100)
      INTEGER TBLOOK, PUSH
      INTEGER AP, ARGSTK(100), CALLST(130), NLB, PLEV(130)
      INTEGER INT
      COMMON /CMACRO/ CP, EP, EVALST(500)
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      LOGICAL*1 BALP(3)
      LOGICAL*1 DEFNAM(7)
      LOGICAL*1 INCNAM(5)
      LOGICAL*1 SUBNAM(7)
      LOGICAL*1 IFNAM(7)
      LOGICAL*1 ARNAM(6)
      INTEGER DEFTYP(2)
      INTEGER INCTYP(2)
      INTEGER SUBTYP(2)
      INTEGER IFTYP(2)
      INTEGER ARTYP(2)
      INTEGER GETARG, I, OPEN
      LOGICAL*1 FILE(512)
      INTEGER MEM(5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      INTEGER PBP, PBSIZE
      LOGICAL*1 PBBUF(512)
      COMMON/CPBACK/PBP, PBSIZE, PBBUF
      DATA BALP(1) /40/, BALP(2) /41/, BALP(3) /0/
      DATA DEFNAM(1) /100/, DEFNAM(2) /101/, DEFNAM(3) /102/
      DATA DEFNAM(4) /105/, DEFNAM(5) /110/, DEFNAM(6) /101/
      DATA DEFNAM(7) /0/
      DATA INCNAM(1)/105/,INCNAM(2)/110/,INCNAM(3)/99/,INCNAM(4)/114/
      DATA INCNAM(5) /0/
      DATA SUBNAM(1) /115/, SUBNAM(2) /117/, SUBNAM(3) /98/
      DATA SUBNAM(4) /115/, SUBNAM(5) /116/, SUBNAM(6) /114/
      DATA SUBNAM(7) /0/
      DATA IFNAM(1) /105/, IFNAM(2) /102/, IFNAM(3) /101/
      DATA IFNAM(4) /108/, IFNAM(5) /115/, IFNAM(6) /101/
      DATA IFNAM(7) /0/
      DATA DEFTYP(1) /-4/, DEFTYP(2) /0/
      DATA INCTYP(1) /-12/, INCTYP(2) /0/
      DATA SUBTYP(1) /-13/, SUBTYP(2) /0/
      DATA IFTYP(1) /-11/, IFTYP(2) /0/
      DATA ARTYP(1) /-14/, ARTYP(2) /0/
      DATA ARNAM(1) /97/, ARNAM(2) /114/, ARNAM(3) /105/, ARNAM(4) /116/
     *, ARNAM(5) /104/, ARNAM(6) /0/
      CALL QUERY(24Husage:  macro [file] ...)
      CALL TBINIT(5000)
      CALL PBINIT(512)
      CALL TBINST(DEFNAM, DEFTYP)
      CALL TBINST(INCNAM, INCTYP)
      CALL TBINST(SUBNAM, SUBTYP)
      CALL TBINST(IFNAM, IFTYP)
      CALL TBINST(ARNAM, ARTYP)
      I=1
23000 CONTINUE
      IF (.NOT.(GETARG(I, FILE, 512) .EQ. -1))GOTO 23003
      IF (.NOT.(I .NE. 1))GOTO 23005
      GOTO 23002
23005 CONTINUE
      INT = 1
      GOTO 23004
23003 CONTINUE
      IF (.NOT.(FILE(1) .EQ. 45 .AND. FILE(2) .EQ. 0))GOTO 23007
      INT = 1
      GOTO 23008
23007 CONTINUE
      INT = OPEN(FILE, 1)
      IF (.NOT.(INT .EQ. -3))GOTO 23009
      CALL CANT (FILE)
23009 CONTINUE
23008 CONTINUE
23004 CONTINUE
      BP = 0
      CP = 0
      AP = 1
      EP = 1
      T=GTOKEN(TOKEN, 100, INT)
23011 IF (.NOT.(T.NE. -1))GOTO 23013
      IF (.NOT.(T .EQ. -9))GOTO 23014
      IF (.NOT.(TBLOOK(TOKEN, DEFN) .EQ. 0))GOTO 23016
      CALL PUTTOK(TOKEN)
      GOTO 23017
23016 CONTINUE
      CP = CP + 1
      IF (.NOT.(CP .GT. 130))GOTO 23018
      CALL ERROR(20Hcall stack overflow.)
23018 CONTINUE
      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 = GTOKEN(TOKEN, 100, INT)
      CALL PBSTR(TOKEN)
      IF (.NOT.(T .NE. 40))GOTO 23020
      CALL PBSTR(BALP)
23020 CONTINUE
      PLEV(CP) = 0
23017 CONTINUE
      GOTO 23015
23014 CONTINUE
      IF (.NOT.(T .EQ. 91))GOTO 23022
      NLB = 1
23024 CONTINUE
      T = GTOKEN(TOKEN, 100, INT)
      IF (.NOT.(T .EQ. 91))GOTO 23027
      NLB = NLB + 1
      GOTO 23028
23027 CONTINUE
      IF (.NOT.(T .EQ. 93))GOTO 23029
      NLB = NLB - 1
      IF (.NOT.(NLB .EQ. 0))GOTO 23031
      GOTO 23026
23031 CONTINUE
      GOTO 23030
23029 CONTINUE
      IF (.NOT.(T .EQ. -1))GOTO 23033
      CALL ERROR(14HEOF in string.)
23033 CONTINUE
23030 CONTINUE
23028 CONTINUE
      CALL PUTTOK(TOKEN)
23025 GOTO 23024
23026 CONTINUE
      GOTO 23023
23022 CONTINUE
      IF (.NOT.(CP .EQ. 0))GOTO 23035
      CALL PUTTOK(TOKEN)
      GOTO 23036
23035 CONTINUE
      IF (.NOT.(T .EQ. 40))GOTO 23037
      IF (.NOT.(PLEV(CP) .GT. 0))GOTO 23039
      CALL PUTTOK(TOKEN)
23039 CONTINUE
      PLEV(CP) = PLEV(CP) + 1
      GOTO 23038
23037 CONTINUE
      IF (.NOT.(T .EQ. 41))GOTO 23041
      PLEV(CP) = PLEV(CP) - 1
      IF (.NOT.(PLEV(CP) .GT. 0))GOTO 23043
      CALL PUTTOK(TOKEN)
      GOTO 23044
23043 CONTINUE
      CALL PUTCHR(0)
      CALL EVAL(ARGSTK, CALLST(CP), AP-1)
      AP = CALLST(CP)
      EP = ARGSTK(AP)
      CP = CP - 1
23044 CONTINUE
      GOTO 23042
23041 CONTINUE
      IF (.NOT.(T .EQ. 44 .AND. PLEV(CP) .EQ. 1))GOTO 23045
      CALL PUTCHR(0)
      AP = PUSH(EP, ARGSTK, AP)
      GOTO 23046
23045 CONTINUE
      CALL PUTTOK(TOKEN)
23046 CONTINUE
23042 CONTINUE
23038 CONTINUE
23036 CONTINUE
23023 CONTINUE
23015 CONTINUE
23012 T=GTOKEN(TOKEN, 100, INT)
      GOTO 23011
23013 CONTINUE
      IF (.NOT.(CP .NE. 0))GOTO 23047
      CALL ERROR(15Hunexpected EOF.)
23047 CONTINUE
      IF (.NOT.(INT .NE. 1))GOTO 23049
      CALL CLOSE(INT)
23049 CONTINUE
23001 I=I+1
      GOTO 23000
23002 CONTINUE
      RETURN
      END
      SUBROUTINE DOARTH(ARGSTK,I,J)
      INTEGER CTOI
      INTEGER ARGSTK(100), I, J, K, L
      LOGICAL*1 OP
      COMMON /CMACRO/ CP, EP, EVALST(500)
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      K = ARGSTK(I+2)
      L = ARGSTK(I+4)
      OP = EVALST(ARGSTK(I+3))
      IF (.NOT.(OP .EQ. 43))GOTO 23051
      CALL PBNUM(CTOI(EVALST,K)+CTOI(EVALST,L))
      GOTO 23052
23051 CONTINUE
      IF (.NOT.(OP .EQ. 45))GOTO 23053
      CALL PBNUM(CTOI(EVALST,K)-CTOI(EVALST,L))
      GOTO 23054
23053 CONTINUE
      IF (.NOT.(OP .EQ. 42 ))GOTO 23055
      CALL PBNUM(CTOI(EVALST,K)*CTOI(EVALST,L))
      GOTO 23056
23055 CONTINUE
      IF (.NOT.(OP .EQ. 47 ))GOTO 23057
      CALL PBNUM(CTOI(EVALST,K)/CTOI(EVALST,L))
      GOTO 23058
23057 CONTINUE
      CALL REMARK(11Harith error)
23058 CONTINUE
23056 CONTINUE
23054 CONTINUE
23052 CONTINUE
      RETURN
      END
      SUBROUTINE DODEF(ARGSTK, I, J)
      INTEGER A2, A3, ARGSTK(100), I, J
      COMMON /CMACRO/ CP, EP, EVALST(500)
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      IF (.NOT.(J - I .GT. 2))GOTO 23059
      A2 = ARGSTK(I+2)
      A3 = ARGSTK(I+3)
      CALL TBINST(EVALST(A2), EVALST(A3))
23059 CONTINUE
      RETURN
      END
      SUBROUTINE DOIF(ARGSTK, I, J)
      INTEGER EQUAL
      INTEGER A2, A3, A4, A5, ARGSTK(100), I, J
      COMMON /CMACRO/ CP, EP, EVALST(500)
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      IF (.NOT.(J - I .LT. 5))GOTO 23061
      RETURN
23061 CONTINUE
      A2 = ARGSTK(I+2)
      A3 = ARGSTK(I+3)
      A4 = ARGSTK(I+4)
      A5 = ARGSTK(I+5)
      IF (.NOT.(EQUAL(EVALST(A2), EVALST(A3)) .EQ. 1))GOTO 23063
      CALL PBSTR(EVALST(A4))
      GOTO 23064
23063 CONTINUE
      CALL PBSTR(EVALST(A5))
23064 CONTINUE
      RETURN
      END
      SUBROUTINE DOINCR(ARGSTK, I, J)
      INTEGER CTOI
      INTEGER ARGSTK(100), I, J, K
      COMMON /CMACRO/ CP, EP, EVALST(500)
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      K = ARGSTK(I+2)
      CALL PBNUM(CTOI(EVALST, K)+1)
      RETURN
      END
      SUBROUTINE DOSUB(ARGSTK, I, J)
      INTEGER CTOI, LENGTH
      INTEGER AP, ARGSTK(100), FC, I, J, K, NC
      COMMON /CMACRO/ CP, EP, EVALST(500)
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      IF (.NOT.(J - I .LT. 3))GOTO 23065
      RETURN
23065 CONTINUE
      IF (.NOT.(J - I .LT. 4))GOTO 23067
      NC = 100
      GOTO 23068
23067 CONTINUE
      K = ARGSTK(I+4)
      NC = CTOI(EVALST, K)
23068 CONTINUE
      K = ARGSTK(I+3)
      AP = ARGSTK(I+2)
      FC = AP + CTOI(EVALST, K) - 1
      IF (.NOT.(FC .GE. AP .AND. FC .LT. AP + LENGTH(EVALST(AP))))GOTO 2
     *3069
      K = FC + MIN0(NC, LENGTH(EVALST(FC))) - 1
23071 IF (.NOT.(K .GE. FC))GOTO 23073
      CALL PUTBAK(EVALST(K))
23072 K = K - 1
      GOTO 23071
23073 CONTINUE
23069 CONTINUE
      RETURN
      END
      SUBROUTINE EVAL(ARGSTK, I, J)
      INTEGER INDEXC, LENGTH
      INTEGER ARGNO, ARGSTK(100), I, J, K, M, N, T, TD
      COMMON /CMACRO/ CP, EP, EVALST(500)
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      LOGICAL*1 DIGITS(11)
      DATA DIGITS(1) /48/
      DATA DIGITS(2) /49/
      DATA DIGITS(3) /50/
      DATA DIGITS(4) /51/
      DATA DIGITS(5) /52/
      DATA DIGITS(6) /53/
      DATA DIGITS(7) /54/
      DATA DIGITS(8) /55/
      DATA DIGITS(9) /56/
      DATA DIGITS(10) /57/
      DATA DIGITS(11) /0/
      T = ARGSTK(I)
      TD = EVALST(T)
      IF (.NOT.(TD .EQ. -4))GOTO 23074
      CALL DODEF(ARGSTK, I, J)
      GOTO 23075
23074 CONTINUE
      IF (.NOT.(TD .EQ. -12))GOTO 23076
      CALL DOINCR(ARGSTK, I, J)
      GOTO 23077
23076 CONTINUE
      IF (.NOT.(TD .EQ. -13))GOTO 23078
      CALL DOSUB(ARGSTK, I, J)
      GOTO 23079
23078 CONTINUE
      IF (.NOT.(TD .EQ. -11))GOTO 23080
      CALL DOIF(ARGSTK, I, J)
      GOTO 23081
23080 CONTINUE
      IF (.NOT.(TD .EQ. -14))GOTO 23082
      CALL DOARTH(ARGSTK, I, J)
      GOTO 23083
23082 CONTINUE
      K = T+LENGTH(EVALST(T))-1
23084 IF (.NOT.(K .GT. T))GOTO 23086
      IF (.NOT.(EVALST(K-1) .NE. 36))GOTO 23087
      CALL PUTBAK(EVALST(K))
      GOTO 23088
23087 CONTINUE
      ARGNO = INDEXC(DIGITS, EVALST(K)) - 1
      IF (.NOT.(ARGNO .GE. 0 .AND. ARGNO .LT. J-I))GOTO 23089
      N = I + ARGNO + 1
      M = ARGSTK(N)
      CALL PBSTR(EVALST(M))
23089 CONTINUE
      K = K - 1
23088 CONTINUE
23085 K = K - 1
      GOTO 23084
23086 CONTINUE
      IF (.NOT.(K .EQ. T))GOTO 23091
      CALL PUTBAK(EVALST(K))
23091 CONTINUE
23083 CONTINUE
23081 CONTINUE
23079 CONTINUE
23077 CONTINUE
23075 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION GTOKEN(TOKEN, TOKSIZ, INT)
      LOGICAL*1 NGETC, TYPE
      INTEGER I, TOKSIZ, INT
      LOGICAL*1 TOKEN (TOKSIZ)
      I=1
23093 IF (.NOT.(I.LT.TOKSIZ))GOTO 23095
      GTOKEN = TYPE( NGETCH(TOKEN(I), INT))
      IF (.NOT.(GTOKEN .NE. 1 .AND. GTOKEN .NE. 2))GOTO 23096
      GOTO 23095
23096 CONTINUE
23094 I=I+1
      GOTO 23093
23095 CONTINUE
      IF (.NOT.(I .GE. TOKSIZ))GOTO 23098
      CALL ERROR (15Htoken too long.)
23098 CONTINUE
      IF (.NOT.(I .GT. 1))GOTO 23100
      CALL PUTBAK (TOKEN(I))
      I = I - 1
      GTOKEN = -9
23100 CONTINUE
      TOKEN(I+1) = 0
      RETURN
      END
      SUBROUTINE PBNUM(N)
      INTEGER MOD
      INTEGER M, N, NUM
      LOGICAL*1 DIGITS(11)
      DATA DIGITS(1) /48/
      DATA DIGITS(2) /49/
      DATA DIGITS(3) /50/
      DATA DIGITS(4) /51/
      DATA DIGITS(5) /52/
      DATA DIGITS(6) /53/
      DATA DIGITS(7) /54/
      DATA DIGITS(8) /55/
      DATA DIGITS(9) /56/
      DATA DIGITS(10) /57/
      DATA DIGITS(11) /0/
      NUM = N
23102 CONTINUE
      M = MOD(NUM, 10)
      CALL PUTBAK(DIGITS(M+1))
      NUM = NUM / 10
23103 IF (.NOT.(NUM .EQ. 0))GOTO 23102
23104 CONTINUE
      RETURN
      END
      INTEGER FUNCTION PUSH(EP, ARGSTK, AP)
      INTEGER AP, ARGSTK(100), EP
      IF (.NOT.(AP .GT. 100))GOTO 23105
      CALL ERROR(19Harg stack overflow.)
23105 CONTINUE
      ARGSTK(AP) = EP
      PUSH = AP + 1
      RETURN
      END
      SUBROUTINE PUTCHR(C)
      LOGICAL*1 C
      COMMON /CMACRO/ CP, EP, EVALST(500)
      INTEGER CP
      INTEGER EP
      LOGICAL*1 EVALST
      IF (.NOT.(CP .EQ. 0))GOTO 23107
      CALL PUTCH(C,2)
      GOTO 23108
23107 CONTINUE
      IF (.NOT.(EP .GT. 500))GOTO 23109
      CALL ERROR(26Hevaluation stack overflow.)
23109 CONTINUE
      EVALST(EP) = C
      EP = EP + 1
23108 CONTINUE
      RETURN
      END
      SUBROUTINE PUTTOK(STR)
      LOGICAL*1 STR(100)
      INTEGER I
      I = 1
23111 IF (.NOT.(STR(I) .NE. 0))GOTO 23113
      CALL PUTCHR(STR(I))
23112 I = I + 1
      GOTO 23111
23113 CONTINUE
      RETURN
      END