SUBROUTINE MAIN
      LOGICAL*1 GTOKEN
      LOGICAL*1 DEFN(200), T, TOKEN(100)
      INTEGER LOOKUP, 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
      COMMON /CDEFIO/ BP, BUF(300)
      INTEGER BP
      LOGICAL*1 BUF
      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(400)
      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/
      DATA BP /0/
      CALL TBINIT
      CALL INSTAL(DEFNAM, DEFTYP)
      CALL INSTAL(INCNAM, INCTYP)
      CALL INSTAL(SUBNAM, SUBTYP)
      CALL INSTAL(IFNAM, IFTYP)
      CALL INSTAL(ARNAM, ARTYP)
      I=1
23000 CONTINUE
      IF(.NOT.(GETARG(I, FILE, 400) .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. 63 .AND. FILE(2) .EQ. 0))GOTO 23007
      CALL ERROR(25Husage:  macro [file ...].)
      GOTO 23008
23007 CONTINUE
      IF(.NOT.(FILE(1) .EQ. 45 .AND. FILE(2) .EQ. 0))GOTO 23009
      INT = 1
      GOTO 23010
23009 CONTINUE
      INT = OPEN(FILE, 1)
      IF(.NOT.(INT .EQ. -3))GOTO 23011
      CALL CANT (FILE)
23011 CONTINUE
23010 CONTINUE
23008 CONTINUE
23004 CONTINUE
      BP = 0
      CP = 0
      AP = 1
      EP = 1
      T=GTOKEN(TOKEN, 100, INT)
23013 IF(.NOT.(T.NE. -1))GOTO 23015
      IF(.NOT.(T .EQ. -9))GOTO 23016
      IF(.NOT.(LOOKUP(TOKEN, DEFN) .EQ. 0))GOTO 23018
      CALL PUTTOK(TOKEN)
      GOTO 23019
23018 CONTINUE
      CP = CP + 1
      IF(.NOT.(CP .GT. 130))GOTO 23020
      CALL ERROR(20Hcall stack overflow.)
23020 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 23022
      CALL PBSTR(BALP)
23022 CONTINUE
      PLEV(CP) = 0
23019 CONTINUE
      GOTO 23017
23016 CONTINUE
      IF(.NOT.(T .EQ. 91))GOTO 23024
      NLB = 1
23026 CONTINUE
      T = GTOKEN(TOKEN, 100, INT)
      IF(.NOT.(T .EQ. 91))GOTO 23029
      NLB = NLB + 1
      GOTO 23030
23029 CONTINUE
      IF(.NOT.(T .EQ. 93))GOTO 23031
      NLB = NLB - 1
      IF(.NOT.(NLB .EQ. 0))GOTO 23033
      GOTO 23028
23033 CONTINUE
      GOTO 23032
23031 CONTINUE
      IF(.NOT.(T .EQ. -1))GOTO 23035
      CALL ERROR(14HEOF in string.)
23035 CONTINUE
23032 CONTINUE
23030 CONTINUE
      CALL PUTTOK(TOKEN)
23027 GOTO 23026
23028 CONTINUE
      GOTO 23025
23024 CONTINUE
      IF(.NOT.(CP .EQ. 0))GOTO 23037
      CALL PUTTOK(TOKEN)
      GOTO 23038
23037 CONTINUE
      IF(.NOT.(T .EQ. 40))GOTO 23039
      IF(.NOT.(PLEV(CP) .GT. 0))GOTO 23041
      CALL PUTTOK(TOKEN)
23041 CONTINUE
      PLEV(CP) = PLEV(CP) + 1
      GOTO 23040
23039 CONTINUE
      IF(.NOT.(T .EQ. 41))GOTO 23043
      PLEV(CP) = PLEV(CP) - 1
      IF(.NOT.(PLEV(CP) .GT. 0))GOTO 23045
      CALL PUTTOK(TOKEN)
      GOTO 23046
23045 CONTINUE
      CALL PUTCHR(0)
      CALL EVAL(ARGSTK, CALLST(CP), AP-1)
      AP = CALLST(CP)
      EP = ARGSTK(AP)
      CP = CP - 1
23046 CONTINUE
      GOTO 23044
23043 CONTINUE
      IF(.NOT.(T .EQ. 44 .AND. PLEV(CP) .EQ. 1))GOTO 23047
      CALL PUTCHR(0)
      AP = PUSH(EP, ARGSTK, AP)
      GOTO 23048
23047 CONTINUE
      CALL PUTTOK(TOKEN)
23048 CONTINUE
23044 CONTINUE
23040 CONTINUE
23038 CONTINUE
23025 CONTINUE
23017 CONTINUE
23014  T=GTOKEN(TOKEN, 100, INT)
      GOTO 23013
23015 CONTINUE
      IF(.NOT.(CP .NE. 0))GOTO 23049
      CALL ERROR(15Hunexpected EOF.)
23049 CONTINUE
      IF(.NOT.(INT .NE. 1))GOTO 23051
      CALL CLOSE(INT)
23051 CONTINUE
23001 I=I+1
      GOTO 23000
23002 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 23053
      A2 = ARGSTK(I+2)
      A3 = ARGSTK(I+3)
      CALL INSTAL(EVALST(A2), EVALST(A3))
23053 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 23055
      RETURN
23055 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 23057
      CALL PBSTR(EVALST(A4))
      GOTO 23058
23057 CONTINUE
      CALL PBSTR(EVALST(A5))
23058 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 23059
      RETURN
23059 CONTINUE
      IF(.NOT.(J - I .LT. 4))GOTO 23061
      NC = 100
      GOTO 23062
