SUBROUTINE MAIN INTEGER I, STATUS, UNIT INTEGER GETARG, EQUAL, OPEN LOGICAL*1 FILE(40) LOGICAL*1 MINUST(2) DATA MINUST(1)/45/,MINUST(2)/0/ CALL LODIDX I = 1 23000 CONTINUE STATUS = GETARG(I, FILE, 40) IF(.NOT.(STATUS .EQ. -1))GOTO 23003 IF(.NOT.(I .GT. 1))GOTO 23005 GOTO 23002 23005 CONTINUE UNIT = 1 23006 CONTINUE GOTO 23004 23003 CONTINUE IF(.NOT.(EQUAL(FILE, MINUST) .EQ. 1))GOTO 23007 UNIT = 1 GOTO 23008 23007 CONTINUE UNIT = OPEN(FILE, 1) IF(.NOT.(UNIT .EQ. -3))GOTO 23009 CALL CANT(FILE) 23009 CONTINUE 23008 CONTINUE 23004 CONTINUE CALL DOSPEL(UNIT) IF(.NOT.(UNIT .NE. 1))GOTO 23011 CALL CLOSE(UNIT) 23011 CONTINUE I = I + 1 23001 GOTO 23000 23002 CONTINUE RETURN END SUBROUTINE LODIDX LOGICAL*1 FILE(40), BUF(400), TEMP(30) INTEGER INT, N, M, I, JUNK INTEGER OPEN, GETLIN, GETWRD, CTOI COMMON / CSPELL / NLINES, DUNIT, FREEP, FREEC, STRPTR(1800), LINPT *R(2, 1800), CHARAY(18000) INTEGER NLINES INTEGER DUNIT INTEGER FREEP INTEGER FREEC INTEGER STRPTR INTEGER LINPTR LOGICAL*1 CHARAY LOGICAL*1 DICTDX(7) LOGICAL*1 DICT(5) DATA DICTDX(1)/100/,DICTDX(2)/105/,DICTDX(3)/99/,DICTDX(4)/116/,DI *CTDX(5)/100/,DICTDX(6)/120/,DICTDX(7)/0/ DATA DICT(1)/100/,DICT(2)/105/,DICT(3)/99/,DICT(4)/116/,DICT(5)/0/ CALL GETDIR(1, 6, FILE) CALL CONCAT(FILE, DICTDX, FILE) INT = OPEN(FILE, 1) IF(.NOT.(INT .NE. -3))GOTO 23013 M = 1 N=1 23015 IF(.NOT.(GETLIN(BUF, INT) .NE. -1))GOTO 23017 I = 1 JUNK = M + GETWRD(BUF, I, TEMP) + 1 IF(.NOT.(N .GT. 1800 .OR. JUNK .GT. 18000))GOTO 23018 CALL ERROR(48HDictionary index too large for internal storage!) 23018 CONTINUE STRPTR(N) = M CALL STCOPY(TEMP, 1, CHARAY, M) M = M + 1 LINPTR(1, N) = CTOI(BUF, I) LINPTR(2, N) = CTOI(BUF, I) 23016 N=N+1 GOTO 23015 23017 CONTINUE NLINES = N - 1 FREEP = N FREEC = M CALL CLOSE(INT) GOTO 23014 23013 CONTINUE CALL CANT(FILE) 23014 CONTINUE CALL GETDIR(1, 6, FILE) CALL CONCAT(FILE, DICT, FILE) DUNIT = OPEN(FILE, 1) IF(.NOT.(DUNIT .EQ. -3))GOTO 23020 CALL CANT(FILE) 23020 CONTINUE RETURN END INTEGER FUNCTION BINSRC(WORD) LOGICAL*1 WORD(100) INTEGER FIRST, LAST, I, M INTEGER STRCMP COMMON / CSPELL / NLINES, DUNIT, FREEP, FREEC, STRPTR(1800), LINPT *R(2, 1800), CHARAY(18000) INTEGER NLINES INTEGER DUNIT INTEGER FREEP INTEGER FREEC INTEGER STRPTR INTEGER LINPTR LOGICAL*1 CHARAY M = STRPTR(NLINES) IF(.NOT.(STRCMP(WORD, CHARAY(M)) .GT. 0))GOTO 23022 BINSRC=(NLINES) RETURN 23022 CONTINUE M = STRPTR(1) IF(.NOT.(STRCMP(WORD, CHARAY(M)) .LT. 0))GOTO 23024 BINSRC=(1) RETURN 23024 CONTINUE FIRST = 1 LAST = NLINES 23026 IF(.NOT.((LAST - FIRST) .GT. 1))GOTO 23027 I = (FIRST + LAST) / 2 M = STRPTR(I) I23028=(STRCMP(WORD, CHARAY(M))) GOTO 23028 23030 CONTINUE LAST = I GOTO 23029 23031 CONTINUE LAST = I FIRST = I GOTO 23029 23032 CONTINUE FIRST = I GOTO 23029 23028 CONTINUE I23028=I23028+2 IF(I23028.LT.1.OR.I23028.GT.3)GOTO 23029 GOTO(23030,23031,23032),I23028 23029 CONTINUE GOTO 23026 23027 CONTINUE BINSRC=(FIRST) RETURN END INTEGER FUNCTION FINDWD(WORD) LOGICAL*1 WORD(100) INTEGER I, JUNK, N, ADDR(2) INTEGER GETLIN, BINSRC, STRCMP, EQUAL, WDLOOK LOGICAL*1 BUF(400) COMMON / CSPELL / NLINES, DUNIT, FREEP, FREEC, STRPTR(1800), LINPT *R(2, 1800), CHARAY(18000) INTEGER NLINES INTEGER DUNIT INTEGER FREEP INTEGER FREEC INTEGER STRPTR INTEGER LINPTR LOGICAL*1 CHARAY IF(.NOT.(WDLOOK(WORD) .EQ. 1))GOTO 23033 FINDWD=(0) RETURN 23033 CONTINUE I = BINSRC(WORD) ADDR(1) = LINPTR(1, I) ADDR(2) = LINPTR(2, I) CALL SEEK(ADDR, DUNIT) N=GETLIN(BUF,DUNIT) 23035 IF(.NOT.(N .NE. -1))GOTO 23037 BUF(N) = 0 IF(.NOT.(STRCMP(WORD, BUF) .LE. 0))GOTO 23038 GOTO 23037 23038 CONTINUE 23036 N=GETLIN(BUF,DUNIT) GOTO 23035 23037 CONTINUE IF(.NOT.(N .EQ. -1))GOTO 23040 BUF(1) = 0 23040 CONTINUE IF(.NOT.(EQUAL(WORD, BUF) .EQ. 0))GOTO 23042 CALL WDSTAL(WORD) FINDWD = 0 GOTO 23043 23042 CONTINUE FINDWD = 1 23043 CONTINUE RETURN END INTEGER FUNCTION ALPHAN(C) LOGICAL*1 C, T LOGICAL*1 TYPE T = TYPE(C) IF(.NOT.(T .EQ. 1 .OR. T .EQ. 2))GOTO 23044 ALPHAN=(1) RETURN 23044 CONTINUE ALPHAN=(0) RETURN 23045 CONTINUE END INTEGER FUNCTION GTWORD(BUF, I, WORD, START) INTEGER I, START, J LOGICAL*1 BUF(100), WORD(100) INTEGER ALPHAN, LENGTH 23046 IF(.NOT.(ALPHAN(BUF(I)) .EQ. 0))GOTO 23047 IF(.NOT.(BUF(I) .EQ. 0))GOTO 23048 GOTO 23047 23048 CONTINUE I = I + 1 23049 CONTINUE GOTO 23046 23047 CONTINUE START = I J=1 23050 IF(.NOT.(ALPHAN(BUF(I)) .EQ. 1))GOTO 23052 WORD(J) = BUF(I) I = I + 1 23051 J=J+1 GOTO 23050 23052 CONTINUE WORD(J) = 0 GTWORD=(LENGTH(WORD)) RETURN END INTEGER FUNCTION WDLOOK(WORD) LOGICAL*1 WORD(100) INTEGER I, J INTEGER EQUAL COMMON / CSPELL / NLINES, DUNIT, FREEP, FREEC, STRPTR(1800), LINPT *R(2, 1800), CHARAY(18000) INTEGER NLINES INTEGER DUNIT INTEGER FREEP INTEGER FREEC INTEGER STRPTR INTEGER LINPTR LOGICAL*1 CHARAY I=NLINES+1 23053 IF(.NOT.(I .LT. FREEP))GOTO 23055 J = STRPTR(I) IF(.NOT.(EQUAL(WORD, CHARAY(J)) .EQ. 1))GOTO 23056 WDLOOK=(1) RETURN 23056 CONTINUE 23054 I=I+1 GOTO 23053 23055 CONTINUE WDLOOK=(0) RETURN END SUBROUTINE WDSTAL(WORD) LOGICAL*1 WORD(100) INTEGER I INTEGER LENGTH COMMON / CSPELL / NLINES, DUNIT, FREEP, FREEC, STRPTR(1800), LINPT *R(2, 1800), CHARAY(18000) INTEGER NLINES INTEGER DUNIT INTEGER FREEP INTEGER FREEC INTEGER STRPTR INTEGER LINPTR LOGICAL*1 CHARAY IF(.NOT.(FREEP .LE. 1800))GOTO 23058 I = FREEC + LENGTH(WORD) IF(.NOT.(I .LE. 18000))GOTO 23060 STRPTR(FREEP) = FREEC FREEP = FREEP + 1 CALL STCOPY(WORD, 1, CHARAY, FREEC) FREEC = FREEC + 1 23060 CONTINUE 23058 CONTINUE RETURN END SUBROUTINE DOSPEL(UNIT) INTEGER I, M, N, IFERR, J, START, UNIT INTEGER GETLIN, FINDWD, GTWORD LOGICAL*1 BUF(400), WORD(400), ERRBUF(400) COMMON / CSPELL / NLINES, DUNIT, FREEP, FREEC, STRPTR(1800), LINPT *R(2, 1800), CHARAY(18000) INTEGER NLINES INTEGER DUNIT INTEGER FREEP INTEGER FREEC INTEGER STRPTR INTEGER LINPTR LOGICAL*1 CHARAY N=GETLIN(BUF,UNIT) 23062 IF(.NOT.(N .NE. -1))GOTO 23064 CALL PUTLIN(BUF, 2) J=1 23065 IF(.NOT.(BUF(J) .NE. 0))GOTO 23067 IF(.NOT.(BUF(J) .EQ. 9))GOTO 23068 ERRBUF(J) = 9 GOTO 23069 23068 CONTINUE IF(.NOT.(BUF(J) .EQ. 10))GOTO 23070 ERRBUF(J) = 10 GOTO 23071 23070 CONTINUE ERRBUF(J) = 32 23071 CONTINUE 23069 CONTINUE 23066 J=J+1 GOTO 23065 23067 CONTINUE ERRBUF(J) = 0 I = 1 IFERR = 0 23072 IF(.NOT.(GTWORD(BUF, I, WORD, START) .GT. 0))GOTO 23073 CALL FOLD(WORD) IF(.NOT.(FINDWD(WORD) .EQ. 0))GOTO 23074 IFERR = 1 J=START 23076 IF(.NOT.(J .LT. I))GOTO 23078 ERRBUF(J) = 42 23077 J=J+1 GOTO 23076 23078 CONTINUE 23074 CONTINUE GOTO 23072 23073 CONTINUE IF(.NOT.(IFERR .EQ. 1))GOTO 23079 CALL PUTLIN(ERRBUF, 2) 23079 CONTINUE 23063 N=GETLIN(BUF,UNIT) GOTO 23062 23064 CONTINUE RETURN END