PROGRAM DCTNRY C C Will receive messages from ...SPE and use the raf dictionary C to find probable words to fit the misspelling. C C USE: >DCT word C C OR USE ...SPE task to send to ...DCT C C TO BUILD: @DCTNRY 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 /NOCK/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 [7,7] for the dictionary C RSX Executive calls are made C MUST be installed as ...DCT to work C with ...SPE C Not all permutations of a misspelled word C are checked. (Are you kidding?) C C Author: Jeff Hamilton C E-Systems, Inc. C P. O. Box 1056 CBN 27 C Greenville, Texas 75401 C (214)454-4175 C C Date: September 25,1982 C C REVISIONS: C 1.0 FIRST CUT AT MAKING IT WORK C 1.1 MCR CALLABLE C 1.2 DON'T INCLUDE ALREADY FOUND WORD IN OKWORD C 1.3 RECEIVABLE FROM ANY TASK (MAYBE SPET0) C 1.4 DEBUG/CODE CLEANUP/MACRO ROUTINES C PARAMETER (VRSION=1.4) C C BACKGROUND: C This task goes with the spelling checker program C first submitted to the Spring 82 RSX/IAS SIG tape. C During field test I was asked if a way could be found to C look up words in the dictionary during the spelling C correction of a document. This program is the result. C This is a seperate program because I was at the limit C in SPELL for code and data. I thought it wouldn't be too hard C to make a send/receive pair to work with simple words. C Since these are two entirely independent programs that C can be made to work together debugging of each can be C made without modifying both. The send/receive mechanism C depends (at least in RSX-11M) on 13 words (26 bytes). C By coincedence in SPELL the word lengths are set to 25 letters. C Thus one word can be sent with enough room for a status byte. C A bunch of code was stolen from SPELL and modifications were C made to SPELL to link to DCTNRY. C C ORDER OF OPERATION: C C COME ALIVE: C If we were stopped go to getwrd C If not C Init Raf file C If not started by MCR go to getwrd C Get MCR buffer C Go to process word C GETWRD: C Do a receive from any task C If receive not sucessful, exit C If not valid word, exit C PROCESS WORD: C Remove each of the letters one at a time C If resultant word is in dictionary, save it C Transpose each of the letters two at a time C If resultant word is in dictionary, save it C Add every letter in every position in word C If resultant word is in dictionary, save it C Replace each of the letters with every letter C If resultant word is in dictionary, save it C Show all the words to the user C If started by MCR, exit C Get choice by user C Return correct word to calling program C Stop C Go to come alive C C BLOCK I/O: 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 PARAMETER (IBUFSZ=512) !NUMBER OF BYTES IN BLOCK C BYTE CONTNS(IBUFSZ), LUNDAT(12), INDXS BYTE FDB(128), IN(2), DFILE(32), MCRBUF(80) BYTE WORD(25), CWORD(25), OKWORD(25,20), LETTER LOGICAL*1 GOTWRD, VT52, VT100, NUMBER, TERSE LOGICAL*1 MCRSTR, INDICT, DEBUG INTEGER*2 IDFILE, UNIT, IFDB INTEGER*4 LOCAT(2,26) VIRTUAL INDXS(512,26) C C EQUIVALENCES C EQUIVALENCE (LOCAT(1,1),CONTNS(1)) EQUIVALENCE (FDB(1),IFDB) !MUST BE ON EVEN BOUNDRY EQUIVALENCE (DFILE(1),IDFILE) !MUST BE ON EVEN BOUNDRY EQUIVALENCE (LUNDAT(3),UNIT) C C DATA STATEMENTS C DATA DFILE/'S','P','0',':','[','7',',','7',']','D','I','C','T' 1,'.','R','A','F',15*0/ C C FILL IN THE DEVICE ATTACHED TO LUN=1 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(1,LUNDAT,IDS) DFILE(1)=LUNDAT(1) DFILE(2)=LUNDAT(2) UNIT=IAND(UNIT,7) ENCODE(1,1001,DFILE(3))UNIT C C OPEN DICTIONARY FILE C CALL INIT(FDB) !CLEAR FDB FOR RAF IN(1)='41'O !=00100001 !READONLY,SHARED READING IN(2)=1 !=00000001 !BLOCK MODE CALL PARSE(FDB,DFILE,1) !PUT NAME AND LUN=1 INTO FDB IER=0 !MAKE SURE NO ERROR CALL FIND(FDB,IER) !FILE EXIST? IF(IER.LT.0)GO TO 100 !NO CALL OFID(FDB,IN,1,IER) !OPEN BY FILE ID IF(IER.LT.0)GO TO 101 !ERROR DURING OPEN CALL DABRD(FDB,CONTNS,IBUFSZ,1,NBT,IER) !READ INDEX IF(IER.LT.0)GO TO 102 CALL INDXFL(INDXS,LOCAT,FDB) !FILL THE INDEX BLOCKS IN VM C C MAIN PROCESSING C DEBUG=.FALSE. !OTHERWISE WE GET A LOT OF OUTPUT CALL ASNLUN(2,'TI',0) !SHOULD BE SET IN BUILD FILE, BUT... MCRSTR=.FALSE. !NORMALLY MCR DOESN'T START US CALL GETMCR(MCRBUF,IDS) !STARTED BY MCR? IF(IDS.GT.0)THEN !YES, SO MCRSTR=.TRUE. !SET FLAG CALL GTFRMC(MCRBUF,IDS,WORD,GOTWRD) !GET WORD FROM MCRBUF GO TO 4 !SKIP RECEIVER END IF !NO, SO DO A RECEIVE 5 CALL GETWRD(WORD,GOTWRD,VT52,VT100,NUMBER,TERSE,TASK) 4 CALL CLEAR(OKWORD,20*25) !CLEAR LISTS CALL CLEAR(CWORD,25) !...BEFORE WE START NUMFND=0 !HAVEN'T FOUND ANY YET IF(.NOT.GOTWRD)THEN !ORDERLY EXIT CALL CLOS(FDB) !...WHEN NECESSARY CALL EXIT END IF DO 10,I=2,25 !FIND END OF WORD IF(WORD(I).EQ.' ')THEN !...AS DEFINED BY FIRST SPACE LAST=I-1 GO TO 11 END IF 10 CONTINUE 11 CONTINUE C C FIND THE CORRECT WORDS IF THE WRONG WORD HAS ONE TWO MANY LETTERS C DO 30,I=1,LAST K=0 DO 20,J=1,LAST IF(J.NE.I)THEN !EXCEPT FOR THIS POSITION K=K+1 !...COPY WORD. CWORD(K)=WORD(J) END IF 20 CONTINUE DO 21,J=LAST,25 !NOT LAST+1 BECAUSE LESS ONE 21 CWORD(J)=' ' !BLANK OUT REST OF WORD CALL CKDICT(FDB,LOCAT,CWORD,INDICT,DEBUG,INDXS) IF(INDICT)CALL MVC2OK(CWORD,OKWORD,NUMFND) 30 CONTINUE C C FIND THE RIGHT WORDS IF TWO LETTERS MAY BE TRANSPOSED C DO 40,I=1,LAST !MAKE COPY FOR DESTRUCTIVE 40 CWORD(I)=WORD(I) !...USE. DO 41,I=LAST+1,25 !BLANK OUT END OF WORD 41 CWORD(I)=' ' DO 50,I=1,LAST-1 !FOR EACH POSITION, EXCEPT IF(CWORD(I).EQ.WORD(I+1))GO TO 50 !DON'T TRANSPOSE SAME LETTER CWORD(I)=WORD(I+1) !...SWITCH LETTERS CWORD(I+1)=WORD(I) !...WITH NEXT ONE. CALL CKDICT(FDB,LOCAT,CWORD,INDICT,DEBUG,INDXS) IF(INDICT)CALL MVC2OK(CWORD,OKWORD,NUMFND) CWORD(I)=WORD(I) !SWITCH BACK LETTERS CWORD(I+1)=WORD(I+1) !...FOR NEXT CHECK 50 CONTINUE C C FIND THE RIGHT WORDS IF ONE LETTER IS LEFT OUT OF THE WORD C DO 75,AJ=.5,LAST+.5,1. DO 70,L=97,122 LETTER=L K=0 IF(AJ.LT.1)THEN K=K+1 CWORD(K)=LETTER END IF DO 60,I=1,LAST K=K+1 CWORD(K)=WORD(I) IF(AJ.GT.FLOAT(I).AND.AJ.LT.FLOAT(I+1))THEN !BETWEEN THESE TWO K=K+1 CWORD(K)=LETTER END IF 60 CONTINUE DO 65,I=LAST+2,25 !BLANK OUT REST 65 CWORD(I)=' ' !...OF WORD. CALL CKDICT(FDB,LOCAT,CWORD,INDICT,DEBUG,INDXS) IF(INDICT)CALL MVC2OK(CWORD,OKWORD,NUMFND) 70 CONTINUE IF(NUMBER)THEN !NUMBERS ALLOWED IN WORD? DO 74,L=48,57 LETTER=L K=0 IF(AJ.LT.1)THEN K=K+1 CWORD(K)=LETTER END IF DO 72,I=1,LAST K=K+1 CWORD(K)=WORD(I) IF(AJ.GT.FLOAT(I).AND.AJ.LT.FLOAT(I+1))THEN K=K+1 CWORD(K)=LETTER END IF 72 CONTINUE DO 73,I=LAST+2,25 73 CWORD(I)=' ' CALL CKDICT(FDB,LOCAT,CWORD,INDICT,DEBUG,INDXS) IF(INDICT)CALL MVC2OK(CWORD,OKWORD,NUMFND) 74 CONTINUE END IF 75 CONTINUE C C MAYBE ONE OF THE LETTERS ARE WRONG C DO 95,I=1,LAST DO 90,L=97,122 LETTER=L IF(WORD(I).EQ.LETTER)GO TO 90 !DON'T CHECK SAME LETTER DO 80,J=1,LAST IF(I.NE.J)THEN CWORD(J)=WORD(J) ELSE CWORD(J)=LETTER END IF 80 CONTINUE DO 81,J=LAST+1,25 81 CWORD(J)=' ' CALL CKDICT(FDB,LOCAT,CWORD,INDICT,DEBUG,INDXS) IF(INDICT)CALL MVC2OK(CWORD,OKWORD,NUMFND) 90 CONTINUE IF(NUMBER)THEN DO 94,L=48,57 LETTER=L DO 91,J=1,LAST IF(I.NE.J)THEN CWORD(J)=WORD(J) ELSE CWORD(J)=LETTER END IF 91 CONTINUE DO 92,J=LAST+1,25 92 CWORD(J)=' ' CALL CKDICT(FDB,LOCAT,CWORD,INDICT,DEBUG,INDXS) IF(INDICT)CALL MVC2OK(CWORD,OKWORD,NUMFND) 94 CONTINUE END IF 95 CONTINUE C C SHOW THE USER THE WORDS WE FOUND C CALL DISPLA(WORD,OKWORD,NUMFND,VT52,VT100,TERSE,VRSION 1,MCRSTR) GOTWRD=.FALSE. IF(MCRSTR)GO TO 4 !MCR STARTED US, EXIT C C SEND THE WORD HE CHOSE BACK TO ...SPE C CALL PUTWRD(WORD,TASK) C C NOW STOP UNTIL WE ARE WOKEN UP C CALL STOP(IDS) GO TO 5 !SOMEONE UNSTPED US, GO SEE WHY C C ERROR MESSAGES C 100 WRITE(2,1004) CALL EXIT 101 WRITE(2,1003)IER CALL EXIT 102 WRITE(2,1002)IER CALL EXIT 1000 FORMAT(1X,25A1) 1001 FORMAT(I1) 1002 FORMAT(' DCTNRY - ERROR DURING READ =',O6) 1003 FORMAT(' DCTNRY - ERROR DURING OPEN =',O6) 1004 FORMAT(' DCTNRY - FILE NOT FOUND') END SUBROUTINE GETWRD(WORD,GOTWRD,VT52,VT100,NUMBER,TERSE,TASK) C+ C SUBROUTINE GETWRD WILL RECEIVE THE MISSPELLED WORD FROM C SPELL IF IT IS INVOKED AS A SLAVE FROM SPELL. IF USES C A RECEIVE PACKET. C- BYTE WORD(25),WRDINT(26),STATUS INTEGER*2 BUF15(15),BUF13(13),INTWRD LOGICAL*1 GOTWRD,VT52,VT100,NUMBER,TERSE REAL*4 TASK, STASK EQUIVALENCE (BUF15(3),BUF13(1)) EQUIVALENCE (BUF13(1),WRDINT(1)) EQUIVALENCE (STATUS,WRDINT(26)) EQUIVALENCE (INTWRD,WRDINT(1)) EQUIVALENCE (STASK,BUF15(1)) DATA ISSUC/+1/ IEITS/-8/ C GOTWRD=.FALSE. CALL RECEIV(,BUF15,,IDS) !GET PACKET TASK=STASK !WHO SENT IT IF(IDS.EQ.ISSUC)GOTWRD=.TRUE. !WE GOT IT IF(WRDINT(1).EQ.'0'O)GOTWRD=.FALSE. !BLANK WORD SENT IF(IDS.EQ.IEITS)THEN !NO PACKET SENT? WRITE(2,1000) !...THAT'S STRANGE. CALL EXIT !...WE BETTER LEAVE END IF IF(GOTWRD)THEN DO 10,I=1,25 !TELL MAIN WE GOT IT 10 WORD(I)=WRDINT(I) !...COPY IT FOR MAIN TERSE=.FALSE. !CHECK STATUS WORD NUMBER=.FALSE. !... VT52=.FALSE. !... VT100=.FALSE. !... IF((STATUS.AND.1).EQ.1)VT52=.TRUE. !... IF((STATUS.AND.2).EQ.2)VT100=.TRUE. !... IF((STATUS.AND.16).EQ.16)TERSE=.TRUE. !... IF((STATUS.AND.32).EQ.32)NUMBER=.TRUE. !... END IF RETURN 1000 FORMAT(' DCTNRY - NO SEND PACKET',/,'$>') END SUBROUTINE PUTWRD(WORD,TASK) C+ C SUBROUTINE PUTWRD IS USED TO SEND THE CORRECTLY CHOSEN WORD C BACK TO THE SPELLER PROGRAM IF IT WAS INVOKED AS A SLAVE C TO SPE. IT USES A SEND AND AN UNSTOP TO SPELL. C- BYTE WORD(25),WRDINT(26) INTEGER*2 BUF15(15),BUF13(13),INTWRD EQUIVALENCE (WRDINT(1),BUF13(1)) EQUIVALENCE (BUF15(3),BUF13(1)) EQUIVALENCE (INTWRD,WRDINT(1)) DATA IEINS/-2/ ISSUC/+1/ DO 10,I=1,25 !COPY THE WORD TO SEND 10 WRDINT(I)=WORD(I) !... CALL SEND(TASK,BUF13,,IDS) !SEND PACKET TO WHO INVOKED US IF(IDS.EQ.IEINS)THEN !THEY AIN'T THERE? WRITE(2,1000) !...THAT'S STRANGE CALL EXIT !...WE BETTER LEAVE END IF CALL CLEAR(WORD,25) !CLEAR WORD CALL USTP(TASK,IDS) !UNSTOP INVOKING TASK IF(IDS.NE.ISSUC)THEN !...ERROR? WRITE(2,1001) !...LET'S QUIT CALL EXIT END IF RETURN 1000 FORMAT(' DCTNRY - SPELL NOT INSTALLED') 1001 FORMAT(' DCTNRY - UNSTOP ERROR') END SUBROUTINE MVC2OK(CWORD,OKWORD,NUMFND) C+ C SUBROUTINE MVC2OK IS USED TO TRANSFER THE CHECK WORD TO C THE OK WORD LIST IF THE CHECK WORD IS FOUND IN THE C RAF DICTIONARY. NUMFND IS INCREMENTED ALSO. C- BYTE CWORD(25),OKWORD(25,20) C IF(NUMFND.GE.20)RETURN !AS MANY AS WE CAN HANDLE NOW DO 20,I=1,NUMFND !EACH PREVIOUS WORD DO 10,J=1,25 !EACH LETTER IF(CWORD(J).NE.OKWORD(J,I))GO TO 20 !ALREADY THERE? 10 CONTINUE RETURN !YES DON'T ADD 20 CONTINUE NUMFND=NUMFND+1 !NO, ADD TO LIST DO 30,J=1,25 30 OKWORD(J,NUMFND)=CWORD(J) RETURN END SUBROUTINE DISPLA(WORD,OKWORD,NUMFND,VT52,VT100,TERSE,VRSION 1,MCRSTR) C+ C SUBROUTINE DISPLA IS USED IN THE DCT PROGRAM TO DISPLAY AT THE C OPERATOR'S TERMINAL A LIST OF THE WORDS FOUND IN THE DICTIONARY C THAT MIGHT BE THE ONE TO REPLACE THE MISSPELLED WORD. (HOW C IS THE DICTIONARY TO KNOW WHAT YOU MEANT?) C- BYTE WORD(25),OKWORD(25,20), ESC LOGICAL*1 VT52, VT100, TERSE, MCRSTR DATA ESC/'33'O/ IF(.NOT.TERSE)THEN !CLEAR SCREEN IF(VT52)WRITE(2,1000)ESC,ESC IF(VT100)WRITE(2,1001)ESC,ESC END IF WRITE(2,1002)VRSION,(WORD(I),I=1,25) !HEADER AND WRONG WORD DO 10,I=1,NUMFND !FOUND LIST WRITE(2,1003)I,(OKWORD(J,I),J=1,25) 10 CONTINUE NUMUSE=0 IF(.NOT.MCRSTR)THEN WRITE(2,1004) READ(2,*)NUMUSE END IF IF(.NOT.TERSE)THEN !CLEAR SCREEN ON EXIT IF(VT52)WRITE(2,1000)ESC,ESC IF(VT100)WRITE(2,1001)ESC,ESC END IF IF(NUMUSE.EQ.0)RETURN DO 20,J=1,25 !GET THE ONE CHOSEN WORD(J)=OKWORD(J,NUMUSE) 20 CONTINUE RETURN 1000 FORMAT(1X,A1,'H',A1,'J') 1001 FORMAT(1X,A1,'[0;0H',A1,'[0J') 1002 FORMAT(T35,'DCTNRY V',F3.1,//,' 0. ',25A1) 1003 FORMAT(1X,I2,'.',T7,25A1) 1004 FORMAT(/,'$Enter number of word to use:') END SUBROUTINE GTFRMC(MCRBUF,IDS,WORD,GOTWRD) C+ C SUBROUTINE GTFRMC WILL GET THE GIVEN WORD FROM THE MCR BUFFER C WHEN DCT IS INVOKED AS AN EXTERNAL MCR COMMAND. C THE CALLING SEQUENCE IS C C >DCT WORD C- BYTE MCRBUF(80),WORD(25) LOGICAL*1 GOTWRD GOTWRD=.FALSE. IF(IDS.LT.5)RETURN !NO WORD TO GET DO 10,I=5,IDS 10 WORD(I-4)=MCRBUF(I) !TRANSFER WORD DO 20,I=IDS+1,25 20 WORD(I-4)=' ' !BLANK OUT REST OF WORD GOTWRD=.TRUE. CALL LOWER(WORD,25) !MAKE LOWER CASE RETURN 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) !READ BLOCK NUMBER IF(IER.LT.0)WRITE(2,1000)IER CALL EXTRC(BUFFER,DCTWRD,NUMWRD,MAXDIC) !GET DICTIONARY WORDS RETURN 1000 FORMAT(' DCTNRY - GET ERR=',O6) 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(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 CALL EXIT END IF END IF 30 CONTINUE RETURN END SUBROUTINE INDXFL(INDXS,LOCAT,FDB) C+ C SUBROUTINE INDXFL WILL FILL THE INDEXES 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 LETBLK=LOCAT(START,I)-1 CALL DABRD(FDB,BUFFER,IBUFSZ,LETBLK,NBT,IER) IF(IER.LT.0)WRITE(2,1000)IER DO 5,J=1,IBUFSZ 5 INDXS(J,I)=BUFFER(J) 10 CONTINUE RETURN 1000 FORMAT(' DCTNRY - INDXFL ERR=',O6) 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 C THE SEARCH METHOD HAS BEEN MODIFIED TO BE A BINARY SEARCH C WITH THE REGION TO SEARCH TO BE DIVIDED IN HALF UNTIL THE C WORD IS FOUND OR NOT FOUND WHEN THERE IS NOTHING LEFT TO C DIVIDE. THUS 6 COMPARES SHOULD BE NECESSARY ON THE AVERAGE C WHILE ON THE OLD COMPARE TO EACH WORD, 32 COMPARES WOULD C HAVE BEEN NECESSARY ON THE AVERAGE. C C ALSO THE LAST LETNUM AND M BLOCK ARE KEPT SO THAT IF THE C NEW LETNUM AND/OR M ARE THE SAME NO RECALCULATION OR READ C OF THE DICTIONARY IS NECESSARY. THIS PROBABLY WILL NOT OCCUR C UNLESS TWO WORDS HAVE THE SAME SEVERAL STARTING LETTERS. C NOT LIKELY BUT MIGHT AS WELL SAVE SOME TIME IF POSSIBLE. C 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/NUMWRD/125/ C INDICT=.FALSE. PRVS=.FALSE. LETTER=WORD(1:1) !GET FIRST LETTER LETNUM=INDX(LETTER) !INDEX VALUE IF(LETNUM.LT.1.OR.LETNUM.GT.26)RETURN !MUST START WITH LETTER IF(DEBUG)WRITE(2,1001)LETTER BUFNUM=LOCAT(START,LETNUM) !WHERE BUFFER STARTS NUMBUF=LOCAT(SIZE,LETNUM) !LENGTH THIS LETTER IN BLOCKS LETBLK=BUFNUM-1 !BLOCK NUMBER OF LETTER INDEX IF(DEBUG)WRITE(2,1002)BUFNUM,NUMBUF,LETBLK IF(LETNUM.NE.LSTLET)THEN DO 5,I=1,IBUFSZ !LOAD CORRECT 5 LETBUF(I)=INDXS(I,LETNUM) !...LETTER BUFFER END IF !...IF NOT LOADED M=IRDBLK( LETBUF, WORD, DEBUG ) +LETBLK !M=BLOCK IT IS IN IF(DEBUG)WRITE(2,1003)M IF(M.NE.LASTM)THEN !LOAD DICT LIST WITH BLK M CALL GET(FDB,M,DCTWRD,NUMWRD,MAXDIC) END IF 10 CONTINUE IF(DEBUG)THEN WRITE(2,1000)1,DCTWRD(1) WRITE(2,1000)NUMWRD,DCTWRD(NUMWRD) END IF IF(LLT(WORD,DCTWRD(1)))THEN !IF LT 1ST WORD, PREVIOUS BLK IBUG=1 IF(DEBUG)WRITE(2,1004)IBUG 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 IBUG=2 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 IBUG=3 IF(DEBUG)WRITE(2,1004)IBUG IF(PRVS)GO TO 40 !NXT BLK ALRDY USD, SO NOT FOUND IBUG=4 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 IBUG=5 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 USE A BINARY SEARCH METHOD SINCE THE LIST IS IN ALPHABETICAL C ORDER. FOR A LONG LIST (64 WORDS) THIS SHOULD CUT THE C COMPARES TO A FOURTH OF THE AVERAGE NUMBER OF THE LAST C METHOD (COMPARE TO EACH). C LAST=0 !SET UP REGION AS WHOLE LIST NEXT=NUMWRD IHALF=NEXT 30 CONTINUE IF(DEBUG)WRITE(2,1000)IHALF,DCTWRD(IHALF) IF(WORD.EQ.DCTWRD(IHALF))THEN !IF WE FOUND IT IF(DEBUG)WRITE(2,1006)WORD INDICT=.TRUE. !SET FOUND FLAG AND DO CLEAN UP GO TO 50 END IF IF(NEXT-LAST.LE.1)THEN !NOT FOUND, NO WORDS BETWEEN? IBUG=6 !YEP, SO SET FOR DEBUG GO TO 40 !WRITE MESSAGE AND RETURN END IF IF(WORD.GT.DCTWRD(IHALF))LAST=IHALF !IF IN LAST HALF, BRING UP BOT IF(WORD.LT.DCTWRD(IHALF))NEXT=IHALF !IF IN 1ST HALF, LOWER TOP IHALF=(NEXT+LAST)/2 !DIVIDE REGION IN HALF FOR TEST GO TO 30 !GO TEST NEXT WORD 40 IF(DEBUG)THEN WRITE(2,1007)WORD !NOT FOUND, SAY SO. WRITE(2,1004)IBUG !HOW WE GOT HERE END IF 50 LASTM=M !SET FOR NEXT TIME TRU LSTLET=LETNUM !SET THIS ALSO RETURN !RETURN TO CALLING 1000 FORMAT(' DCTWRD(',I3,')=',A25) 1001 FORMAT(' LET=',A1) 1002 FORMAT(' B,N,L=',3(I3,2X)) 1003 FORMAT(' M=',I3) 1004 FORMAT(' ?',I1) 1006 FORMAT(' ',A25,' FOUND') 1007 FORMAT(' ',A25,' NOT FOUND') 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(2,1000)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(2,1001)IRDBLK RETURN 1000 FORMAT(' CFRAG=',A5) 1001 FORMAT(' IRDBLK=',I4) END