23061 CONTINUE
      K = ARGSTK(I+4)
      NC = CTOI(EVALST, K)
23062 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 23
     *063
      K = FC + MIN0(NC, LENGTH(EVALST(FC))) - 1
23065 IF(.NOT.(K .GE. FC))GOTO 23067
      CALL PUTBAK(EVALST(K))
23066 K = K - 1
      GOTO 23065
23067 CONTINUE
23063 CONTINUE
      RETURN
      END
      SUBROUTINE EVAL(ARGSTK, I, J)
      INTEGER INDEX, 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 23068
      CALL DODEF(ARGSTK, I, J)
      GOTO 23069
23068 CONTINUE
      IF(.NOT.(TD .EQ. -12))GOTO 23070
      CALL DOINCR(ARGSTK, I, J)
      GOTO 23071
23070 CONTINUE
      IF(.NOT.(TD .EQ. -13))GOTO 23072
      CALL DOSUB(ARGSTK, I, J)
      GOTO 23073
23072 CONTINUE
      IF(.NOT.(TD .EQ. -11))GOTO 23074
      CALL DOIF(ARGSTK, I, J)
      GOTO 23075
23074 CONTINUE
      IF(.NOT.(TD .EQ. -14))GOTO 23076
      CALL DOARTH(ARGSTK, I, J)
      GOTO 23077
23076 CONTINUE
      K = T+LENGTH(EVALST(T))-1
23078 IF(.NOT.(K .GT. T))GOTO 23080
      IF(.NOT.(EVALST(K-1) .NE. 36))GOTO 23081
      CALL PUTBAK(EVALST(K))
      GOTO 23082
23081 CONTINUE
      ARGNO = INDEX(DIGITS, EVALST(K)) - 1
      IF(.NOT.(ARGNO .GE. 0 .AND. ARGNO .LT. J-I))GOTO 23083
      N = I + ARGNO + 1
      M = ARGSTK(N)
      CALL PBSTR(EVALST(M))
23083 CONTINUE
      K = K - 1
23082 CONTINUE
23079 K = K - 1
      GOTO 23078
23080 CONTINUE
      IF(.NOT.(K .EQ. T))GOTO 23085
      CALL PUTBAK(EVALST(K))
23085 CONTINUE
23077 CONTINUE
23075 CONTINUE
23073 CONTINUE
23071 CONTINUE
23069 CONTINUE
      RETURN
      END
      LOGICAL*1 FUNCTION GTOKEN(TOKEN, TOKSIZ, INT)
      LOGICAL*1 NGETC, TYPE
      INTEGER I, TOKSIZ, INT
      LOGICAL*1 TOKEN (TOKSIZ)
      I=1
23087 IF(.NOT.(I.LT.TOKSIZ))GOTO 23089
      GTOKEN = TYPE( NGETCH(TOKEN(I), INT))
      IF(.NOT.(GTOKEN .NE. 1 .AND. GTOKEN .NE. 2))GOTO 23090
      GOTO 23089
23090 CONTINUE
23088 I=I+1
      GOTO 23087
23089 CONTINUE
      IF(.NOT.(I .GE. TOKSIZ))GOTO 23092
      CALL ERROR (15Htoken too long.)
23092 CONTINUE
      IF(.NOT.(I .GT. 1))GOTO 23094
      CALL PUTBAK (TOKEN(I))
      I = I - 1
      GTOKEN = -9
23094 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
23096 CONTINUE
      M = MOD(NUM, 10)
      CALL PUTBAK(DIGITS(M+1))
      NUM = NUM / 10
23097 IF(.NOT.(NUM .EQ. 0))GOTO 23096
23098 CONTINUE
      RETURN
      END
      INTEGER FUNCTION PUSH(EP, ARGSTK, AP)
      INTEGER AP, ARGSTK(100), EP
      IF(.NOT.(AP .GT. 100))GOTO 23099
      CALL ERROR(19Harg stack overflow.)
23099 CONTINUE
      ARGSTK(AP) = EP
      PUSH = AP + 1
      RETURN
      END
      SUBROUTINE PUTTOK(STR)
      LOGICAL*1 STR(100)
      INTEGER I
      I = 1
23101 IF(.NOT.(STR(I) .NE. 0))GOTO 23103
      CALL PUTCHR(STR(I))
23102 I = I + 1
      GOTO 23101
23103 CONTINUE
      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 23104
      CALL PUTC(C)
      GOTO 23105
23104 CONTINUE
      IF(.NOT.(EP .GT. 500))GOTO 23106
      CALL ERROR(26Hevaluation stack overflow.)
23106 CONTINUE
      EVALST(EP) = C
      EP = EP + 1
23105 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 23108
      CALL PBNUM(CTOI(EVALST,K)+CTOI(EVALST,L))
      GOTO 23109
23108 CONTINUE
      IF(.NOT.(OP .EQ. 45))GOTO 23110
      CALL PBNUM(CTOI(EVALST,K)-CTOI(EVALST,L))
      GOTO 23111
23110 CONTINUE
      IF(.NOT.(OP .EQ. 42 ))GOTO 23112
      CALL PBNUM(CTOI(EVALST,K)*CTOI(EVALST,L))
      GOTO 23113
23112 CONTINUE
      IF(.NOT.(OP .EQ. 47 ))GOTO 23114
      CALL PBNUM(CTOI(EVALST,K)/CTOI(EVALST,L))
      GOTO 23115
23114 CONTINUE
      CALL REMARK(11Harith error)
23115 CONTINUE
23113 CONTINUE
23111 CONTINUE
23109 CONTINUE
      RETURN
      END