c======================================================================= c Build A Project Dictionary c======================================================================= implicit none include 'spell_include' character*80 buf integer*4 i,j,k,l,record_count integer*4 word_len,buf_len,new_word integer*4 compare_words byte word(word_size) c initilize things record_count = 0 project_ptr_limit = 0 project_buf_limit = 0 c open user dictionary word file open (unit=9,file='PROJECT_WORDS.DAT', x READONLY,status='OLD') c read word from user word file 10 read (unit=9,fmt=1000,end=100) buf_len,buf record_count = record_count + 1 c skip leading blanks in word string do i = 1,buf_len if (buf(i:i).ne.' ') goto 20 end do type *,' Warning - blank record found in user word file' goto 10 c copy word to word buffer and convert to lowercase 20 word_len = 0 j = 1 do k = i,buf_len if (buf(k:k).eq.' ') goto 30 j = j + 1 if (j.gt.word_size) then type *,' Error - word buffer overflow' goto 200 else word(j) = ichar(buf(k:k)) word_len = word_len + 1 if ((word(j).ge.'A').and.(word(j).le.'Z')) x word(j) = word(j) + 32 end if end do 30 word(1) = word_len ! fix 01 c test for overflow if (project_ptr_limit.ge.project_ptr_array_size) then ! fix 01 type *,' Error - word pointer array full' goto 200 end if if ((project_buf_limit+word_len).gt. x project_buf_array_size) then type *,' Error - word buffer full' goto 200 end if c insert word length into buffer project_buf_limit = project_buf_limit + 1 c save location of new word new_word = project_buf_limit project_buf(project_buf_limit) = word_len c insert word into buffer do i = 2,word_len+1 project_buf_limit = project_buf_limit + 1 project_buf(project_buf_limit) = word(i) end do c save location of word in buffer into pointer list in sort order if (project_ptr_limit.le.0) then ! first word project_ptr_limit = user_ptr_limit + 1 project_ptr(project_ptr_limit) = new_word else do i = 1,project_ptr_limit j = compare_words(word,project_buf(project_ptr(i))) if (j.eq.0) then write (*,2010) (word(k),k=2,word_len+1) goto 10 else if (j.lt.0) then do k = project_ptr_limit,i,-1 project_ptr(k+1) = project_ptr(k) end do project_ptr_limit = project_ptr_limit + 1 project_ptr(i) = new_word goto 40 endif end do c insert the word at the end of the list project_ptr_limit = project_ptr_limit + 1 project_ptr(project_ptr_limit) = new_word end if c display message 40 write (*,2000) word_len,(word(i),i=2,word_len+1) goto 10 c close files and write use dictionary file 100 close (9) type *,' Pointers Used ',project_ptr_limit type *,' Pointers Free ', x project_ptr_array_size - project_ptr_limit type *,' Buffer Used ',project_buf_limit type *,' Buffer Free ', x project_buf_array_size - project_buf_limit type *,' Records Read ',record_count open (unit=10,file='PROJECT.DICT', x form='UNFORMATTED',recordtype='SEGMENTED',status='NEW') write (unit=10) project_ptr_limit,project_buf_limit, x project_ptr,project_buf close (unit=10) c error exit for program 200 close (9) 1000 format (q,a) 2000 format(' Project dictionary word [',i2,'] ',a) 2010 format(' Warning - Duplicate word in project word list ', x '[',a,']') end