PROGRAM SPELL C C+ C This is a spelling checker program for the DEC RSX-11M operating C system. C C C USE: >SPELL filename[/switches] or C >SPE C SPE>filename[/switches] C SPE>^Z C > C C C TO BUILD: C @SPELL (please use the command file otherwise the C task image will be too big) C C RESTRICTIONS: C DICTIONARY on SP: (reset in tskbld file for your system) C Random access file will take about 900 blocks C FORTRAN-77 used for compilation C Task image size will be about 130 blocks C Short error messages will be included in task image C /NOTR is used to increase speed C Virtual arrays are used for letter index blocks(=6500words) C thus a partition of at least 39k C Hard coded to use [3,3] for the dictionary C C Author: Jeff Hamilton C E-Systems C P. O. Box 1056 C Greenville, Texas 75401 C (214)454-4175 C C Date: January 13,1982 C C Revisions: C 1.1 Include quick check (/Q) C 1.2 Include debug capability C 1.3 Include FORTRAN comment checking (/F) C 1.4 Include hyphenated words that end line C 2.0 Letter index block into virtual memory C 2.1 Recoded sections where most of the time C is spent to increase the speed. C 2.2 Include terse comments to screen (/T) C 2.3 Include numbers in tokens as valid words (/N) C 2.4 Include switch for short words (/S:x) C 2.5 Include switch for auto load of words (/L) C 2.6 Include filename for auto load switch C 2.7 Change uic from [2,2] to [3,3] to avoid C interference with some TECO library. PARAMETER (VERSN=2.7) C C This program is written in FORTRAN-77 and was developed C on a PDP-11/t55 with 6-RK05, running RSX. It's applicability C to other systems is unknown. Some of the later ideas C were stolen from the RT-11 speller from the Spring 81 RT-tape C (give credit where credit is due). This program came C from a desire on my part to have a program that could be C used to check my copy for the DECUS North Texas Local Users C Group Newsletter. The only spelling checker I could find C was the one included in the Software Tools section of C the Spring 81 RSXSIG tape. As I didn't want to build software C tools, I used the data base as a starting point for C program development. As sequential reads were too slow for the C upwards of 42,000 words in the data base, I used Marge Knox's C analysis of the file access speeds of FORTRAN-IV+ (now FORTRAN-77). C Random Access - block i/o was decided on to minimize the C time for disk io. Using Ralph Stammerjohn's Index to the C past RSXSIG tapes, I was able to come up with Phil Cannon's C routines for FCS file access to the FDB. This enabled C me to build the dictionary (using DICTMK) using random access C block io, set the size, and truncate to last block used C on exit. (see DICTMK.FTN) C As this was written when I was not nearly familiar with C F77 as I should be, it is not efficient in space. It probably C can be rewritten to speed it up too. The Spelling Checker C is written to be run from a VT52 type terminal unless C the quick check is used. (see DISPLA C subroutine. It uses standard RSX utility type prompts and C GETMCR command. The file name to be checked is entered. C Each line is read, parsed for each word and each word is checked C for spelling. The order of operation is as follows: C C End of file on input? C If so C Sort output list C Output list to file C Exit C If not C End of current line? C If so, get next line C If not C Get next word C Is word shorter than the smallest word we need to check? C If so, get next word C If not C Is the word a normal standard word (is, and, the...)? C If so get next word. C If not C Is word in misspelled previously list? C If so, correct line and get next word. C If not C Is word in previously denoted as correct list? C If so, get next word. C If not C Is word in previously denoted as correct and add to dictionary? C If so, get next word. C If not C Is word in dictionary? C If so, get next word. C If not C Is quick check being used? C If so, add word to addlist, get next word C If not C Display word and line and get command. C Is command add to dictionary (a)? C If so, add to addlist, get next word C If not C Is command next word (n)? C If so, get next word C If not C Is command exit (x)? C If so, process file as if end of document C If not C Is command exchange word (e)? C If so C Get right word C Make correction in line C Get next word C If not C Is command new line (l)? C If so C Get new line C Get first word in line C If not C Is command ignore short words (#)? C If so, set length to check to # C If not C Is command correct but do not add (c)? C If so, add to correct-list, get next word. C If not C Is command wrong spelling (w)? C If so C Get right spelling C Make correction in line C Add words to lists C Get next word C If not C Is command terse screen display (t)? C If so, from now on display less C If not C Is command verbose screen display (v)? C If so, from now on display more C If not, syntax error C C In non quick mode, as the document is checked a new C file (same name, version+1) is written with the line read, C corrections made. When a misspelled word is designated C and correction made, every occurence of that misspelling from C then on in that document will be corrected, but not reported C to the terminal. The corrections will be in lower case except C for the first letter which will be capitalized if the first C letter of the misspelled word is capitalized. Thus all C capital words (ex: RSX) cannot be corrected on line with the C spelling checker. C C To minimize reads of the disk, the structure of the random C access file (RAF) is: C Block 1 - table of contents C starting block number (N) and number of blocks (M) C for each starting letter for each word C Block N - starting block for each letter pointed to C by the table of contents C Block N-1 - index for each starting letter C first five letters of the first word in each C block used to minimize reads C C Therefore one read is done at the beginning to read the table C of contents. The index blocks for all the letters are read C and stored in virtual memory to reduce the number of reads C while processing the document. C The index block contains the first five letters of the C first word of each block that follows that has only C words with the same first letter. This is cross-referenced C to the block numbers. That block is read and depending on boundary C conditions, the previous block or next block is read. This C continues until the correct block is read and checked. C C The prototype of this program would read the document C to be checked and put each different word in a list C to be checked by the dictionary and those misspelled C written out to a file. This worked somewhat C allright for small files, but the larger the file the more C time that was spent checking against the list for each word C to insure the word was not already included. C Even small files yielded 500 different words to be checked. C This was before the index for each letter was included and C therefore checking consisted on the average of 30 reads for C each word. C C Thanks go to Conrad Schlundt of Mostek for his steering me C to 'Computer Programs for Detecting and Correcting Spelling C Errors' by James Petterson of U. T. Austin from "Communications C of the ACM" Dec, 1980. This document confirmed many of my C assumptions and helped to validate many of the stratagies involved C in the document processing. C C Note: For the quick check the list lengths are adjusted C so that the ALIST essentially becomes four times as long C as its normal size. This can be done because CLIST, WLIST, C and WLIST2 are not used and the length of ALIST will just C overlay this memory space. Thus 4*LISTLN words can be C stored. THIS IS NOT GOOD FORTRAN PROGRAMMING PRACTICE C AND SHOULD NOT BE USED AS A GENERAL RULE. C- C PARAMETER (IBUFSZ=512) !NUMBER OF BYTES IN BLOCK PARAMETER (LISTLN=100) !MAX WORDS IN LIST C LOGICAL*1 PROMPT,EOL,INLIST,INDICT,DEBUG,QUICK,FOUND,FORTRN LOGICAL*1 TERSE,NUMBER,LOAD BYTE MCRLIN(80),LINE(80),FILE(40),DFILE(32),RDLINE(80),BRWORD(25) BYTE CONTNS(IBUFSZ),LUNDAT(12),INDXS BYTE FDB(128),IN(2),COMMND,TIMFIL(10),LFILE(40) VIRTUAL INDXS(512,26) INTEGER*2 START,SIZE,IDFILE,UNIT,DIRDEV INTEGER*2 WHERE,WLISTL,CLISTL,ALISTL,IFDB,TOTLIN INTEGER*4 LOCAT(2,26),NWORDS C C THE NEXT TWO LINES MUST APPEAR AS WRITTEN BECAUSE THE C LENGTH OF ALIST MAY BE ADJUSTED TO COVER THE OTHER 4 ARRAYS C CHARACTER*25 ALIST(LISTLN),CLIST(LISTLN) CHARACTER*25 WLIST(LISTLN),WLIST2(LISTLN) C CHARACTER*25 NLIST(12) CHARACTER*25 WORD,RWORD C C EQUIVALENCES C EQUIVALENCE (LOCAT(1,1),CONTNS(1)) EQUIVALENCE (FDB(1),IFDB) EQUIVALENCE (DFILE(1),IDFILE) EQUIVALENCE (BRWORD(1),RWORD) EQUIVALENCE (LUNDAT(3),UNIT) EQUIVALENCE (LUNDAT(5),DIRDEV) C C DATA STATEMENTS C DATA START/1/SIZE/2/ DATA DFILE/'S','P','0',':','[','3',',','3',']','D','I','C','T' 1,'.','R','A','F',15*0/ DATA TIMFIL/'S','P','E','L','L','.','T','I','M',0/ DATA LFILE/40*0/ C C PROGRAM FOLLLOWS C C TO TEST THE TIMING OF THE DIFFERENT ROUTINES, UNCOMMENT THE C FOLLOWING LINE. TIMER AND TIMERX COME FROM THE SPRING 79 C RSXSIG TAPE UNDER RATFOR. THEY REQUIRE THAT THE /TR:ALL OR C AT LEAST /TR:NAMES BE USED TO FIGURE THE STATISTICS. ALSO C THE PRIORITY SHOULD BE HIGH ENOUGH SO THAT THE SAMPLING DONE C EVERY CLOCK TIC WOULD REPRESENT A CORRECT ANALYSIS. C C CALL TIMER(TIMFIL) !TIME THE ROUTINES C CALL ERRSET(29,.TRUE.,.FALSE.,.TRUE.,.FALSE.,15) !NO SUCH FILE DEBUG=.FALSE. PROMPT=.FALSE. FOUND=.FALSE. QUICK=.FALSE. LOADLN=0 CALL GETMCR(MCRLIN,IDS) IF(IDS.GT.0)CALL GETFIL(MCRLIN,FILE,FOUND,QUICK 1,FORTRN,TERSE,NUMBER,LOWEST,LOAD,LFILE) IF(FOUND)GO TO 10 5 WRITE(5,101) READ(5,100,END=70)IDS,(MCRLIN(I),I=5,IDS+5) PROMPT=.TRUE. MCRLIN(1)='S' MCRLIN(2)='P' MCRLIN(3)='E' MCRLIN(4)=' ' CALL GETFIL(MCRLIN,FILE,FOUND,QUICK 1,FORTRN,TERSE,NUMBER,LOWEST,LOAD,LFILE) IF(.NOT.FOUND)GO TO 5 10 CONTINUE C C ADJUST LENGTH OF ALIST SINCE WE WILL BE USING ONLY THIS C LIST. ** NOT GOOD PROGRAMMING PRACTICE ** C LISTLL=LISTLN IF(QUICK)LISTLL=LISTLN*4 ALISTL=0 WLISTL=0 CLISTL=0 CALL FNDNOR(NLIST,NLISTL,LNLIST) !LOAD THE NORMAL LIST CALL ASNLUN(4,'SY',0) !USE CURRENT SY: CALL ASNLUN(1,'SY',0) !USE CURRENT SY: C C IF AUTO LOAD SWITCH THEN OPEN LOAD FILE AND PUT WORDS C FROM FILE INTO ADD LIST. IF NO FILE CONTINUE. IF NUMBER C OF WORDS IN LOAD FILE GREATER THAN LISTLN GO TO QUICK MODE. C IF(LOAD)THEN OPEN(UNIT=1,FILE=LFILE,STATUS='OLD' 1 ,CARRIAGECONTROL='LIST',READONLY,ERR=8) 7 READ(1,104,END=9)WORD IF(ALISTL.GT.LISTLL)THEN IF(ALISTL.GT.4*LISTLN)THEN WRITE(5,119) CALL EXIT END IF LISTLL=LISTLN*4 QUICK=.TRUE. WRITE(5,116) END IF CALL ADDLST(ALIST,ALISTL,WORD,LISTLL) GO TO 7 8 WRITE(5,117)LFILE GO TO 19 9 CLOSE(UNIT=1) LOADLN=ALISTL 19 CONTINUE END IF C C FILL IN THE DEVICE ATTACHED TO LUN=2 INTO THE C FILE NAME OF THE DICTIONARY FILE. THIS IS SET IN C THE TASKBUILD FILE. IT MUST BE DONE SINCE THE PARSE C ROUTINE BELOW WILL FILL IN SY0: FOR THE DEVICE IF THE C DEVICE IS NOT GIVEN. C CALL GETLUN(2,LUNDAT,IDS) DFILE(1)=LUNDAT(1) DFILE(2)=LUNDAT(2) UNIT=IAND(UNIT,7) DIRDEV=IAND(DIRDEV,8) IF(DIRDEV.EQ.0)THEN WRITE(5,112) CALL EXIT END IF ENCODE(1,109,DFILE(3))UNIT C C IF THERE IS AN ERROR IN THE EXECUTION OF THIS PROGRAM THE C NEW FILE WILL BE DELETED AND THE OLD ONE KEPT, IF THERE C IS NO ERROR THEN THE OLD ONE WILL BE DELETED AND THE NEW C ONE KEPT. C OPEN(UNIT=4,FILE=FILE,STATUS='OLD',CARRIAGECONTROL='LIST' 1,ERR=80) IF(.NOT.QUICK)THEN TOTLIN=0 11 READ(4,100,END=12)NN,(LINE(I),I=1,NN) TOTLIN=TOTLIN+1 GO TO 11 12 REWIND(4) END IF CALL CLEAR(LINE,80) IF(.NOT.QUICK)OPEN(UNIT=1,FILE=FILE,STATUS='NEW' 1,CARRIAGECONTROL='LIST',DISPOSE='DELETE') CALL INIT(FDB) !CLEAR FDB FOR RAF IN(1)=1 !READONLY IN(2)=1 !BLOCK MODE CALL PARSE(FDB,DFILE,2) !PUT NAME AND LUN=2 INTO FDB IER=0 !MAKE SURE NO ERROR CALL FIND(FDB,IER) !FILE EXIST? IF(IER.LT.0)GO TO 60 !NO CALL OFID(FDB,IN,2,IER) !OPEN BY FILE ID IF(IER.LT.0)GO TO 65 !ERROR DURING OPEN CALL DABRD(FDB,CONTNS,IBUFSZ,1,NBT,IER) !READ INDEX IF(DEBUG)WRITE(5,113) CALL INDXFL(INDXS,LOCAT,FDB) !FILL THE INDEX BLOCKS IN VM LINRED=0 !NUMBER OF LINES READ NWORDS=0 !NUMBER OF WORDS PROCESSED C C**** GET NEXT LINE C 15 READ(4,100,END=50)NL,(LINE(I),I=1,NL) !GET NEW LINE LINRED=LINRED+1 !HOW MANY LINES WE READ IF(LINE(1).NE.'C'.AND.FORTRN)GO TO 15 !ONLY DO COMMENTS IN FORTRAN DO 20,I=1,NL !COPY LINE FOR USE LATER ON 20 RDLINE(I)=LINE(I) NLR=NL IF(DEBUG)WRITE(5,114) IF(NL.EQ.0)GO TO 15 !EMPTY LINES ARE IGNORED CALL LOWER(LINE,NL) !MAKE LOWER CASE FOR CHECKING IPNTR=1 !BEGINING OF LINE C C**** GET NEXT WORD C 25 CALL GETWRD(LINE,NL,WORD,NW,IPNTR,EOL,DEBUG,FORTRN,NUMBER) IF(EOL)THEN !END-OF-LINE? IF(.NOT.QUICK)WRITE(1,100)NLR,(RDLINE(I),I=1,NLR)!YES, WRITE OUT IF(NL.GT.0)CALL CLEAR(LINE,NL) !CLEAR OUT BUFFER IF(NLR.GT.0)CALL CLEAR(RDLINE,NLR) !CLEAR OUT BUFFER GO TO 15 !GET NEXT LINE END IF NWORDS=NWORDS+1 !HOW MANY WORDS PROCESSED IF(NW.LE.LOWEST)GO TO 25 !IGNORE THE SMALLER WORDS IF(DEBUG)WRITE(5,115)LOWEST,NW C C IS WORD IN THE NORMAL LIST? C IF(NW.LE.LNLIST)THEN !IF WORD>LONGEST WORD, NOT IN CALL CKLIST(NLIST,NLISTL,WORD,INLIST,WHERE) IF(INLIST)GO TO 25 !GET NEXT WORD END IF C C IS WORD IN THE WRONG LIST? C IF(WLISTL.GT.0)THEN CALL CKLIST(WLIST,WLISTL,WORD,INLIST,WHERE) IF(INLIST)THEN CALL CRCTLN(RDLINE,NLR,WORD,WLIST2,WHERE 1 ,DEBUG) !CORRECT LINE GO TO 25 !GET NEXT WORD END IF END IF C C IS WORD IN THE CORRECT BUT DON'T ADD TO DICT LIST? C 30 IF(CLISTL.GT.0)THEN CALL CKLIST(CLIST,CLISTL,WORD,INLIST,WHERE) IF(INLIST)GO TO 25 !GET NEXT WORD END IF C C IS THE WORD IN THE CORRECT AND ADD TO THE DICT LIST? C IF(ALISTL.GT.0)THEN CALL CKLIST(ALIST,ALISTL,WORD,INLIST,WHERE) IF(INLIST)GO TO 25 !GET NEXT WORD END IF C C WORD IS NOT IN ANY LISTS, THEREFORE CHECK THE DICTIONARY. C CALL CKDICT(FDB,LOCAT,WORD,INDICT,DEBUG,INDXS) IF(INDICT)GO TO 25 !GET NEXT WORD C C OK, WORD IS NOT FOUND C IF(QUICK)THEN CALL ADDLST(ALIST,ALISTL,WORD,LISTLL) GO TO 25 !GET NEXT WORD END IF C C DISPLAY SCREEN INFO IN EITHER TERSE OR VERBOSE MODES C AND GET THE COMMAND. C 35 CALL DISPLA(RDLINE,NLR,WORD,COMMND,LINRED,TOTLIN 1,NWORDS,ALISTL,CLISTL,WLISTL,DEBUG,VERSN,TERSE) C C PROCESS COMMAND C IF(COMMND.EQ.'a')THEN !WORD IS RIGHT AND ADD TO DICT CALL ADDLST(ALIST,ALISTL,WORD,LISTLL)!ADD TO LIST GO TO 25 !NEXT WORD ELSE IF(COMMND.EQ.'n')THEN !NEXT WORD GO TO 25 ELSE IF(COMMND.EQ.'x')THEN !EXIT GO TO 50 ELSE IF(COMMND.EQ.'e')THEN !EXCHANGE WORD WRITE(5,107) READ(5,100,END=50)NBRW,(BRWORD(I),I=1,NBRW)!GET CORRECT WORD CALL CRCTLN(RDLINE,NLR,WORD,BRWORD,1,DEBUG)!CORRECT LINE WORD=RWORD !CHECK THIS WORD GO TO 30 ELSE IF(COMMND.EQ.'l')THEN !NEW LINE 40 WRITE(5,108) !PROMPT READ(5,100,END=50)NL,(LINE(I),I=1,NL) !GET NEW LINE IF(NL.EQ.0)GO TO 40 !AT LEAST SOMETHING DO 45,I=1,NL !MAKE COPY 45 RDLINE(I)=LINE(I) NLR=NL CALL LOWER(LINE,NL) !MAKE ALL LOWER CASE IPNTR=1 !RESET POINTER TO START GO TO 25 !GET NEXT WORD ELSE IF(COMMND.EQ.'c')THEN !CORRECT BUT DON'T ADD CALL ADDLST(CLIST,CLISTL,WORD) !ADD TO LIST GO TO 25 !NEXT WORD ELSE IF(COMMND.EQ.'w')THEN !WRONG SPELLING WRITE(5,105) !PROMPT FOR RIGHT WORD CALL CLEAR(BRWORD,25) !GET RID OF LAST ONE READ(5,100,END=50)NBRW,(BRWORD(I),I=1,NBRW)!GET CORRECT SPELLING CALL ADDLST(WLIST,WLISTL,WORD,LISTLL) !ADD TO WRONG LIST N=WLISTL-1 !WLISTL WAS CHANGED CALL ADDLST(WLIST2,N,RWORD,LISTLL) !ADD TO RIGHT LIST CALL CRCTLN(RDLINE,NLR,WORD,WLIST2,WLISTL,DEBUG) WORD=RWORD !CHECK NEW WORD GO TO 30 !TEST NEW WORD ELSE IF(COMMND.GE.'1'.AND.COMMND.LT.'9')THEN DECODE(1,109,COMMND)LOWEST !SET SMALLEST WORD GO TO 30 !GET NOTHER COMMAND ELSE WRITE(5,106) !SYNTAX ERROR CALL MARK(6,2,2) !SET EFN=6 AFTER 2 SECONDS CALL STOPFR(6) !WAIT FOR EFN=6 GO TO 35 !GET RIGHT COMMAND END IF C C FINISHED WITH THE DOCUMENT C 50 CONTINUE CALL CLOS(FDB) !CLOSE RAF IF(.NOT.QUICK)CLOSE(UNIT=1,ERR=60,DISPOSE='KEEP') IF(QUICK)CLOSE(UNIT=1,DISPOSE='DELETE') IF(.NOT.QUICK)CLOSE(UNIT=4,DISPOSE='DELETE') IF(QUICK)CLOSE(UNIT=4,DISPOSE='KEEP') IF(ALISTL-LOADLN.GT.0)THEN !WRITE WORDS TO BE ADDED CALL SORT(ALIST(LOADLN+1),ALISTL-LOADLN)!SORT IN ALPHA ORDER IF(QUICK)OPEN(UNIT=4,FILE='SPELL.WRD',STATUS='NEW' 1 ,CARRIAGECONTROL='LIST') IF(.NOT.QUICK)OPEN(UNIT=4,FILE='DICT.ADD',STATUS='NEW' 1 ,CARRIAGECONTROL='LIST') DO 55,I=1+LOADLN,ALISTL 55 WRITE(4,104)ALIST(I) CLOSE(UNIT=4) IF(QUICK)WRITE(5,110) !TELL WHICH ONE IF(.NOT.QUICK)WRITE(5,111) !...WAS WRITTEN END IF IF(PROMPT)GO TO 5 !GET NOTHER FILENAME CALL EXIT 60 WRITE(5,102) CALL EXIT 65 WRITE(5,103)IER 70 CALL EXIT 80 WRITE(5,117)FILE CALL EXIT 100 FORMAT(Q,80A1) 101 FORMAT(/,'$SPE>') 102 FORMAT(' SPE - DICTIONARY FILE NOT FOUND') 103 FORMAT(' SPE - ERROR OPENING DICT = ',I6) 104 FORMAT(A25) 105 FORMAT('$Correction>>') 106 FORMAT(' SPE - SYNTAX ERROR') 107 FORMAT('$Exchange>>') 108 FORMAT('$New line>>') 109 FORMAT(I1) 110 FORMAT(' SPE - NOT FOUND WORDS SAVED IN SPELL.WRD') 111 FORMAT(' SPE - ADD WORDS SAVED IN DICT.ADD') 112 FORMAT(' SPE - LUN=2 NOT DIRECTORY DEVICE') 113 FORMAT(1X,'FILE OPEN') 114 FORMAT(1X,'LINE READ') 115 FORMAT(1X,'LWST=',I2,/,1X,'NW=',I2) 116 FORMAT(' SPE - SPELL.DCT > LISTLN; QUICK WILL BE USED.') 117 FORMAT(' SPE - ',40A1,' NOT FOUND') 119 FORMAT(' SPE - SPELL.DCT > LISTLL. SPELL EXITING') END SUBROUTINE STUFF(ARRAY,LENGTH,CHAR) C+ C SUBROUTINE STUFF WILL STUFF LENGTH CHARS INTO THE C ARRAY OF LENGTH BYTES. C ALTERNATE ENTRY POINTS ARE CLEAR WHICH SETS ELEMENTS C TO NULLS, AND BLANK WHICH SETS ELEMENTS TO SPACES. C C SUBROUTINE BLANK WILL TAKE ARRAY OF LENGTH LENGTH BYTES C AND PUT A BLANK IN EACH OF THE POSITIONS. TO BE USED C WITH THE F77 STRING PROCESSING FUNCTIONS. READ, AND ASSIGN C USING STRINGS WILL FILL TO THE RIGHT WITH BLANKS, THUS C BYTE ARRAYS WILL NEED BLANKS INSTEAD OF NULLS IN POSITIONS C FOR COMPARING STRINGS. THIS MANIFESTED ITSELF WITH THE C WORD 'it' NOT BEING FOUND IN DICTIONARY OR IN NORMAL LIST. C F77 STRINGS ARE NICE FOR SOME OF THEIR FEATURES, BUT C THEIR RESTRICTIONS CAUSE PROBLEMS. A STRING CAN NOT HAVE C MORE THAN 255 CHARACTERS. PICKING OUT WORDS FROM A LONG C STRING WITH SPACES IN BETWEEN THE WORDS IS NOT AS EASY AS C USING IPOS WITH A SEARCH FOR A SPACE AS THE SECOND SPACE C WILL NOT BE USED UNLESS SOME TRICKS ARE PLAYED. IF YOU READ C WITH A CHAR*25 AND READ ONLY 4 CHAR (FROM A FILE OR KEYBOARD) C THE 21 CHAR TO THE RIGHT WILL BE FILLED WITH BLANKS. USING C THE LEN CHAR FUNCT WILL PRODUCE A LENGTH OF 25 EVEN THOUGH C ONLY 4 CHAR WERE INPUT. OTHER PROBLEMS OCCUR UNLESS YOU ARE C AWARE OF THE INTERNAL STRUCTURE AND LIMITATIONS OF THE F77 C CHAR TYPE. (VIRTUAL ARRAYS CAN NOT HAVE CHAR TYPE.) C- BYTE ARRAY(LENGTH),CHAR GO TO 10 ENTRY CLEAR(ARRAY,LENGTH) CHAR='0'O GO TO 10 ENTRY BLANK(ARRAY,LENGTH) CHAR=' ' 10 CONTINUE DO 20,I=1,LENGTH 20 ARRAY(I)=CHAR RETURN END SUBROUTINE LOWER(X,N) C+ C SUBROUTINE LOWER WILL CHANGE UPPER CASE LETTERS C IN A STRING X OF N CHARACTERS TO LOWER CASE C- BYTE X(N) DO 10,I=1,N IF(X(I).GE.'A'.AND.X(I).LE.'Z')X(I)=X(I)+'40'O 10 CONTINUE RETURN END SUBROUTINE GETFIL(MCRLIN,FILE,FOUND,QUICK,FORTRN 1,TERSE,NUMBER,LOWEST,LOAD,LFILE) C+ C SUBROUTINE GETFIL WILL FIND THE FILE STRING C WITH THE FILE NAME FROM THE MCRLINE. FOUND C IS SET TRUE IF THERE IS A VALID FILE NAME IN C THE STRING. C SWITCHES THAT ARE USED: C /Q RUN IN QUICK MODE (NO TERMINAL IO) C /F INPUT IS A FORTRAN SOURCE, CHECK C THE 'C' COMMENTS ONLY C /T TERSE DISPLAY NOTHING EXTRA BUT C WORD AND LINE C /N NUMBERS IN TOKENS ARE VALID C /S:X DO NOT CHECK WORDS LE X CHAR C /L:filename PRE LOAD ADD LIST WITH filename.DCT IF C filename GIVEN OR 'SPELL.DCT' IF C /L ALONE. C C- INTEGER*2 LOWEST LOGICAL*1 FOUND,QUICK,FORTRN,NUMBER,TERSE,LOAD BYTE FILE(40),MCRLIN(80),LFILE(40) FOUND=.FALSE. QUICK=.FALSE. FORTRN=.FALSE. TERSE=.FALSE. NUMBER=.FALSE. LOAD=.FALSE. IEND=1 ISTRT=1 DO 10,I=1,80 IF(MCRLIN(I).GE.'a'.AND.MCRLIN(I).LE.'z') 1 MCRLIN(I)=MCRLIN(I)-'40'O !MAKE UPPER CASE IF(MCRLIN(I).EQ.' '.AND.ISTRT.EQ.1)ISTRT=I+1 IF(MCRLIN(I).EQ.'/' 1.OR.MCRLIN(I).EQ.';'.OR.MCRLIN(I).EQ.'11'O 2.OR.MCRLIN(I).EQ.'15'O.OR.MCRLIN(I).EQ.'0'O)THEN IF(IEND.EQ.1)IEND=I-1 IF(MCRLIN(I).EQ.'/')THEN IF(MCRLIN(I+1).EQ.'Q')QUICK=.TRUE. IF(MCRLIN(I+1).EQ.'F')FORTRN=.TRUE. IF(MCRLIN(I+1).EQ.'T')TERSE=.TRUE. IF(MCRLIN(I+1).EQ.'N')NUMBER=.TRUE. IF(MCRLIN(I+1).EQ.'L')THEN LOAD=.TRUE. CALL GETLOD(MCRLIN(I+1),LFILE) END IF IF(MCRLIN(I+1).EQ.'S')DECODE(1,101 1 ,MCRLIN(I+3))LOWEST END IF IF(MCRLIN(I).EQ.';')THEN WRITE(5,100) CALL EXIT END IF END IF 10 CONTINUE IF(ISTRT.EQ.1.OR.IEND.EQ.1)RETURN DO 50,I=ISTRT,IEND 50 FILE(I-ISTRT+1)=MCRLIN(I) FILE(IEND+1)='0'O FOUND=.TRUE. RETURN 100 FORMAT(1X,'SPE - VERSION NUMBER NOT ALLOWED') 101 FORMAT(I1) END SUBROUTINE GETLOD(LINE,FILE) C+ C SUBROUTINE GETLOD WILL SEARCH THE COMMAND LINE FOR THE AUTOLOAD C FILENAME. IF FOUND IT WILL PUT IT IN THE FILE, IF NOT C SPELL.DCT WILL BE PUT IN IT. C- BYTE FILE(40),LINE(80),DEFALT(10) DATA DEFALT/'S','P','E','L','L','.','D','C','T',0/ C IF(LINE(2).EQ.':')THEN IF(LINE(3).GE.'A'.AND.LINE(3).LE.'Z')THEN K=0 DO 5,J=3,12 IF(LINE(J).LT.'A'.OR.LINE(J).GT.'Z')GO TO 6 K=K+1 FILE(K)=LINE(J) 5 CONTINUE 6 FILE(K+1)='.' FILE(K+2)='D' FILE(K+3)='C' FILE(K+4)='T' FILE(K+5)='0'O ELSE WRITE(5,100) GO TO 8 END IF ELSE GO TO 8 END IF RETURN 8 CONTINUE DO 10,K=1,10 10 FILE(K)=DEFALT(K) RETURN 100 FORMAT(' SPE - AUTO LOAD FILENAME ERROR') END SUBROUTINE FNDNOR(NLIST,NLISTL,LONGST) C+ C SUBROUTINE FNDNOR WILL FILL THE NORMAL LIST WITH C WORDS THAT ARE ENCOUNTERED FREQUENTLY WHEN PROCESSING C MOST NORMAL DOCUMENTS. THIS LIST COMES FROM THE "BOOK C OF LISTS" WHICH REFERENCES "AMERICAN HERITAGE WORD C FREQUENCY BOOK" OF 1971. C C NLISTL LENGTH OF LIST IF LESS THAN 12 C LONGST NUMBER OF CHARACTERS IN LONGEST WORD IN LIST C (NO USE CHECKING WORD IF IT HAS MORE LETTERS C THAN THE LONGEST WORD IN THE LIST.) C- CHARACTER*25 NLIST(12) C NLIST(1)='the' NLIST(2)='of' NLIST(3)='and' NLIST(4)='a' NLIST(5)='to' NLIST(6)='in' NLIST(7)='is' NLIST(8)='you' NLIST(9)='that' NLIST(10)='it' NLIST(11)='he' NLIST(12)='for' NLISTL=12 LONGST=4 RETURN END SUBROUTINE INDXFL(INDXS,LOCAT,FDB) C+ C SUBROUTINE INDXFL WILL FILL THE INDXES VIRTUAL ARRAYS FROM C THE DICTIONARY RAF FILE. C- PARAMETER (IBUFSZ=512) VIRTUAL INDXS(512,26) BYTE INDXS,FDB(128),BUFFER(IBUFSZ) INTEGER START,SIZE,IB INTEGER*4 LOCAT(2,26) EQUIVALENCE (IB,BUFFER(1)) DATA START/1/SIZE/2/ C DO 10,I=1,26 BUFNUM=LOCAT(START,I) NUMBUF=LOCAT(SIZE,I) LETBLK=BUFNUM-1 CALL DABRD(FDB,BUFFER,IBUFSZ,LETBLK,NBT,IER) IF(IER.LT.0)WRITE(5,100)IER DO 5,J=1,IBUFSZ 5 INDXS(J,I)=BUFFER(J) 10 CONTINUE RETURN 100 FORMAT(' SPE - INDXFL ERR=',I6) END SUBROUTINE GETWRD(LINE,NL,WORD,NW,IPNTR,EOL 1,DEBUG,FORTRN,NUMBER) C+ C SUBROUTINE GETWRD WILL RETURN THE NEXT WORD FROM THE C LINE OR EOL=.TRUE. IF END-OF-LINE C RUNOFF COMMAND LINES ARE PROCESSED TO THE EXTENT C THAT THE RUNOFF COMMANDS ARE NOT CHECKED BUT EVERYTHING C AFTER THE ';' IS CHECKED IF IT OCCURS ON A RUNOFF COMMAND C LINE. C C VARIABLE DEFINITIONS: C C LINE 80 BYTE LINE CONTAINING CURRENT LINE C FROM DOCUMENT. C NL LENGTH OF LINE IN BYTES C WORD NEXT CHAR*25 RETURNED TO CALLER C NW NUMBER OF BYTES IN WORD C IPNTR POINTER TO CURRENT POSITION IN LINE C EOL LOGICAL*1 IF END-OF-LINE C DEBUG THE DEBUG VARIABLE C FORTRN THE FORTRAN VARIABLE C NUMBER THE NUMBERS ARE ALL RIGHT VARIABLE C C CALL CLEAR TO CLEAR ARRAY WORD C C LOCAL VARIABLES: C C WDSTRT THE STARTING POSITION IN THE LINE OF NEXT WORD C WDEND THE ENDING POSITION IN THE LINE OF CURRENT WORD C HYPHEN DEFINES WHETHER LAST WORD ON PREVIOUS LINE WAS - C HPNTR POINTS TO BEGINNING OF WORD IF NOT HYPHEN, POINTS C TO CONTINUATION SPOT IF HYPHEN C- LOGICAL*1 EOL,DEBUG,FORTRN,HYPHEN,NUMBER BYTE LINE(80),WORD(25) INTEGER WDSTRT,WDEND,HPNTR DATA HYPHEN /.FALSE./ C EOL=.FALSE. WDSTRT=1 IF(LINE(1).EQ.'.'.AND.IPNTR.EQ.1)THEN !PROCESS RNO COMMAND LINES DO 10,I=1,NL IF(LINE(I).EQ.';')THEN IPNTR=I+1 GO TO 20 END IF 10 CONTINUE GO TO 50 END IF 20 CONTINUE IF(HYPHEN)THEN HPNTR=NW HYPHEN=.FALSE. ELSE HPNTR=1 END IF DO 30,I=IPNTR,NL IF(FORTRN.AND.I.EQ.1)GO TO 30 IF((LINE(I).GE.'a'.AND.LINE(I).LE.'z').OR. 1((LINE(I).GE.'0'.AND.LINE(I).LE.'9').AND.NUMBER))THEN WDSTRT=I GO TO 40 END IF 30 CONTINUE 40 IF(I.GT.NL.OR.IPNTR.GT.NL)THEN 50 IF(DEBUG)WRITE(5,101) EOL=.TRUE. RETURN ELSE DO 60,J=WDSTRT,NL+1 IF(LINE(J).EQ.' '.OR.LINE(J).EQ.'11'O 1 .OR.LINE(J).EQ.','.OR.LINE(J).EQ.'.' 2 .OR.LINE(J).EQ.';'.OR.LINE(J).EQ.':' 3 .OR.LINE(J).EQ.'?'.OR.LINE(J).EQ.'/' 4 .OR.LINE(J).EQ.'!'.OR.LINE(J).EQ.'(' 5 .OR.LINE(J).EQ.')'.OR.LINE(J).EQ.'_' 6 .OR.J.EQ.NL+1)THEN WDEND=J-1 IPNTR=J GO TO 70 END IF 60 CONTINUE 70 CONTINUE DO 80,K=WDSTRT,WDEND IF(LINE(K).GE.'a'.AND.LINE(K).LE.'z' 1 .OR.((LINE(K).GE.'0'.AND.LINE(K).LE.'9').AND.NUMBER) 2 .OR.(LINE(K).EQ.'-'.OR.LINE(K).EQ.'47'O))THEN !FOR HYPHEN WORD(K-WDSTRT+HPNTR)=LINE(K) !OR "'" IF(LINE(K).EQ.'-'.AND.K.EQ.NL) 1 HYPHEN=.TRUE. !IF EOL AND - ELSE GO TO 20 END IF 80 CONTINUE END IF NW=WDEND-WDSTRT+1 DO 90,K=NW+1,25 90 WORD(K)=' ' IF(DEBUG)THEN WRITE(5,103)WORD WRITE(5,102) END IF RETURN 100 FORMAT(1X,80A1,/,1X,25A1) 101 FORMAT(' EXIT GETWRD EOL') 102 FORMAT(' EXIT GETWRD NO EOL') 103 FORMAT(' WORD=',A25) END SUBROUTINE CKLIST(LIST,LENGTH,WORD,INLIST,WHERE) C+ C SUBROUTINE CKLIST WILL CHECK 'LIST' OF LENGTH 'LENGTH' C TO SEE IF 'WORD' IS IN IT. IF SO INLIST=.TRUE. AND C 'WHERE' WILL BE THE LIST ELEMENT NUMBER. C- INTEGER*2 WHERE LOGICAL*1 INLIST CHARACTER*25 LIST(LENGTH),WORD C INLIST=.FALSE. WHERE=0 DO 10,I=1,LENGTH IF(WORD.EQ.LIST(I))THEN INLIST=.TRUE. WHERE=I RETURN END IF 10 CONTINUE RETURN END SUBROUTINE CRCTLN(LINE,NL,WORD,WLIST2,WHERE,DEBUG) C+ C SUBROUTINE CRCTLN WILL CORRECT THE GIVEN LINE SO C THAT THE MISSPELLED WORD WILL BE REPLACED WITH C THE CORRECT WORD FROM THE LIST WLIST2. C C LINE LINE TO BE CORRECTED C NL LENGTH OF LINE IN BYTES C WORD MISSPELLED WORD C WLIST2 LIST OF CORRECTIONS THAT CAN BE MADE C WHERE THE ELEMENT IN WLIST2 TO BE USED IN PLACE OF WORD C C- CHARACTER*25 WORD,CLINE*80,LETTER*1,BWORD INTEGER*2 WHERE BYTE LINE(NL),BLINE(80),NLINE(80),BWRDB(25) BYTE WLIST2(25,100) !IN MAIN 100 WORDS/LIST LOGICAL*1 CAPTAL,DEBUG,FIRST EQUIVALENCE (BLINE(1),CLINE) EQUIVALENCE (BWORD,BWRDB(1)) C CAPTAL=.FALSE. FIRST=.TRUE. CALL CLEAR(BLINE,80) DO 10,I=1,NL 10 BLINE(I)=LINE(I) 5 CALL LOWER(BLINE,NL) ILENW=INDEX(WORD,' ')-1 IF(ILENW.EQ.0)ILENW=25 IF(DEBUG)WRITE(5,100)CLINE,WORD IPOS=INDEX(CLINE,WORD(1:ILENW)) !WHERE WORD IS IN LINE IF(IPOS.EQ.0)THEN !WORD NOT IN LINE? IF(FIRST)THEN !MAYBE WORD IS UPPER CALL LOWER(WORD,25) FIRST=.FALSE. !TRY AGAIN GO TO 5 END IF WRITE(5,101) !2ND TIME WE GOT PROBM RETURN END IF IF(LINE(IPOS).LE.'132'O)CAPTAL=.TRUE. !WORD IS CAPITALIZED DO 6,I=1,25 IF(WLIST2(I,WHERE).EQ.'0'O)THEN ILENR=I !HOW LONG RIGHT WORD GO TO 7 END IF 6 BWRDB(I)=WLIST2(I,WHERE) ILENR=25 !LONGER THAN LOOP? C C NOW COPY LINE UP TO WRONG WORD, INSERT RIGHT WORD, AND COPY REST C OF THE LINE. C 7 J=0 !NEW LINE POSITION DO 20,I=1,IPOS-1 !COPY UNTIL WRONG WORD J=J+1 20 NLINE(J)=LINE(I) DO 30,I=1,ILENR !COPY RIGHT WORD J=J+1 NLINE(J)=WLIST2(I,WHERE) IF(CAPTAL.AND.I.EQ.1 1.AND.NLINE(J).GE.'a'.AND.NLINE(J).LE.'z') 2NLINE(J)=NLINE(J)-'40'O !CAPITAL IF WRNG WRD WAS CAPITAL 30 CONTINUE DO 40,I=ILENW+IPOS,NL !COPY REST OF LINE J=J+1 40 NLINE(J)=LINE(I) LAST=J DO 50,I=1,LAST !RECOPY LINE 50 LINE(I)=NLINE(I) NL=LAST !ADJUST LENGTH SHOWN RETURN 100 FORMAT(' CL=',80A1,/,' WORD=',A25) 101 FORMAT(' PROBLEM IN CRCTLN') END SUBROUTINE CKDICT(FDB,LOCAT,WORD,INDICT,DEBUG,INDXS) C+ C SUBROUTINE CKDICT WILL CHECK THE DICTIONARY TO SEE IF THE C WORD GIVEN IS THERE. INDICT IS SET ACCORDING TO THE RESULT. C C FDB IS THE FILE DESCRIPTOR BLOCK FOR THE RAF. C LOCAT IS THE TABLE OF CONTENTS SET UP BE FIRST READ AFTER C RAF IS OPENED. (BLOCK=1) C- PARAMETER (IBUFSZ=512) PARAMETER (MAXDIC=125) LOGICAL*1 INDICT,DEBUG,PRVS VIRTUAL INDXS(512,26) BYTE INDXS BYTE FDB(128),LETBUF(IBUFSZ) CHARACTER*25 WORD,LETTER*1,DCTWRD(MAXDIC) INTEGER*4 LOCAT(2,26) INTEGER*2 START,SIZE,BUFNUM,LBUF,IBUF EQUIVALENCE (LBUF,LETBUF(1)) DATA START/1/SIZE/2/ C INDICT=.FALSE. PRVS=.FALSE. LETTER=WORD(1:1) !GET FIRST LETTER K=INDX(LETTER) !INDEX VALUE IF(K.LT.1.OR.K.GT.26)RETURN !MUST START WITH LETTER IF(DEBUG)WRITE(5,1001)LETTER BUFNUM=LOCAT(START,K) !WHERE BUFFER STARTS NUMBUF=LOCAT(SIZE,K) !LENGTH THIS LETTER IN BLOCKS LETBLK=BUFNUM-1 !BLOCK NUMBER OF LETTER INDEX IF(DEBUG)WRITE(5,1002)BUFNUM,NUMBUF,LETBLK DO 5,I=1,IBUFSZ !LOAD CORRECT 5 LETBUF(I)=INDXS(I,K) !...LETTER BUFFER M=IRDBLK( LETBUF, WORD, DEBUG ) +LETBLK !M=BLOCK IT IS IN IF(DEBUG)WRITE(5,1003)M CALL GET(FDB,M,DCTWRD,NUMWRD,MAXDIC) !LOAD DICT LIST WITH BLK M 10 CONTINUE IF(DEBUG)THEN WRITE(5,1000)1,DCTWRD(1) WRITE(5,1000)NUMWRD,DCTWRD(NUMWRD) END IF IF(LLT(WORD,DCTWRD(1)))THEN !IF LT 1ST WORD, PREVIOUS BLK IF(DEBUG)WRITE(5,1004)1 IF(M.LE.BUFNUM)GO TO 40 !BEFORE FIRST WORD OF THIS LET M=M-1 !TRY PREVIOUS PRVS=.TRUE. !WE READ A PREVIOUS BLOCK CALL GET(FDB,M,DCTWRD,NUMWRD,MAXDIC)!LOAD DICT LIST WITH BLK M IF(LGT(WORD,DCTWRD(NUMWRD)))THEN!IF GT THAN LAST WORD, NOT HERE IF(DEBUG)WRITE(5,1005)1 GO TO 40 !NOT HERE ELSE GO TO 10 !TEST THE BLOCK WE READ END IF END IF 20 CONTINUE IF(LGT(WORD,DCTWRD(NUMWRD)))THEN !IF GT LAST WORD, NEXT BLOCK IF(DEBUG)WRITE(5,1004)2 IF(PRVS)GO TO 40 !NXT BLK ALRDY USD, SO NOT FOUND IF(M.GE.BUFNUM+NUMBUF-1)GO TO 40!AFTER LAST WORD THIS LETTER M=M+1 !TRY NEXT BUFFER CALL GET(FDB,M,DCTWRD,NUMWRD,MAXDIC) IF(LLT(WORD,DCTWRD(1)))THEN !IF LT 1ST WRD, NOT HERE IF(DEBUG)WRITE(5,1005)2 GO TO 40 !NOT IN DICT ELSE GO TO 10 !RETEST THIS BLOCK END IF END IF C C THEREFORE WORD SHOULD BE IN THIS BLOCK OF WORDS C DO 30,K=1,NUMWRD !CHECK THEM ALL IF(DEBUG)WRITE(5,1000)K,DCTWRD(K) IF(WORD.EQ.DCTWRD(K))THEN IF(DEBUG)WRITE(5,1006)WORD INDICT=.TRUE. !FOUND!!! RETURN END IF IF(LLT(WORD,DCTWRD(K)))THEN IF(DEBUG)WRITE(5,1005)3 GO TO 40 !NOT FOUND END IF 30 CONTINUE IF(DEBUG)WRITE(5,1005)4 !NOT FOUND 40 IF(DEBUG)WRITE(5,1007) RETURN 1000 FORMAT(' DCTWRD(',I3,')=',A25) 1001 FORMAT(' LETTER=',A1) 1002 FORMAT(' B,N,L=',3(I3,2X)) 1003 FORMAT(' M=',I3) 1004 FORMAT(' TEST TRUE #',I1) 1005 FORMAT(' ?',I1) 1006 FORMAT(' *** ',A25,' FOUND ***') 1007 FORMAT(' ',A25,' NOT FOUND') END FUNCTION INDX(A) C+ C FUNCTION INDX WILL RETURN THE NUMBER OF THE LETTER OF THE ALPHABET C a=1 b=2 c=3 A=1 C=3 etc. C- BYTE A INDX=0 IF(A.GE.'A'.AND.A.LE.'Z')INDX=A-'A'+1 IF(A.GE.'a'.AND.A.LE.'z')INDX=A-'a'+1 RETURN END FUNCTION IRDBLK( LIST ,WORD ,DEBUG ) C+ C FUNCTION IRDBLK WILL RETURN THE BLOCK NUMBER TO READ GIVEN THE C LETTER INDEX READ FROM THE DISK FILE. C C ONLY 102 LISTINGS ARE POSSIBLE (102*(5 LETTERS)) <512 C- BYTE LIST(5,102) CHARACTER*25 WORD CHARACTER*5 CFRAG BYTE BFRAG(5) LOGICAL*1 DEBUG EQUIVALENCE (CFRAG,BFRAG(1)) C DO 30,I=2,102 !CHECK ALL THE POSITIONS IF(LIST(1,I).EQ.'0'O)GO TO 40 !NULL ENDS LIST CALL CLEAR(BFRAG,5) !CLEAR CHECK WORD DO 10,J=1,5 !FILL THE CHECK WORD IF(LIST(J,I).EQ.'0'O)GO TO 20 !NULLS AT END OF SHORT 10 BFRAG(J)=LIST(J,I) ! 20 CONTINUE ! IF(DEBUG)WRITE(5,100)CFRAG IF(LLT(WORD(1:5),CFRAG))THEN !HAVE GONE TOO FAR? IRDBLK=I-1 !YES, USE LAST GO TO 45 !THAT IS WHAT WE WANT END IF 30 CONTINUE 40 IRDBLK=I-1 !GONE TOO FAR, LAST ONE 45 IF(DEBUG)WRITE(5,101)IRDBLK RETURN 100 FORMAT(' CFRAG=',A5) 101 FORMAT(' IRDBLK=',I4) END SUBROUTINE GET(FDB,BLKNUM,DCTWRD,NUMWRD,MAXDIC) C+ C SUBROUTINE GET WILL READ BLOCK # = BLKNUM FROM THE C FILE DESCRIBED BY FDB USING DIRECT ACCESS BLOCK I/O. C THIS BLOCK WILL BE CHECKED FOR DICTIONARY WORDS AND C PUT IN THE LIST DCTWRD. THE # OF WORDS FOUND IS C RETURNED IN NUMWRD. MAXDIC IS THE MAXIMUM C LENGTH OF DCTWRD. C- BYTE FDB(128),BUFFER(512) CHARACTER*25 DCTWRD(MAXDIC) INTEGER*2 BLKNUM EQUIVALENCE (IBUF,BUFFER(1)) C CALL DABRD(FDB,BUFFER,512,BLKNUM,NBT,IER) IF(IER.LT.0)WRITE(5,100)IER CALL EXTRC(BUFFER,DCTWRD,NUMWRD,MAXDIC) RETURN 100 FORMAT(' SPE - GET ERR=',I6) END SUBROUTINE EXTRC(BUFFER,DCTWRD,NUMWRD,MAXDIC) C+ C SUBROUTINE EXTRC WILL TAKE THE BUFFER READ IN RANDOM ACCESS C BLOCK IO AND FILL THE DICTIONARY WORD LIST TO BE CHECKED C AGAINST THE WORD. MAXDIC SHOULD NOT EVER BE >125 (I HOPE). C- BYTE BUFFER(512),DCTWRD(25,125) INTEGER POSITN IF(MAXDIC.GT.125)THEN 10 WRITE(5,100) CALL EXIT END IF IF(NUMWRD.GT.0)CALL BLANK(DCTWRD,25*NUMWRD) NUMWRD=1 !NUMBER OF WORDS IN BUFFER FOUND POSITN=1 DO 30,I=1,512 !DO ALL THE BYTES IF(BUFFER(I).NE.'0'O)THEN !NULL SEPERATES THE WORDS DCTWRD(POSITN,NUMWRD)=BUFFER(I) POSITN=POSITN+1 ELSE IF(I.EQ.512.OR.BUFFER(I+1).EQ.'0'O)RETURN POSITN=1 !REPOSITN TO START OF WORD IF(NUMWRD.LT.125)THEN NUMWRD=NUMWRD+1 !ANOTHER WORD FOUND ELSE GO TO 10 END IF END IF 30 CONTINUE RETURN 100 FORMAT(' SPE - DCTWRD SIZE EXCEDED IN EXTRC') END SUBROUTINE ADDLST(LIST,LENGTH,WORD,LISTLN) C+ C SUBROUTINE ADDLST WILL ADD WORD TO LIST AND INCREASE C THE LENGTH TO LENGTH + 1. C C ONLY VALID FOR LIST LESS THAN LISTLN ELEMENTS C- CHARACTER*25 LIST(LISTLN),WORD C LENGTH=LENGTH+1 IF(LENGTH.GT.LISTLN)THEN WRITE(5,100) CALL EXIT END IF LIST(LENGTH)=WORD RETURN 100 FORMAT(' OVERFLOW IN ADDLST') END SUBROUTINE DISPLA(LINE,NL,WORD,PRMPT,LINRED,TOTLIN 1,NWORDS,ALISTL,CLISTL,WLISTL,DEBUG,VERSN,TERSE) C+ C SUBROUTINE DISPLA WILL DISPLAY ON THE SCREEN IN THE NON-QUICK MODE C THE WORD THAT IS NOT FOUND IN THE DICTIONARY OR ANY OF THE C LISTS AS WELL AS THE LINE FROM THE DOCUMENT IN WHICH THE C WORD WAS FOUND. IN THE VERBOSE MODE (NON-TERSE) THE TITLE, C REVISION NUMBER, COMMAND LIST, AND STATISTICS ARE PRINTED ALSO. C FOR SCREEN ADDRESSING THE SUBROUTINE USES THE VT52 TYPE ESCAPE SEQUENCES. C C GO TO UPPER LEFT IS 'H' C CLEAR TO END OF SCREEN IS 'J' C REMEMBER IS '33'O C- BYTE PRMPT,LINE(NL),WORD(25),COMAND(5) LOGICAL*1 DEBUG,TERSE INTEGER*4 NWORDS INTEGER*2 ALISTL,CLISTL,WLISTL,TOTLIN C 5 IF(.NOT.TERSE)THEN IF(.NOT.DEBUG)WRITE(5,100)'33'O,'33'O !CLEAR SCREEN WRITE(5,200)VERSN !WRITE HEADING WRITE(5,201)LINRED,TOTLIN,NWORDS,ALISTL,CLISTL,WLISTL END IF WRITE(5,101)(LINE(I),I=1,NL) !WRT LINE WRD IS IN WRITE(5,102)WORD !WRITE NOT FOUND WRD READ(5,103,END=10)COMAND !GET COMMAND IF(COMAND(1).EQ.'D'.AND.COMAND(2).EQ.'E' 1.AND.COMAND(3).EQ.'B'.AND.COMAND(4).EQ.'U' 2.AND.COMAND(5).EQ.'G')THEN !TOGGLE DEBUG SWITCH IF(DEBUG)THEN DEBUG=.FALSE. ELSE DEBUG=.TRUE. END IF END IF PRMPT=COMAND(1) CALL LOWER(PRMPT,1) IF(PRMPT.EQ.'t')THEN TERSE=.TRUE. GO TO 5 END IF IF(PRMPT.EQ.'v')THEN TERSE=.FALSE. GO TO 5 END IF RETURN 10 WRITE(5,100)'33'O,'33'O !CNTRL Z CAUSES EXIT CALL EXIT 100 FORMAT(1X,A1,'H',A1,'J') 101 FORMAT(1X,80A1) 102 FORMAT('$',25A1,1X,'>>',1X) 103 FORMAT(5A1) 200 FORMAT(30X,'SPELLING CHECKER V',F3.1,/ 1,/,37X,'COMMANDS',/ 2,/,1X,'# - Ignore words <= to # in length' 3,/,1X,'A - Correct, add to dictionary' 4,/,1x,'C - Correct, do not add to dictionary' 5,/,1X,'E - Exchange word, but do not add to list' 6,/,1x,'L - Replace current line' 7,/,1X,'N - Next word, do not add to list' 8,/,1X,'W - Wrong spelling, make correction' 9,/,1X,'X - Exit, as if end of document',/) 201 FORMAT(1X,'Number of lines processed = ',I5,' out of ',I5 1,/,1X,'Number of words processed = ',I6 2,/,1X,'Maximum words allowed in list = 100' 3,/,1X,'Number of words to be added to dictionary = ',I3 4,/,1X,'Number of words in correct list = ',I3 5,/,1x,'Number of words in incorrect list = ',I3,/) END SUBROUTINE SORT(LIST,LENGTH) C+ C SUBROUTINE SORT WILL SORT A LIST OF WORDS INTO ALPHABETICAL C ORDER. C- CHARACTER*25 LIST(LENGTH),WORD LOGICAL*1 RIGHT C 10 RIGHT=.TRUE. DO 20,I=1,LENGTH-1 IF(LIST(I).GT.LIST(I+1))THEN WORD=LIST(I) LIST(I)=LIST(I+1) LIST(I+1)=WORD RIGHT=.FALSE. END IF 20 CONTINUE IF(.NOT.RIGHT)GO TO 10 RETURN END