#-h- spelsym 55 asc 30-oct-80 12:30:07 [002,100] define(MAX_DIR_ENTRIES,1800) define(MAX_CHARS,18000) #-h- cspell 483 asc 30-oct-80 12:30:08 [002,100] common / cspell / nlines, dunit, freep, freec, strptr(MAX_DIR_ENTRIES), linptr(2, MAX_DIR_ENTRIES), charay(MAX_CHARS) integer nlines # number of entries read from index integer dunit # rat4 unit for dictionary file integer freep # next free loc in strptr integer freec # next free loc in charay integer strptr # index into charay for the key for the n'th entry integer linptr # values to load into seek to locate record character charay # key strings stored here #-h- spell.r 4892 asc 30-oct-80 12:30:09 [002,100] #-h- main 519 asc 29-oct-80 23:02:04 tools include spelsym subroutine main integer i, status, unit integer getarg, equal, open character file(FILENAMESIZE) string minust "-" call lodidx i = 1 repeat { status = getarg(i, file, FILENAMESIZE) if (status == EOF) if (i > 1) break else unit = STDIN else if (equal(file, minust) == YES) unit = STDIN else { unit = open(file, READ) if (unit == ERR) call cant(file) } call dospel(unit) if (unit != STDIN) call close(unit) i = i + 1 } return end #-h- lodidx 935 asc 23-oct-80 08:53:39 # load dictionary index file subroutine lodidx character file(FILENAMESIZE), buf(MAXLINE), temp(30) integer int, n, m, i, junk integer open, getlin, getwrd, ctoi include cspell string dictdx "dictdx" string dict "dict" call getdir(BINDIRECTORY, LOCAL, file) call concat(file, dictdx, file) int = open(file, READ) if (int != ERR) { m = 1 for (n=1; getlin(buf, int) != EOF; n=n+1) { i = 1 junk = m + getwrd(buf, i, temp) + 1 if (n > MAX_DIR_ENTRIES | junk > MAX_CHARS) call error("Dictionary index too large for internal storage!") strptr(n) = m call stcopy(temp, 1, charay, m) m = m + 1 linptr(1, n) = ctoi(buf, i) linptr(2, n) = ctoi(buf, i) } nlines = n - 1 freep = n freec = m call close(int) } else call cant(file) call getdir(BINDIRECTORY, LOCAL, file) call concat(file, dict, file) dunit = open(file, READ) if (dunit == ERR) call cant(file) return end #-h- binsrc 493 asc 17-oct-80 15:26:58 integer function binsrc(word) character word(ARB) integer first, last, i, m integer strcmp include cspell m = strptr(nlines) if (strcmp(word, charay(m)) > 0) return(nlines) m = strptr(1) if (strcmp(word, charay(m)) < 0) return(1) first = 1 last = nlines while ((last - first) > 1) { i = (first + last) / 2 m = strptr(i) switch (strcmp(word, charay(m))) { case -1: last = i case 0: {last = i; first = i} case 1: first = i } } return(first) end #-h- findwd 642 asc 23-oct-80 08:53:40 integer function findwd(word) character word(ARB) integer i, junk, n, addr(2) integer getlin, binsrc, strcmp, equal, wdlook character buf(MAXLINE) include cspell if (wdlook(word) == YES) # seen this mis-spelled word before return(NO) i = binsrc(word) addr(1) = linptr(1, i) addr(2) = linptr(2, i) call seek(addr, dunit) for (n=getlin(buf,dunit); n != EOF; n=getlin(buf,dunit)) { buf(n) = EOS if (strcmp(word, buf) <= 0) break } if (n == EOF) buf(1) = EOS if (equal(word, buf) == NO) { call wdstal(word) # install mis-spelled word findwd = NO } else findwd = YES return end #-h- alphan 149 asc 17-oct-80 15:26:59 integer function alphan(c) character c, t character type t = type(c) if (t == LETTER | t == DIGIT) return(YES) else return(NO) end #-h- gtword 345 asc 17-oct-80 15:27:00 integer function gtword(buf, i, word, start) integer i, start, j character buf(ARB), word(ARB) integer alphan, length while (alphan(buf(i)) == NO) if (buf(i) == EOS) break else i = i + 1 start = i for (j=1; alphan(buf(i)) == YES; j=j+1) { word(j) = buf(i) i = i + 1 } word(j) = EOS return(length(word)) end #-h- wdlook 235 asc 23-oct-80 08:53:43 integer function wdlook(word) character word(ARB) integer i, j integer equal include cspell for (i=nlines+1; i < freep; i=i+1) { j = strptr(i) if (equal(word, charay(j)) == YES) return(YES) } return(NO) end #-h- wdstal 404 asc 23-oct-80 08:53:44 subroutine wdstal(word) character word(ARB) integer i integer length include cspell if (freep <= MAX_DIR_ENTRIES) { i = freec + length(word) if (i <= MAX_CHARS) # word will fit { strptr(freep) = freec # fill in pointer freep = freep + 1 # bump pointer call stcopy(word, 1, charay, freec) # copy word, bumping freec freec = freec + 1 # point past EOS } } return end #-h- dospel 711 asc 29-oct-80 23:02:05 tools subroutine dospel(unit) integer i, m, n, iferr, j, start, unit integer getlin, findwd, gtword character buf(MAXLINE), word(MAXLINE), errbuf(MAXLINE) include cspell for (n=getlin(buf,unit); n != EOF; n=getlin(buf,unit)) { call putlin(buf, STDOUT) for (j=1; buf(j) != EOS; j=j+1) if (buf(j) == TAB) errbuf(j) = TAB else if (buf(j) == NEWLINE) errbuf(j) = NEWLINE else errbuf(j) = BLANK errbuf(j) = EOS i = 1 iferr = NO while (gtword(buf, i, word, start) > 0) { call fold(word) if (findwd(word) == NO) { iferr = YES for (j=start; j < i; j=j+1) errbuf(j) = STAR } } if (iferr == YES) call putlin(errbuf, STDOUT) } return end