SUBROUTINE MAIN
      LOGICAL*1 BUF(512), SUB(132), OLD(512)
      INTEGER N, PAT(132)
      INTEGER GETLIN, EQUAL, MATCH
      COMMON / CTABLE / VERBOS, LSTPTR, GBLPAT(132), PTR(100)
      INTEGER VERBOS
      INTEGER LSTPTR
      INTEGER GBLPAT
      INTEGER PTR
      CALL QUERY(36Husage:  xch [-gpat] [-v] patfile ...)
      CALL INIPAT(BUF, PAT, SUB)
      N = 0
23000 IF (.NOT.(GETLIN(BUF, 1) .NE. -1))GOTO 23001
      N = N + 1
      CALL STRCPY(BUF, OLD)
      IF (.NOT.(GBLPAT(1) .EQ. 0))GOTO 23002
      CALL DOSUBS(BUF, PAT, SUB)
      GOTO 23003
23002 CONTINUE
      IF (.NOT.(MATCH(BUF, GBLPAT) .EQ. 1))GOTO 23004
      CALL DOSUBS(BUF, PAT, SUB)
23004 CONTINUE
23003 CONTINUE
      IF (.NOT.(VERBOS .EQ. 1))GOTO 23006
      IF (.NOT.(EQUAL(BUF, OLD) .EQ. 0))GOTO 23008
      CALL PUTINT(N, 1, 3)
      CALL PUTCH(10, 3)
      CALL PUTLIN(OLD, 3)
      CALL PUTLIN(BUF, 3)
23008 CONTINUE
23006 CONTINUE
      CALL PUTLIN(BUF, 2)
      GOTO 23000
