PROGRAM DICTMK C C+ C This is the dictionary maker program to be included C with the spelling checker program. C C Author: Jeff Hamilton C E-Systems, Inc. C P. O. Box 1056 CBN 28 C Greenville, Texas 75401 C (214)454-4175 C C Date: January 11, 1982 C C This program makes up a large random access block io file C for use with the spelling checker file. The reason this C program exists instead of including the code into the spelling C checker itself is that the Dictionary itself takes on the order C of eight minutes on a quiet system and disk to create the C large RAF. It was felt that this overtime shouldn't be included C in any spelling checking. C Any new words are included into the dictionary by C running this program. If 'DICT.ADD' exists under the C current uic and sy: then the words in the file are sorted C (they should be in sorted order from SPELL but they are sorted C again to make sure). Then they are merged into DICT.SEQ C to create a new DICT.SEQ. This is then used as the data C base to create DICT.RAF. The principle behind a large (less space C than the sequential file) Random access block io file is C based on Marge Knox's paper from the Fall 1981 DECUS Symposium C on the relative timings of disk io for FORTRAN-IV+ on a RSX C system. I decided that a single block io was prefered to C many sequential ios. It was also the only way to random C access io for variable length words without wasting a lot C of space on a standard length equal to the longest word (22 letters). C Thus the word blocking and unblocking in each disk block is C done in DICTMK and SPELL. I figure this is about what is done C in the ISAM program under Software Tools from the Spring 1981 C RSXSIG tape. My understanding is that ISAM produces another C file with disk blocks for the first record in each block C set up to reduce disk reads. C My next problem came from Marge's cryptic statement that C this file couldn't be truncated to eof without it disappearing C altogether. This seemed inadequate to me, so I used C Ralph Stammerjohn's index to the RSXSIG tapes (there was bound C to be something in there to help) and what-do-you-know up C came Phil Cannon's work to use a user defined FDB for program C file control. This came from the Spring 1980 tape uic=[300,52]. C These routines were built into the F77FCS library. C All the routines I needed were there except the TRUNC close. C This was added by modifying the CLOS routine. These routines C were added to the algorithms and the result is DICTMK and C SPELL. Two new routines were added to DICTMK since it is not C strapped for space. These are GETSIZ and GETVER from the Copious C library off of the RSXSIG tapes. COPIOUS is from GR Johnson of C Battelle Northwest. GETSIZ is used to get the C size of the input file so that the output file can be opened C with the same size. GETVER is used to find out which version C of the sequential file is open for information of the user. C To properly work UIC [7,7] must exist with RWED for C world or DICTMK must be run by privileged accounts. If C you don't like [3,3] to be used, modify the data statements C in DICTMK main and SPELL main and MERGE in DICTMK for how you C want it. C In the taskbuild file lun=2,3 are set to be SP0:, this must be taken C into account. Lun=4 is set to the NL:. If reassigned before C running to SY:, a map of the contents of DICT.RAF and the statistics C of the contents of the dictionary are produced. Normally this C is used just for debugging. C C To build: @DICTMK C- C PARAMETER (IBUFSZ=512) C INTEGER*4 LOCAT(2,26),TOTBYT,TOTWRD,STATUS(5,26) LOGICAL*1 EXIST INTEGER*2 IBUF(256),WDSIZ,BUFNM,POINTR,SIZE,START INTEGER*2 BUFSTR,UNIT,DIRDEV BYTE BUFFER(IBUFSZ),LINE(30),LETTER,CONTNS(IBUFSZ) BYTE FDB(128),OUT(2),FILE(30),BJ,FSTLET,SFILE(30),LUNDAT(12) EQUIVALENCE (FSTLET,LINE(1)) EQUIVALENCE (LOCAT(1,1),CONTNS(1)) EQUIVALENCE (BUFFER(1),IBUF(1)) EQUIVALENCE (ISIZE,FDB(11)) EQUIVALENCE (ICNTIG,FDB(29)) EQUIVALENCE (UNIT,LUNDAT(3)) EQUIVALENCE (DIRDEV,LUNDAT(5)) DATA SFILE/'S','P','0',':','[','7',',','7',']','D','I','C','T' 1,'.','S','E','Q',13*0/ DATA FILE/'S','P','0',':','[','7',',','7',']','D','I','C','T' 1,'.','R','A','F',13*0/ DATA NUMBUF/1/START/1/SIZE/2/POINTR/1/BUFNM/3/ DATA LETTER/'a'/MAXBUF/900/BUFSTR/3/ DATA EXIST/.FALSE./ C DO 1,I=1,26 !PRESET LOWEST WORD LENGTH 1 STATUS(3,I)=50 D TIMMRK=SECNDS(0.0) CALL MERGE CALL GETLUN(3,LUNDAT,IDS) SFILE(1)=LUNDAT(1) SFILE(2)=LUNDAT(2) FILE(1)=LUNDAT(1) FILE(2)=LUNDAT(2) UNIT=IAND(UNIT,7) DIRDEV=IAND(DIRDEV,8) IF(DIRDEV.EQ.0)THEN TYPE *,'DICTMK - LUN=3 NOT DIRECTORY DEVICE' CALL EXIT END IF ENCODE(1,1009,SFILE(3))UNIT ENCODE(1,1009,FILE(3))UNIT OPEN(UNIT=3,FILE=SFILE,STATUS='OLD',READONLY) CALL GETVER(3,IVER) !WHICH VERSION OF SEQ WE USING? WRITE(5,1010)IVER !TELL USER CALL INIT(FDB) OUT(1)='16'O !CREATE , WRITE , EXTEND OUT(2)=1 !BLOCK MODE FDB(1)=2 FDB(2)=2 ICNTIG=MAXBUF !IF NOT THERE CREATE AS MAXBUF BLOCKS CALL PARSE(FDB,FILE,2) !PUT NAME AND LUN 2 INTO FDB IER=0 CALL FIND(FDB,IER) !FILE ALREADY EXISTS? IF(IER.GE.0)THEN !YES OUT(1)='6'O !WRITE , EXTEND EXIST=.TRUE. WRITE(5,1011) CALL OFID(FDB,OUT,2,IER) !OPEN BY FILE ID IF(IER.LT.0)GO TO 1999 !ERROR ELSE !NOT FOUND WRITE(5,1012) CALL OFNB(FDB,OUT,2,FILE,IER) !OPEN BY FILE NAME BLOCK IF(IER.LT.0)GO TO 1999 !ERROR END IF C C NOW READ LINE C 10 READ(3,1000,END=300)WDSIZ,(LINE(I),I=1,WDSIZ) CALL STATIS(LINE,WDSIZ,STATUS) IF(FSTLET.LT.'a'.OR.FSTLET.GT.'z')GO TO 10 !(NO PUNC) IF(FSTLET.LT.LETTER)GO TO 10 !ALPHABETICAL ORDER IF(FSTLET.EQ.LETTER)GO TO 20 !NEW STARTING LETTER? LOCAT(START,INDX(LETTER))=BUFSTR LOCAT(SIZE,INDX(LETTER))=NUMBUF+1 !HOW MANY WE HAVE WRITTEN+THIS IF(LETTER.EQ.'a')LOCAT(SIZE,INDX(LETTER))=NUMBUF !SPECIAL CASE BUFSTR=BUFNM+2 !NEXT LETTER STARTS OVER INDEX LETTER=FSTLET !THIS IS THE NEW STARTING LETTER NUMBUF=0 !NUMBER BUFFERS WRITTEN THIS LET CALL DABWT(FDB,BUFFER,IBUFSZ,BUFNM,NB,IER)!WRITE CURRENT BUFFER IF(IER.LE.0)GO TO 2001 !ERROR CALL CLEAR(BUFFER,IBUFSZ) !CLEAR OUT BUFFER BUFNM=BUFSTR !NEXT BUFFER TO BE WRITTEN POINTR=1 !POINT TO START OF BUFFER GO TO 30 !ADD WORD TO BUFFER C C NEXT +1 BECAUSE NULL ENDS WORD C 20 IF(POINTR+WDSIZ+1.LE.IBUFSZ)GO TO 30 !BUFFER FULL? 25 CONTINUE !YES CALL DABWT(FDB,BUFFER,IBUFSZ,BUFNM,NB,IER) !WRITE BUFFER IF(IER.LE.0)GO TO 2001 !ERROR CALL CLEAR(BUFFER,IBUFSZ) !CLEAR BUFFER BUFNM=BUFNM+1 !NEXT BLOCK TO FILL IF(BUFNM.GT.MAXBUF.AND..NOT.EXIST)THEN WRITE(5,*)'OVERFLOW' CALL EXIT END IF NUMBUF=NUMBUF+1 !NO, ANOTHER BLOCK FOR THIS FILE POINTR=1 !POINT TO BEGINNING OF BLOCK 30 CONTINUE !BUFFER NOT FULL CALL ADD(BUFFER,LINE,POINTR,WDSIZ) !ADD WORD POINTR=POINTR+WDSIZ !UPDATE POINTER POINTR=POINTR+1 !REMEMBER NULL ENDS WORD GO TO 10 !GET NEXT WORD 300 CALL DABWT(FDB,BUFFER,IBUFSZ,BUFNM,NB,IER) !WRITE LAST BLOCK IF(IER.LE.0)GO TO 2001 LOCAT(START,INDX(LETTER))=BUFSTR !UPDATE Z START LOCAT(SIZE,INDX(LETTER))=NUMBUF+1 !UPDATE Z SIZE CALL DABWT(FDB,CONTNS,IBUFSZ,1,NB,IER) !WRITE OUT CONTENTS PAGE IF(IER.LE.0)GO TO 2001 !ERROR ISIZE=BUFNM+1 !HOW MANY BLOCKS WRITTEN CALL LTRLOC(LOCAT,FDB) CALL TCLOS(FDB) !CLOSE THE FILE & TRUNC. CLOSE(UNIT=3) D ENDTIM=SECNDS(TIMMRK)/60. D WRITE(5,*)'DICTMK - TIME TO RUN = ',ENDTIM,' MINUTES.' D WRITE(5,*)'DICTMK - LAST BLOCK = ',BUFNM C C NOW WRITE OUT THE STATISTICS TO THE DICTIONARY MAP. THE LUN=4 C IS USUALLY SET IN THE TASK BUILD FILE TO BE THE NL:. IT CAN C BE REASSIGNED TO SY: THUS PRODUCING THE MAP. C OPEN(UNIT=4,FILE='DICT.MAP',STATUS='NEW') WRITE(4,1002) DO 400,J=97,122 !FROM 'a' to 'z' BJ=J 400 WRITE(4,1001)BJ,(LOCAT(K,INDX(BJ)),K=START,SIZE) 1,LOCAT(START,INDX(BJ))-1 WRITE(4,1003) DO 401,J=97,122 !FROM 'a' to 'z' BJ=J WRITE(4,1004)BJ,(STATUS(K,INDX(BJ)),K=1,5) TOTBYT=TOTBYT+STATUS(5,INDX(BJ)) TOTWRD=TOTWRD+STATUS(1,INDX(BJ)) 401 CONTINUE WRITE(4,1005)TOTWRD,TOTBYT WRITE(4,1006)(TOTWRD+TOTBYT)/512 WRITE(4,1007)TOTWRD/(BUFNM-1) WRITE(4,1008)TOTBYT/TOTWRD CLOSE(UNIT=4) WRITE(5,*)'DICTMK - EXITING' CALL EXIT 1999 WRITE(5,*)'DICTMK - ERROR OPENING RAF' CALL EXIT 2000 CALL EXIT 2001 WRITE(5,*)'DICTMK - ERROR WRITING TO RAF' CALL EXIT 1000 FORMAT(Q,80A1) 1001 FORMAT(4X,A1,6X,I5,5X,I5,5X,I5) 1002 FORMAT(1X,'LETTER',3X,'STRT BLK',3X,'NUM BLK' 1,3X,'LET BLK') 1003 FORMAT(//,' LETTER',3X,'NUM WRDS',3X,'LONG LEN' 1,3X,'SHRT LEN',3X,'AVE LEN',3X,'TOT BYTS') 1004 FORMAT(4X,A1,8X,I5,7X,I2,9X,I2,8X,I2,7X,I6) 1005 FORMAT(12X,'______',37X,'______',/,12X,I6,37X,I6) 1006 FORMAT(//,1X,'MINIMUM NUMBER OF BLOCKS =',3X,I4) 1007 FORMAT(1X,'AVERAGE WORDS PER BLOCK =',3X,I4) 1008 FORMAT(1X,'AVERAGE WORD LENGTH =',3X,I2) 1009 FORMAT(I1) 1010 FORMAT(' DICTMK - [7,7]DICT.SEQ;',O4.4,' IS BEING USED.') 1011 FORMAT(' DICTMK - OLD [7,7]DICT.RAF BEING OVERWRITTEN.') 1012 FORMAT(' DICTMK - NEW [7,7]DICT.RAF BEING CREATED.') END FUNCTION INDX(A) C+ C FUNCTION INDX WILL RETURN THE POSITION OF A GIVEN CHARACTER C IN THE ALPHABET. 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 SUBROUTINE CLEAR(A,N) C+ C SUBROUTINE CLEAR WILL ZERO OUT A GIVEN BYTE ARRAY OF LENGTH N C- BYTE A(N) DO 10,I=1,N 10 A(I)='0'O RETURN END SUBROUTINE ADD(A,L,N,M) C+ C SUBROUTINE ADD WILL ADD A WORD TO THE BUFFER BEING MADE UP C FROM THE SEQUENTIAL DICTIONARY. C- BYTE A(512),L(30) DO 10,I=N,N+M-1 10 A(I)=L(I-N+1) CALL CLEAR(L,M) RETURN END SUBROUTINE STATIS(LINE,N,STATUS) C+ C SUBROUTINE STATIS WILL DEVELOP THE STATISTICS FOR EACH OF THE C LETTERS. C- INTEGER*4 STATUS(5,26),M BYTE LINE(N) I=INDX(LINE(1)) M=N STATUS(1,I)=STATUS(1,I)+1 !NUMBER OF WORDS STATUS(5,I)=STATUS(5,I)+M !NUMBER OF LETTERS STATUS(2,I)=MAX(STATUS(2,I),M) !MAX LETTERS SO FAR STATUS(3,I)=MIN(STATUS(3,I),M) !MIN LETTERS SO FAR STATUS(4,I)=STATUS(5,I)/STATUS(1,I) !AVERAGE LETTERS/WRD RETURN END SUBROUTINE LTRLOC(LOCAT,FDB) C+ C SUBROUTINE LTRLOC DEVELOPS THE INDEX FOR EACH OF THE LETTERS. C IT THEN WRITES OUT EACH INDEX TO THE PROPER LOCATION IN THE C RANDOM ACCESS BLOCK IO FILE. C C THE LETTER INDEX CONSISTS OF 102 5-BYTE LOCATIONS IN A BUFFER C OF 512 BYTES. THESE 5 BYTE LOCATIONS CONSIST OF: C BYTES 1-5 ARE THE FIRST FIVE LETTERS OF THE C FIRST WORD IN EACH BLOCK THAT HAS THAT FIRST LETTER. C C NOTE: AT ONE TIME DURING TESTING, AN ERROR KEPT OCCURING THAT C CAUSED PROBLEMS IN WRITING THE LETTER INDEXES. THE DISK I HAD C BEEN USING AS THE DICTIONARY DISK WAS WRITE CHECKED AND A WRITE C CHECK ERROR KEPT OCCURRING AND THE LETTER INDEX BLOCKS WERE NOT C UPDATED. SETTING THE DISK NO WRITE CHECK CURED THE PROBLEM, BUT C I AM NOT SURE WHY IT OCCURRED IN THE FIRST PLACE. C- BYTE FDB(128),BJ,BUFFER(512),WTBUF(512) INTEGER*4 LOCAT(2,26) INTEGER*2 STRBLK,IBUF,IFDB,FERR,FERR1 EQUIVALENCE (IBUF,BUFFER(1)) C DO 5,J=97,122 !FOR EACH LOWER CASE LET BJ=J !CONVERT TO ASCII CALL CLEAR(WTBUF,512) !ZERO OUT LETTER BUFFER LETBLK=LOCAT(1,INDX(BJ))-1 !WHERE IS LETTER BLK STRBLK=LOCAT(1,INDX(BJ)) !WHERE IS STARTING BLOCK LENBLK=LOCAT(2,INDX(BJ)) !HOW MANY BLOCKS LETTER? DO 10,K=STRBLK,STRBLK+LENBLK-1 !FOR EACH BLOCK,THIS LET CALL CLEAR(BUFFER,512) !CLEAR READ BUFFER CALL DABRD(FDB,BUFFER,512,K,NBA,IER) !READ BLOCK DO 20,KK=1,5 !...AND FILL FRAG WORD IF(BUFFER(KK).NE.'0'O)THEN WTBUF(((K-STRBLK)*5)+KK)=BUFFER(KK) ELSE GO TO 21 END IF 20 CONTINUE 21 CONTINUE 10 CONTINUE DO 30,KKK=1,512 !COPY TO BUFFER OUT BUFFER(KKK)=WTBUF(KKK) 30 CONTINUE CALL DABWT(FDB,BUFFER,512,LETBLK,NBB,IER) !WRITE LETTER BUFFER FERR=FDB(45) FERR1=FDB(46) IF(IER.LT.0)TYPE 1002,FERR,FERR1 !ERROR NOTICE 1002 FORMAT(1X,'DICTMK - F.ERR=',I4,1X,'F.ERR+1=',I4) 5 CONTINUE RETURN END SUBROUTINE MERGE C+ C SUBROUTINE MERGE WILL TAKE NEW WORDS TO BE INCLUDED C IN THE DICTIONARY CREATED BY SPELL AND MERGE THEM WITH C THE THE SEQUENTIAL FILE DATA BASE. THIS WILL THEN BE USED C FOR THE DICTIONARY MAKE ROUTINE. C C THE ROUTINE GETSIZ FROM THE COPIOUS LIBRARY IS USED C HERE TO CREATE SEQUENTIAL LIBRARY THE SAME SIZE AS OLD ONE. C C REMEMBER THAT LUN=1 IS ON SY: LUN=2 IS ON SP: LUN=3 IS ON SP: C AND LUN=4 IS ON NL:. THESE ARE SET IN THE TASKBUILD FILE. C- PARAMETER (MAXADD=150) CHARACTER*30 ADWORD,SQWORD,NWORD,LIST(MAXADD) INTEGER*2 UNIT,DIRDEV,GETSIZ BYTE FILE(30),LUNDAT(12) EQUIVALENCE (UNIT,LUNDAT(3)) EQUIVALENCE (DIRDEV,LUNDAT(5)) DATA FILE/'S','P','0',':','[','7',',','7',']','D','I','C','T' 1,'.','S','E','Q',13*0/ C CALL ASNLUN(1,'SY',0) CALL ERRSET(29,.TRUE.,.FALSE.,.TRUE.,.FALSE.,15)!NO SUCH FILE OPEN(UNIT=1,FILE='DICT.ADD',TYPE='OLD' 1,CARRIAGECONTROL='LIST',ERR=100) I=1 C C FILL LIST TO SORT C 5 READ(1,1000,END=6)LIST(I) I=I+1 IF(I.GT.MAXADD)THEN WRITE(5,1001)MAXADD CALL EXIT END IF GO TO 5 6 LAST=I-1 CLOSE(UNIT=1,DISPOSE='DELETE') CALL SORT(LIST,LAST) !SORT LIST OPEN(UNIT=1,NAME='DICT.TMP',STATUS='SCRATCH' C C WRITE OUT SORTED LIST C 1,CARRIAGECONTROL='LIST') DO 7,I=1,LAST IJ=INDEX(LIST(I),' ')-1 7 WRITE(1,1002)LIST(I)(1:IJ) REWIND 1 CALL GETLUN(3,LUNDAT,IDS) FILE(1)=LUNDAT(1) FILE(2)=LUNDAT(2) UNIT=IAND(UNIT,7) DIRDEV=IAND(DIRDEV,8) IF(DIRDEV.EQ.0)THEN TYPE *,'DICTMK - LUN=3 NOT DIRECTORY DEVICE' CALL EXIT END IF ENCODE (1,109,FILE(3))UNIT C C NOW INCLUDE THIS SORTED FILE WITH THE SEQUENTIAL DICTIONARY C INTSIZ=-GETSIZ(2,FILE) !GET SIZE OF OLD OPEN(UNIT=2,FILE=FILE,STATUS='OLD' 1,CARRIAGECONTROL='LIST',ERR=101) OPEN(UNIT=3,FILE=FILE,STATUS='NEW',INITIALSIZE=INTSIZ 1,CARRIAGECONTROL='LIST',ERR=102) READ(1,1000)ADWORD READ(2,1000)SQWORD 10 IF(ADWORD.GT.SQWORD)THEN IJ=INDEX(SQWORD,' ')-1 WRITE(3,1002)SQWORD(1:IJ) READ(2,1000,END=20)SQWORD GO TO 10 ELSE IF(ADWORD.EQ.SQWORD)THEN IJ=INDEX(SQWORD,' ')-1 WRITE(3,1002)SQWORD(1:IJ) READ(2,1000,END=20)SQWORD READ(1,1000,END=30)ADWORD GO TO 10 ELSE IF(ADWORD.LT.SQWORD)THEN IJ=INDEX(ADWORD,' ')-1 WRITE(3,1002)ADWORD(1:IJ) READ(1,1000,END=30)ADWORD GO TO 10 END IF TYPE *,'DICTMK - LOGIC PROBLEM IN MERGE' CALL EXIT C 20 READ(1,1000,END=40)ADWORD IJ=INDEX(ADWORD,' ')-1 WRITE(3,1002)ADWORD(1:IJ) GO TO 20 C 30 READ(2,1000,END=40)SQWORD IJ=INDEX(SQWORD,' ')-1 WRITE(3,1002)SQWORD(1:IJ) GO TO 30 C 40 CLOSE(UNIT=2) CLOSE(UNIT=1) CLOSE(UNIT=3) RETURN 100 CONTINUE TYPE *,'DICTMK - NO NEW WORDS TO BE ADDED' RETURN 101 TYPE *,'DICTMK - UNABLE TO ACCESS [7,7]DICT.SEQ' CALL EXIT 102 TYPE *,'DICTMK - UNABLE TO CREATE NEW [7,7]DICT.SEQ' CALL EXIT 1000 FORMAT(A30) 1001 FORMAT(' DICTMK - ADD LIST > ',I3) 1002 FORMAT(A) 109 FORMAT(I1) END SUBROUTINE SORT(LIST,LENGTH) C+ C SUBROUTINE SORT WILL SORT A GIVEN LIST OF CHARACTER*25 WORDS C INTO ALPHABETICAL ORDER AND RETURN THEM IN THE SAME ARRAY. C- CHARACTER*30 LIST(LENGTH),WORD LOGICAL*1 RIGHT 5 RIGHT=.TRUE. IF(LIST(I).GT.LIST(I+1))THEN WORD=LIST(I) LIST(I)=LIST(I+1) LIST(I+1)=WORD RIGHT=.FALSE. END IF 10 CONTINUE IF(.NOT.RIGHT)GO TO 5 RETURN END