SUBROUTINE MAIN INTEGER GETARG, OPEN INTEGER I, FD LOGICAL*1 ARG(36) LOGICAL*1 ST001Z(25) DATA ST001Z(1)/117/,ST001Z(2)/115/,ST001Z(3)/97/,ST001Z(4)/103/,ST *001Z(5)/101/,ST001Z(6)/58/,ST001Z(7)/32/,ST001Z(8)/32/,ST001Z(9)/1 *16/,ST001Z(10)/115/,ST001Z(11)/111/,ST001Z(12)/114/,ST001Z(13)/116 */,ST001Z(14)/32/,ST001Z(15)/91/,ST001Z(16)/102/,ST001Z(17)/105/,ST *001Z(18)/108/,ST001Z(19)/101/,ST001Z(20)/93/,ST001Z(21)/32/,ST001Z *(22)/46/,ST001Z(23)/46/,ST001Z(24)/46/,ST001Z(25)/0/ CALL QUERY(ST001Z) I=1 23000 IF (.NOT.(GETARG(I, ARG, 36) .NE. -1))GOTO 23002 IF (.NOT.(ARG(1) .EQ. 45 .AND. ARG(2) .EQ. 0))GOTO 23003 FD = 1 GOTO 23004 23003 CONTINUE FD = OPEN(ARG, 1) IF (.NOT.(FD .EQ. -3))GOTO 23005 CALL CANT(ARG) 23005 CONTINUE 23004 CONTINUE CALL TPSORT (FD) IF (.NOT.(FD .NE. 1))GOTO 23007 CALL CLOSE(FD) 23007 CONTINUE 23001 I=I+1 GOTO 23000 23002 CONTINUE IF (.NOT.(I .EQ. 1))GOTO 23009 CALL TPSORT (1) 23009 CONTINUE RETURN END SUBROUTINE TPSORT (FD) LOGICAL*1 LINBUF(402), SYMBUF(120) INTEGER I, J, F, R, N, FD INTEGER GETWRD, GETLIN, LOOKS INTEGER HASH INTEGER NXTSYM INTEGER NXTFRE INTEGER BUF LOGICAL*1 ST002Z(9) COMMON /CTSORT/ HASH(128), NXTSYM, NXTFRE, BUF(5000) DATA ST002Z(1)/99/,ST002Z(2)/105/,ST002Z(3)/114/,ST002Z(4)/99/,ST0 *02Z(5)/117/,ST002Z(6)/108/,ST002Z(7)/97/,ST002Z(8)/114/,ST002Z(9)/ *0/ NXTSYM = 1 NXTFRE = 5000 I = 1 23011 IF (.NOT.(I .LE. 128))GOTO 23013 HASH(I) = 0 23012 I = I + 1 GOTO 23011 23013 CONTINUE 23014 IF (.NOT.(GETLIN(LINBUF, FD) .NE. -1))GOTO 23015 I = 1 IF (.NOT.(GETWRD(LINBUF, I, SYMBUF) .LE. 0))GOTO 23016 GOTO 23014 23016 CONTINUE J = LOOKS(SYMBUF) 23018 IF (.NOT.(GETWRD(LINBUF, I, SYMBUF) .GT. 0))GOTO 23019 CALL ENTPRC(J, LOOKS(SYMBUF)) GOTO 23018 23019 CONTINUE GOTO 23014 23015 CONTINUE F = 0 I = 1 23020 IF (.NOT.(I .LT. NXTSYM .AND. F .EQ. 0))GOTO 23022 IF (.NOT.(BUF(I+1) .EQ. 0))GOTO 23023 F = I 23023 CONTINUE 23021 I = I + 3 GOTO 23020 23022 CONTINUE R = F 23025 IF (.NOT.(I .LT. NXTSYM))GOTO 23027 IF (.NOT.(BUF(I+1) .EQ. 0))GOTO 23028 BUF(R+1) = I R = I 23028 CONTINUE 23026 I = I + 3 GOTO 23025 23027 CONTINUE N = NXTSYM 23030 IF (.NOT.(F .GT. 0))GOTO 23032 CALL ICOPYS (BUF, BUF(F+0), LINBUF, 1) CALL PUTLIN(LINBUF, 2) CALL PUTCH(10, 2) I = BUF(F+2) 23033 IF (.NOT.(I .GT. 0))GOTO 23035 J = BUF(I+1) BUF(J+1) = BUF(J+1) - 1 IF (.NOT.(BUF(J+1) .EQ. 0))GOTO 23036 BUF(R+1) = J R = J 23036 CONTINUE 23034 I = BUF(I+0) GOTO 23033 23035 CONTINUE N = N - 3 23031 F = BUF(F+1) GOTO 23030 23032 CONTINUE IF (.NOT.(N .GT. 1))GOTO 23038 CALL ERROR(ST002Z) 23038 CONTINUE RETURN END SUBROUTINE ENTPRC(A, B) INTEGER A, B INTEGER P INTEGER NALLOC INTEGER HASH INTEGER NXTSYM INTEGER NXTFRE INTEGER BUF COMMON /CTSORT/ HASH(128), NXTSYM, NXTFRE, BUF(5000) BUF(B+1) = BUF(B+1) + 1 P = NALLOC(2) BUF(P+0) = BUF(A+2) BUF(P+1) = B BUF(A+2) = P RETURN END INTEGER FUNCTION LOOKS(S) LOGICAL*1 S(120), LIN(120) INTEGER I INTEGER LENGTH, NALLOC, EQUAL, SYMALC INTEGER HASH INTEGER NXTSYM INTEGER NXTFRE INTEGER BUF COMMON /CTSORT/ HASH(128), NXTSYM, NXTFRE, BUF(5000) I = HASH(S(1)+1) 23040 IF (.NOT.(I .GT. 0))GOTO 23042 CALL ICOPYS (BUF, I+2, LIN, 1) IF (.NOT.(EQUAL(S, LIN) .EQ. 1))GOTO 23043 LOOKS=(BUF(I+1)) RETURN 23043 CONTINUE 23041 I = BUF(I+0) GOTO 23040 23042 CONTINUE I = NALLOC(2 + 1 + LENGTH(S) + 1) BUF(I+0) = HASH(S(1)+1) HASH(S(1)+1) = I BUF(I+1) = SYMALC(I+2) CALL SCOPYI(S, 1, BUF, I + 2) LOOKS=(BUF(I+1)) RETURN END INTEGER FUNCTION NALLOC(N) INTEGER N INTEGER HASH INTEGER NXTSYM INTEGER NXTFRE INTEGER BUF LOGICAL*1 ST003Z(15) COMMON /CTSORT/ HASH(128), NXTSYM, NXTFRE, BUF(5000) DATA ST003Z(1)/111/,ST003Z(2)/117/,ST003Z(3)/116/,ST003Z(4)/32/,ST *003Z(5)/111/,ST003Z(6)/102/,ST003Z(7)/32/,ST003Z(8)/115/,ST003Z(9) */116/,ST003Z(10)/111/,ST003Z(11)/114/,ST003Z(12)/97/,ST003Z(13)/10 *3/,ST003Z(14)/101/,ST003Z(15)/0/ NXTFRE = NXTFRE - N IF (.NOT.(NXTFRE .LT. NXTSYM))GOTO 23045 CALL ERROR(ST003Z) 23045 CONTINUE NALLOC=(NXTFRE + 1) RETURN END INTEGER FUNCTION SYMALC(S) INTEGER S INTEGER P INTEGER HASH INTEGER NXTSYM INTEGER NXTFRE INTEGER BUF LOGICAL*1 ST004Z(15) COMMON /CTSORT/ HASH(128), NXTSYM, NXTFRE, BUF(5000) DATA ST004Z(1)/111/,ST004Z(2)/117/,ST004Z(3)/116/,ST004Z(4)/32/,ST *004Z(5)/111/,ST004Z(6)/102/,ST004Z(7)/32/,ST004Z(8)/115/,ST004Z(9) */116/,ST004Z(10)/111/,ST004Z(11)/114/,ST004Z(12)/97/,ST004Z(13)/10 *3/,ST004Z(14)/101/,ST004Z(15)/0/ P = NXTSYM NXTSYM = NXTSYM + 3 IF (.NOT.(NXTSYM .GT. NXTFRE))GOTO 23047 CALL ERROR(ST004Z) 23047 CONTINUE BUF(P+0) = S BUF(P+1) = 0 BUF(P+2) = 0 SYMALC=(P) RETURN END SUBROUTINE ICOPYS(FROM, I, TO, J) INTEGER FROM(100) LOGICAL*1 TO(100) INTEGER I, J, K1, K2 K2 = J K1 = I 23049 IF (.NOT.(FROM(K1) .NE. 0))GOTO 23051 TO(K2) = FROM(K1) K2 = K2 + 1 23050 K1 = K1 + 1 GOTO 23049 23051 CONTINUE TO(K2) = 0 RETURN END SUBROUTINE SCOPYI(FROM, I, TO, J) LOGICAL*1 FROM(100) INTEGER TO(100) INTEGER I, J, K1, K2 K2 = J K1 = I 23052 IF (.NOT.(FROM(K1) .NE. 0))GOTO 23054 TO(K2) = FROM(K1) K2 = K2 + 1 23053 K1 = K1 + 1 GOTO 23052 23054 CONTINUE TO(K2) = 0 RETURN END