23001 CONTINUE
      RETURN
      END
      SUBROUTINE DOSUBS(BUF, PAT, SUB)
      LOGICAL*1 BUF(512), SUB(132)
      INTEGER I, J, K, PAT(132)
      COMMON / CTABLE / VERBOS, LSTPTR, GBLPAT(132), PTR(100)
      INTEGER VERBOS
      INTEGER LSTPTR
      INTEGER GBLPAT
      INTEGER PTR
      INTEGER MEM(5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      I=1
23010 IF (.NOT.(I .LE. LSTPTR))GOTO 23012
      J=PTR(I)+1
      K=1
23013 IF (.NOT.(MEM(J) .NE. 0))GOTO 23015
      PAT(K) = MEM(J)
23014 J=J+1
      K=K+1
      GOTO 23013
23015 CONTINUE
      PAT(K) = 0
      J = PTR(I)
      CALL SCOPY(CMEM, (2*(MEM(J)-1)+1), SUB, 1)
      CALL REPLAC(BUF, PAT, SUB)
23011 I=I+1
      GOTO 23010
23012 CONTINUE
      RETURN
      END
      INTEGER FUNCTION ENTER(LHS, RHS)
      INTEGER LHS(132), SIZE, I, J
      LOGICAL*1 RHS(132)
      INTEGER NODE, DSGET, TEMP, SDUPL
      INTEGER MEM(5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      SIZE=1
23016 IF (.NOT.(LHS(SIZE) .NE. 0))GOTO 23018
23017 SIZE=SIZE+1
      GOTO 23016
23018 CONTINUE
      NODE = DSGET(SIZE + 1)
      IF (.NOT.(NODE .EQ. 0))GOTO 23019
      CALL ERROR(39HToo many patterns for internal storage.)
23019 CONTINUE
      I=1
      J=NODE+1
23021 IF (.NOT.(LHS(I) .NE. 0))GOTO 23023
      MEM(J) = LHS(I)
23022 I=I+1
      J=J+1
      GOTO 23021
23023 CONTINUE
      MEM(J) = 0
      TEMP = SDUPL(RHS)
      IF (.NOT.(TEMP .EQ. 0))GOTO 23024
      CALL ERROR(39HToo many patterns for internal storage.)
23024 CONTINUE
      MEM(NODE) = TEMP
      ENTER=(NODE)
      RETURN
      END
      SUBROUTINE FERROR(FILE, BUF, REASON)
      LOGICAL*1 FILE(100), BUF(100), REASON(100)
      LOGICAL*1 ERR1(24)
      LOGICAL*1 ERR2(11)
      LOGICAL*1 ERR3(17)
      DATA ERR1(1)/69/,ERR1(2)/114/,ERR1(3)/114/,ERR1(4)/111/,ERR1(5)/11
     *4/,ERR1(6)/32/,ERR1(7)/112/,ERR1(8)/114/,ERR1(9)/111/,ERR1(10)/99/
     *,ERR1(11)/101/,ERR1(12)/115/,ERR1(13)/115/,ERR1(14)/105/,ERR1(15)/
     *110/,ERR1(16)/103/,ERR1(17)/32/,ERR1(18)/102/,ERR1(19)/105/,ERR1(2
     *0)/108/,ERR1(21)/101/,ERR1(22)/58/,ERR1(23)/32/,ERR1(24)/0/
      DATA ERR2(1)/44/,ERR2(2)/32/,ERR2(3)/114/,ERR2(4)/101/,ERR2(5)/97/
     *,ERR2(6)/115/,ERR2(7)/111/,ERR2(8)/110/,ERR2(9)/58/,ERR2(10)/32/,E
     *RR2(11)/0/
      DATA ERR3(1)/79/,ERR3(2)/102/,ERR3(3)/102/,ERR3(4)/101/,ERR3(5)/11
     *0/,ERR3(6)/100/,ERR3(7)/105/,ERR3(8)/110/,ERR3(9)/103/,ERR3(10)/32
     */,ERR3(11)/108/,ERR3(12)/105/,ERR3(13)/110/,ERR3(14)/101/,ERR3(15)
     */58/,ERR3(16)/32/,ERR3(17)/0/
      CALL PUTLIN(ERR1, 3)
      CALL PUTLIN(FILE, 3)
      CALL PUTLIN(ERR2, 3)
      CALL PUTLNL(REASON, 3)
      CALL PUTLIN(ERR3, 3)
      CALL PUTLNL(BUF, 3)
      CALL ENDST(-3)
      RETURN
      END
      SUBROUTINE INIPAT(BUF, LHS, RHS)
      LOGICAL*1 BUF(512), RHS(132), PATFIL(40), DELIM
      INTEGER I, J, LHS(132)
      INTEGER GETARG, GETLIN, MAKPAT, MAKSUB
      INTEGER ENTER
      INTEGER INT
      INTEGER OPEN
      COMMON / CTABLE / VERBOS, LSTPTR, GBLPAT(132), PTR(100)
      INTEGER VERBOS
      INTEGER LSTPTR
      INTEGER GBLPAT
      INTEGER PTR
      INTEGER MEM(5000)
      LOGICAL*1 CMEM(10000)
      EQUIVALENCE (CMEM(1),MEM(1))
      COMMON/CDSMEM/MEM
      LOGICAL*1 ILLPAT(35)
      LOGICAL*1 ILLSUB(48)
      LOGICAL*1 PTROVF(40)
      DATA ILLPAT(1)/73/,ILLPAT(2)/108/,ILLPAT(3)/108/,ILLPAT(4)/101/,IL
     *LPAT(5)/103/,ILLPAT(6)/97/,ILLPAT(7)/108/,ILLPAT(8)/32/,ILLPAT(9)/
     *112/,ILLPAT(10)/97/,ILLPAT(11)/116/,ILLPAT(12)/116/,ILLPAT(13)/101
     */,ILLPAT(14)/114/,ILLPAT(15)/110/,ILLPAT(16)/32/,ILLPAT(17)/105/,I
     *LLPAT(18)/110/,ILLPAT(19)/32/,ILLPAT(20)/108/,ILLPAT(21)/101/,ILLP
     *AT(22)/102/,ILLPAT(23)/116/,ILLPAT(24)/32/,ILLPAT(25)/104/,ILLPAT(
     *26)/97/,ILLPAT(27)/110/,ILLPAT(28)/100/,ILLPAT(29)/32/,ILLPAT(30)/
     *115/,ILLPAT(31)/105/,ILLPAT(32)/100/,ILLPAT(33)/101/,ILLPAT(34)/46
     */,ILLPAT(35)/0/
      DATA ILLSUB(1)/73/,ILLSUB(2)/108/,ILLSUB(3)/108/,ILLSUB(4)/101/,IL
     *LSUB(5)/103/,ILLSUB(6)/97/,ILLSUB(7)/108/,ILLSUB(8)/32/,ILLSUB(9)/
     *115/,ILLSUB(10)/117/,ILLSUB(11)/98/,ILLSUB(12)/115/,ILLSUB(13)/116
     */,ILLSUB(14)/105/,ILLSUB(15)/116/,ILLSUB(16)/117/,ILLSUB(17)/116/,
     *ILLSUB(18)/105/,ILLSUB(19)/111/,ILLSUB(20)/110/,ILLSUB(21)/32/,ILL
     *SUB(22)/115/,ILLSUB(23)/116/,ILLSUB(24)/114/,ILLSUB(25)/105/,ILLSU
     *B(26)/110/,ILLSUB(27)/103/,ILLSUB(28)/32/,ILLSUB(29)/105/,ILLSUB(3
     *0)/110/,ILLSUB(31)/32/,ILLSUB(32)/114/,ILLSUB(33)/105/,ILLSUB(34)/
     *103/,ILLSUB(35)/104/,ILLSUB(36)/116/,ILLSUB(37)/32/,ILLSUB(38)/104
     */,ILLSUB(39)/97/,ILLSUB(40)/110/,ILLSUB(41)/100/,ILLSUB(42)/32/,IL
     *LSUB(43)/115/,ILLSUB(44)/105/,ILLSUB(45)/100/,ILLSUB(46)/101/,ILLS
     *UB(47)/46/,ILLSUB(48)/0/
      DATA PTROVF(1)/84/,PTROVF(2)/111/,PTROVF(3)/111/,PTROVF(4)/32/,PTR
     *OVF(5)/109/,PTROVF(6)/97/,PTROVF(7)/110/,PTROVF(8)/121/,PTROVF(9)/
     *32/,PTROVF(10)/112/,PTROVF(11)/97/,PTROVF(12)/116/,PTROVF(13)/116/
     *,PTROVF(14)/101/,PTROVF(15)/114/,PTROVF(16)/110/,PTROVF(17)/115/,P
     *TROVF(18)/32/,PTROVF(19)/102/,PTROVF(20)/111/,PTROVF(21)/114/,PTRO
     *VF(22)/32/,PTROVF(23)/105/,PTROVF(24)/110/,PTROVF(25)/116/,PTROVF(
     *26)/101/,PTROVF(27)/114/,PTROVF(28)/110/,PTROVF(29)/97/,PTROVF(30)
     */108/,PTROVF(31)/32/,PTROVF(32)/115/,PTROVF(33)/116/,PTROVF(34)/11
     *1/,PTROVF(35)/114/,PTROVF(36)/97/,PTROVF(37)/103/,PTROVF(38)/101/,
     *PTROVF(39)/46/,PTROVF(40)/0/
      LSTPTR = 0
      VERBOS = 0
      GBLPAT(1) = 0
      CALL DSINIT(5000)
      I=1
23026 IF (.NOT.(GETARG(I, PATFIL, 40) .NE. -1))GOTO 23028
      IF (.NOT.(PATFIL(1) .EQ. 45))GOTO 23029
      IF (.NOT.(PATFIL(2) .EQ. 118 .OR. PATFIL(2) .EQ. 86))GOTO 23031
      VERBOS = 1
      GOTO 23032
23031 CONTINUE
      IF (.NOT.(PATFIL(2) .EQ. 103 .OR. PATFIL(2) .EQ. 71))GOTO 23033
      IF (.NOT.(MAKPAT(PATFIL, 3, 0, GBLPAT) .EQ. -3))GOTO 23035
      CALL ERROR(24HError in global pattern.)
23035 CONTINUE
      GOTO 23034
23033 CONTINUE
      CALL BADARG(PATFIL)
23034 CONTINUE
23032 CONTINUE
      GOTO 23030
23029 CONTINUE
      INT = OPEN(PATFIL, 1)
      IF (.NOT.(INT .EQ. -3))GOTO 23037
      CALL CANT(PATFIL)
23037 CONTINUE
23039 IF (.NOT.(GETLIN(BUF, INT) .NE. -1))GOTO 23040
      DELIM = BUF(1)
      J = MAKPAT(BUF, 2, DELIM, LHS)
      IF (.NOT.(J .EQ. -3))GOTO 23041
      CALL FERROR(PATFIL, BUF, ILLPAT)
23041 CONTINUE
      J = MAKSUB(BUF, J+1, DELIM, RHS)
      IF (.NOT.(J .EQ. -3))GOTO 23043
      CALL FERROR(PATFIL, BUF, ILLSUB)
23043 CONTINUE
      LSTPTR = LSTPTR + 1
      IF (.NOT.(LSTPTR .GT. 100))GOTO 23045
      CALL FERROR(PATFIL, BUF, PTROVF)
23045 CONTINUE
      PTR(LSTPTR) = ENTER(LHS, RHS)
      GOTO 23039
23040 CONTINUE
      CALL CLOSE(INT)
23030 CONTINUE
23027 I=I+1
      GOTO 23026
23028 CONTINUE
      RETURN
      END
      SUBROUTINE REPLAC(OLD, PAT, SUB)
      LOGICAL*1 OLD(512), SUB(132), NEW(512)
      INTEGER J, LASTM, K, M, JUNK, PAT(132)
      INTEGER AMATCH, ADDSET
      J = 1
      LASTM = 0
      K=1
23047 IF (.NOT.(OLD(K) .NE. 0))GOTO 23049
      M = AMATCH(OLD, K, PAT)
      IF (.NOT.(M .GT. 0 .AND. LASTM .NE. M))GOTO 23050
      CALL CATSUB(OLD, K, M, SUB, NEW, J, 512)
      LASTM = M
23050 CONTINUE
      IF (.NOT.(M .EQ. 0 .OR. M .EQ. K))GOTO 23052
      JUNK = ADDSET(OLD(K), NEW, J, 512)
      K = K + 1
      GOTO 23053
23052 CONTINUE
      K = M
23053 CONTINUE
23048 GOTO 23047
23049 CONTINUE
      IF (.NOT.(J .GT. 512))GOTO 23054
      J = 512
      CALL REMARK(33HThe next line has been truncated.)
23054 CONTINUE
      NEW(J) = 0
      CALL STRCPY(NEW, OLD)
      RETURN
      END