20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 1 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0001 PROGRAM WORD !! {Out_file} {-Flags} 0002 c.--------------------------------------------------------------------- 0003 c. This program is meant to act as an OnLine Dictionary for 0004 c. the "legal" spelling or words.It looks up the input word in its 0005 c. 35,000 word dictionary. Don't Check: Words starting with Non alpha, 0006 c. Single character words, Trailing punctuation. 0007 c.--------------------------------------------------------------------- 0008 c.Cmd---v 0009 c. Out_file .. Resulting output 0016 c. /EDIT .. Edit the current "Old_file" 0017 c. /EDT .. Edt the current "Old_file" 0018 c. EXIT .. Exit {after processing IN_file} 0019 c. $ Cmd .. Issue the DCL command 0020 c. -B .. Output a Bell on errors 0021 c. -L .. Output each word on a Separate line 0022 c. -P .. Pack the words together {if not -L} 0023 c. -U .. Show multiple occur of Unique bad words 0024 c. -W .. Return the "LEGAL" words in a list format 0025 c. .. otherwise, use interactive mode for on-line correcting. 0026 c. -T .. Output text format with incorrect words flagged 0027 c-----------------------------------------------------------end.of.info 0028 c. -D .. Debug 0029 c. /ZERO .. Clear good and bad 0030 c.----------------------------------------------------------------------- 0031 c. 0032 c. Systems Control Technology, Inc. 0033 c. 1801 Page Mill Rd. 0034 c. Palo Alto, Ca. 94303 0035 c. 0036 c. Revisions Log: 0037 c. M. Liveright initial entry 0038 c. 05-16-83 J. Josselyn make interactive 0039 c.---------------------------------------------------------------------- 0040 c. Words checked by this program must have the following 0041 c. characteristics: 0042 c. -start with an alpha character, "a" to "z"; 0043 c. -be of length less than 20 characters; 0044 c. -if a word ends in "'s", the possessive form checked; 0045 c. -hyphenated words are evaluated as two separate words; 0046 c. -trailing delimiters are eliminated; 0047 c. -words beginning with a period are not checked unless 0048 c. the "-P" switch is specified,(this allows the spelling 0049 c. program to be used in conjunction with Runoff). 0050 c.---------------------------------------------------------------------- 0051 c. 0052 c CALLS JJCTC .. to set and read control C's 0053 c. CALLS JJUCMD .. to read the commands 0054 c CALLS IOPEN .. to open the units for the dictionary files. 0055 c. 0056 c.--------------------------------------------------------------------- 0057 c. WORD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 2 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0058 COMMON /JJU_SWI/ JJUS(256) 0059 COMMON / JJU_FIL / infile, outfile 0060 COMMON / OUTDEV / idev, interflg, icount 0061 character*80 infile, outfile 0062 character*32 cmd, chread, chtem, ian, cmd1, cmd2 0063 character*80 inline, ch1, ch2, oldfile, savlin(3), blklin 0064 character*80 curlin, prtlin, inlin2 0065 integer numch(32) 0066 integer lunopn(20) !! Set 1 if open 0067 character*32200 bad 0068 character*32200 good 0069 character*4 quest 0070 character*5 sline 0071 character*6 snline 0072 c 0073 data good(1:10)/' '/,ixg/1/ 0074 data bad(1:10)/' '/,ixb/1/ 0075 data quest / ' ? ' / 0076 data sline / 'line=' / 0077 data blklin(1:10) / ' ' / 0078 c.------------------------------------------------ 0079 41 format(80a) 0080 42 format(' ',/////) 0081 43 format(' ?',$) 0082 44 format(i6) 0083 c.------------------------------------------------ 0084 c ...set up to trap ctrl-c 0085 call jjctc(1) 0086 c 0087 call LIB$ERASE_PAGE(1,1) 0088 call LIB$SET_CURSOR(1,1) 0089 c 0090 c ... Initalize with "NO_FILE" 0091 c. 0092 500 continue 0093 savlin(1)=blklin 0094 savlin(2)=blklin 0095 savlin(3)=blklin 0096 curlin=blklin 0097 itim=0 0098 if( isexit.eq.1 ) goto 9000 0099 c ... Flush the buffer 0100 call OUTWRD('\N') 0101 c ... Close input unit 0102 close(unit=1) 0103 ch1 = ' ' 0104 ch2 = ' 0 when files are currently open 0131 c ... Get the next word in the cmd line.jjjnxt=# chars. 0132 c ... Or,read in a new line, leaving 1st space blank 0133 c ... put next word from inline to cmd; move that word out 0134 c ... of inline. 0135 c ... On return jjucmd= { >0 : # characters; 0136 c =0 : EOL; 0137 c =-1 : EO@; 0138 c =-2 : ^Z 0139 c. 0140 2000 continue 0141 newflg=0 0142 2010 interflg=0 0143 if( isinfl.gt.0 ) then 0144 if( jjjnxt( cmd, inline ).gt.0 ) goto 2300 0145 read( 1,41,end=500) inline(2:) 0146 inlin2(1:)=inline(2:) 0147 newflg=1 0148 goto 2010 0149 else 0150 call JJUpp(cmd) 0151 idev=6 0152 if(JJUS(ichar('W')).ge.0) idev=-2 0153 if( jjucmd( cmd, inline ) ) 9000, 2100, 2200 0154 endif 0155 c. 0156 2100 continue 0157 if( infile.eq.' NO_FILE' ) goto 1000 0158 0159 if( infile.eq.' *' ) then 0160 infile = oldfile 0161 else 0162 oldfile = infile 0163 endif 0164 0165 inline = ' ' 0166 iret = JJUFIL( ch1, ch2 ) 0167 if( iret.le.0 ) goto 500 0168 isinfl = +1 0169 ixb = 1 0170 numb = 0 0171 nline=0 WORD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 4 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0172 goto 2000 0173 c.------------------------------------------------------------- 0174 c... User only commands 0175 c. 0176 2200 continue 0177 if( cmd(1:1).eq.'?' .or. cmd.eq.'HELP' ) then 0178 if( numg+numb.gt.0 ) 0179 1 type *,' ',numg+numb,' Unique words', numb,' Bad' 0180 if( JJUS(ichar('D')).lt.0 ) 0181 1 type *,ixg, ' Size of Good',ixb,' Size of Bad' 0182 type *,'Word? {Cmd} {Out_file}' 0183 type *,' {Word} {aaaaa} {aa...{bb}} {aa?bb}' 0184 type *,' {Flags} {-Line} {-Pack}' 0185 type *,' {Other} {/EDIT} {/EDT} {$ dcl_cmd} {EXIT}' 0186 if( oldfile(2:).gt.' ' ) 0187 1 type *,' {Lst <*} <',Oldfile(2:jjlen(oldfile)) 0188 goto 1000 0189 else if(cmd(1:1).eq.'=' ) then 0190 open(unit=1,name=inline(2:),type='old',err=1000) 0191 type *,' Reading ',inline(1:jjlen(inline)) 0192 2311 continue 0193 read(1,41,end=2312)inline 0194 lnl = jjlen(inline) 0195 call jjlow(inline(1:lnl)) 0196 good(ixg+1:ixg+lnl+4) = inline 0197 ixg = ixg+lnl+2 0198 goto 2311 0199 2312 continue 0200 close(unit=1) 0201 goto 1000 0202 else if(cmd.eq.'/EDT' ) then 0203 call lib$spawn('EDIT/EDT/Command=SCI_COM:EDTINI '//oldfile) 0204 goto 1000 0205 else if( cmd.eq.'/ZERO' ) then 0206 type *,ixg,' Siz of Good',ixb,' Siz of Bad, ZEROED' 0207 ixb = 1 0208 ixg = 1 0209 numg = 0 0210 numb = 0 0211 goto 1000 0212 else if(cmd(1:1).eq.'/' ) then 0213 call LIB$SPAWN( cmd(2:jjlen(cmd))//' '//oldfile ) 0214 goto 1000 0215 else if( cmd.eq.'EXIT' ) then 0216 isexit = 1 0217 if( infile.eq.' NO_FILE' ) goto 9000 0218 goto 2000 0219 endif 0220 c.---------------------------------------------------------------- 0221 c... O.K. not a User command 0222 c. 0223 2300 continue 0224 if(newflg.ne.1) goto 2310 0225 c ...if a new line of text was just read then, 0226 c ... if this is interactive mode, save the last line 0227 c ... if this is the output text mode, write the last line 0228 c ...reset the newflg to zero. WORD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 5 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0229 if(JJUS(ichar('W')).ge.0) then 0230 savlin(1)=savlin(2) 0231 savlin(2)=savlin(3) 0232 savlin(3)=curlin 0233 endif 0234 c 0235 if(((JJUS(ichar('T')).lt.0).or.(JJUS(ichar('W')).ge.0)) 0236 * .and.(itim.gt.0)) then 0237 do ln4=80,1,-1 0238 if(curlin(ln4:ln4).gt.' ') goto 52 0239 enddo 0240 if(ln4.lt.1) goto 55 0241 52 write(6,41) curlin(1:ln4) 0242 endif 0243 c 0244 55 if((JJUS(ichar('W')).lt.0).or.(itim.ne.0)) goto 2305 0245 do 50 i=1,60,5 0246 prtlin(i:i+4)='-----' 0247 50 continue 0248 call LIB$ERASE_PAGE(1,1) 0249 call LIB$PUT_SCREEN(prtlin,9,1) 0250 call LIB$SET_SCROLL(10,24) 0251 call LIB$SET_CURSOR(1,1) 0252 c. 0253 2305 itim=1 0254 nline=nline+1 0255 curlin=inlin2 0256 newflg=0 0257 c 0258 2310 if( jjctc(0).gt.0 ) then 0259 type 41,' Enter: ^Z to exit',07 0260 goto 1500 0261 endif 0262 c ... make all lower case 0263 cmd1=cmd 0264 call JJUpp(cmd) 0265 call jjlow(cmd) 0266 C ... ln=length of the cmd word 0267 ln = jjlen(cmd) 0268 c ... 1st letter in the word must be an alpha 0269 if( cmd(1:1).lt.'a' .or. cmd(1:1).gt.'z' ) goto 2000 0270 c ... length of the word must be <20 characters. 0271 if( ln.ge.20 ) goto 2000 0272 c ... This is to look up the spelling of a user entered 0273 c ... word in the dictionary.isinfl=0;no input document. 0274 if( isinfl.le.0 ) then 0275 if( index(cmd,'...').ne.0 ) goto 4000 !! aaaa... 0276 if( index(cmd,'?').ne.0 ) goto 3000 !! aa?bb 0277 endif 0278 c ... Find the last alpha character;this gets rid of 0279 c ... blanks,commas,periods and other delimiters. 0280 do ln=ln,1,-1 0281 if( cmd(ln:ln).ge.'a'.and.cmd(ln:ln).le.'z' ) goto 2500 0282 enddo 0283 goto 2000 0284 c ... Checking a word from an input document. 0285 c ... If "'s" ---strip it. WORD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 6 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0286 2500 continue 0287 if(ln.le.2) goto 2505 0288 if( cmd(ln-1:ln).eq.'''s' ) ln = ln-2 0289 c ... Evaluate hyphenated words or words w/ periods 0290 c ... as two separate words. Alter inline accordingly. 0291 2505 do ii=ln,1,-1 0292 if( cmd(ii:ii).eq.'.' .or. cmd(ii:ii).eq.'-' ) then 0293 inline(ii:ii) = ' ' 0294 cmd(ii:) = ' ' 0295 ln = ii-1 0296 endif 0297 enddo 0298 c ... If word is just one letter, dont check.continue. 0299 if( ln.le.1 ) goto 2000 0300 c. ... Is the word already in the array of "good" words? 0301 if( index(good(1:ixg),' '//cmd(1:ln)//' ').ne.0 ) goto 2650 0302 c ... Has the word already been tagged as a bad word? 0303 c ... If so, and there is an input document and the "U" 0304 c ... option was chosen, dont print it again. continue. 0305 if( index(bad(1:ixb),' '//cmd(1:ln)//' ').ne.0 ) then 0306 if( isinfl.gt.0 .and. JJUS(ichar('U')).ge.0 ) goto 2000 0307 goto 2770 0308 endif 0309 c ... Has the isam dictionary file for words of this 0310 c ... length been opened yet? 0311 if( lunopn(ln).eq.0 ) lunopn(ln) = IOPEN( ln ) 0312 c ... try to do an index read of keyeq=equal for the word 0313 c ... If the word isnt in the dictionary,goto 2750;its bad 0314 c ... If its found,add it to the list of found good words. 0315 read(50+ln,41,keyeq=cmd(1:ln),err=2750) chread 0316 numg = numg+1 0317 if( ixg.le.32000 ) then 0318 good(ixg+1:ixg+ln+4) = ' '//cmd(1:ln) 0319 ixg = ixg+ln+2 0320 if(JJUS(ichar('D')).lt.0 ) type *,ixg,' Good' 0321 endif 0322 2650 continue 0323 c ... If checking a user entered single word; print ok. 0324 if( isinfl.le.0 ) then 0325 write(6,41)' Ok `',cmd(1:ln),'''' 0326 endif 0327 goto 2000 0328 c 0329 c. ----------------------------------------------------------- 0330 c ... Word wasnt in the dictionary. 0331 2750 continue 0332 numb = numb+1 0333 c ... Add word to the list of found bad words.limit=32000 0334 if( ixb.lt.32000 ) then 0335 bad(ixb+1:ixb+ln+4)=' '//cmd(1:ln) 0336 ixb = ixb+ln+2 0337 if(JJUS(ichar('D')).lt.0 ) type *,ixb,' Bad' 0338 endif 0339 2770 continue 0340 interflg=0 0341 c ... if this is output text mode, flag the word. 0342 if(JJUS(ichar('T')).lt.0) goto 2900 WORD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 7 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0343 c ... if this is interactive, get user input to correct it 0344 if(JJUS(ichar('W')).ge.0) goto 2800 0345 c ... If checking user entered single words;tell user 0346 c ... its not spelled correctly. 0347 if( isinfl.le.0 ) then 0348 write(6,41)' `',cmd(1:ln),''' *NO*' 0349 else 0350 c ... If the 'b' switch is used, ring bell; output to list 0351 if( JJUS(ichar('B')).lt.0 ) type 41,'+',07 0352 if( ln.ge.20 ) ln = 19 0353 call OUTWRD( cmd(1:ln) ) 0354 endif 0355 goto 2000 0356 c------------------------------------------------------------------ 0357 c ... Interactive correction mode 0358 c ... clear the screen;write out the last three lines; 0359 c ...ask for user response to correct the word 0360 c 0361 2800 call LIB$ERASE_PAGE(10,1) 0362 2810 call LIB$SET_CURSOR(1,1) 0363 cmd=cmd1 0364 ln=jjlen(cmd) 0365 nlc=index(curlin,cmd(1:ln)) 0366 interflg=1 0367 ian=cmd 0368 i=4 0369 j=1 0370 call LIB$ERASE_LINE(i,1) 0371 call LIB$ERASE_LINE(i+1,1) 0372 call LIB$ERASE_LINE(i+2,1) 0373 call LIB$PUT_SCREEN(savlin(2),i,j) 0374 call LIB$PUT_SCREEN(savlin(3),i+1,j) 0375 call LIB$SET_CURSOR(i+2,1) 0376 if(nlc.gt.1) call LIB$PUT_SCREEN(curlin(1:nlc-1),i+2,j) 0377 call LIB$PUT_SCREEN(cmd(1:ln),,,2) 0378 call LIB$PUT_SCREEN(curlin(nlc+ln:)) 0379 call LIB$PUT_SCREEN(sline,i+3,65) 0380 write(snline,44) nline 0381 call LIB$PUT_SCREEN(snline,i+3,71) 0382 2820 call LIB$ERASE_LINE(i+4,1) 0383 call LIB$SET_CURSOR(i+4,1) 0384 call LIB$GET_SCREEN(cmd,quest,ln2) 0385 call LIB$SET_CURSOR(11,1) 0386 c 0387 cmd2=cmd 0388 call JJUPP(cmd) 0389 call JJLOW(cmd) 0390 if(index(cmd,'...').ne.0) goto 4000 0391 if(index(cmd,'?' ).ne.0) goto 3000 0392 if(index(cmd,'=' ).ne.0) goto 8000 0393 if(cmd(1:1).eq.' ') goto 2850 0394 if((cmd(1:1).gt.'0').and.(cmd(1:1).le.'9')) then 0395 interflg=9 0396 call outwrd(cmd2) 0397 endif 0398 cmd=cmd2 0399 ln1=JJLEN(cmd) WORD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 8 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0400 curlin(nlc:)=cmd(1:ln1)//curlin(nlc+ln:) 0401 inline(1:)=' '//cmd(1:ln1)//inline(ln+1:) 0402 interflg=0 0403 if(jjjnxt( cmd, inline ) .gt. 0) goto 2300 0404 c 0405 2850 call LIB$ERASE_PAGE(11,1) 0406 goto 2000 0407 c------------------------------------------------------------------ 0408 c ... Output text with the incorrect word flagged 0409 c 0410 2900 loc=1 0411 cmd=cmd1 0412 ln=jjlen(cmd) 0413 2910 nlc=index(curlin(loc:),cmd(1:ln)) 0414 in=index(curlin(loc:),' ?> ') 0415 if(in.eq.0) goto 2912 0416 if(in.ne.nlc-4) goto 2912 0417 loc=nlc+1 0418 goto 2910 0419 c ... Find the last alpha character;this gets rid of 0420 c ... blanks,commas,periods and other delimiters. 0421 2912 do ln3=80,1,-1 0422 if( curlin(ln3:ln3).gt.' ') goto 2915 0423 enddo 0424 2915 if(ln3.le.76) goto 2920 0425 if(nlc.gt.1) then 0426 write(6,41) curlin(1:nlc-1) 0427 curlin(1:)=curlin(nlc:80) 0428 loc=1 0429 goto 2910 0430 endif 0431 if(nlc.eq.1) then 0432 write(6,41) ' ?> '//curlin(1:ln) 0433 curlin(1:)=curlin(ln+1:80-ln) 0434 goto 2000 0435 endif 0436 2920 curlin(nlc:)=' ?> '//curlin(nlc:76) 0437 goto 2000 0438 c.----------------------------------------------------------------- 0439 c... Test for questional spellings 0440 c. 0441 3000 continue 0442 if( lunopn(ln).eq.0 ) lunopn(ln) = IOPEN( ln ) 0443 chtem = cmd 0444 inx = index(cmd,'?') 0445 c. 0446 c ... Zero the count of bad words. 0447 call outwrd('\Z') 0448 c ...one char. missing of format aaa?aaa.fill in w/ a to z 0449 do ix='a','z' 0450 cmd(inx:inx) = char(ix) 0451 if( jjctc(0).gt.0 ) goto 1000 0452 read(50+ln,41,keyeq=cmd(1:ln),err=3900)chread 0453 call outwrd(chread(1:ln)//',') 0454 3900 continue 0455 enddo 0456 call outwrd('<----End') WORD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 9 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0457 c ... Flush buffer 0458 call outwrd('\N') 0459 if(interflg.ne.1) goto 2000 0460 cmd=ian 0461 goto 2820 0462 c.------------------------------------------------------------------- 0463 c... test for continuations 0464 c. 0465 4000 continue 0466 c ... Init. the output buffer 0467 call outwrd('\Z') 0468 ldot = index(cmd,'...')-1 0469 if( ldot.lt.1 ) then 0470 type *,'Can''t have Dot''s at start' 0471 goto 2000 0472 endif 0473 chtem = cmd(1:ldot) 0474 ch2 = cmd(ldot+4:) 0475 ltrl = jjlen(ch2) 0476 if( ch2.le.' ' ) ltrl = 0 0477 c ... Going to do the set of possible word lengths 0478 c ... Go from the file of shortest possible words to long. 0479 do ltst=ldot+ltrl, 20-ltrl 0480 c ... If ctrl-c, stop list. 0481 if( jjctc(0).gt.0 ) goto 1000 0482 if( lunopn(ltst).eq.0 ) lunopn(ltst) = IOPEN( ltst ) 0483 c ... Read the prefix part; aaa_ 0484 read(50+ltst,41,keyge=chtem(1:ltst),err=4900) chread 0485 goto 4500 0486 c. 0487 4100 continue 0488 if( jjctc(0).gt.0 ) goto 1000 0489 read(50+ltst,41,end=4900) chread 0490 c. 0491 4500 continue 0492 if( chread(1:ldot).eq.chtem ) then 0493 if( ltrl.eq.0 ) goto 4600 0494 if(chread(ltst-ltrl+1:ltst).ne.ch2) goto 4100 0495 4600 continue 0496 call outwrd( chread(1:ltst)//',' ) 0497 goto 4100 0498 endif 0499 4900 continue 0500 enddo 0501 c ... Flush buffer and return for another user command 0502 call outwrd('<----End') 0503 call outwrd('\N') 0504 if(interflg.ne.1) goto 2000 0505 cmd=ian 0506 goto 2820 0507 c.---------------------------------------------------------------- 0508 c... Segment to create dictionary 0509 c. 0510 8000 continue 0511 read(1,41,end=9000)cmd 0512 n = jjlen(cmd) 0513 numch(n) = numch(n)+1 WORD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 10 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0514 iun = 50+n 0515 write(iun,41) cmd(1:n) 0516 if(JJUS(ichar('W')).ge.0) goto 2000 0517 goto 2000 0518 c. 0519 9000 continue 0520 call OUTWRD('\N') 0521 type *,numg+numb,' Unique words', numb,' Bad' 0522 if( JJUS(ichar('D')).lt.0 ) 0523 1 type *,ixg,' Siz of Good',ixb,' Siz of Bad' 0524 end WORD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 11 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 7447 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 530 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 66712 PIC CON REL LCL NOSHR NOEXE RD WRT LONG 3 JJU_SWI 1024 PIC OVR REL GBL SHR NOEXE RD WRT LONG 4 JJU_FIL 160 PIC OVR REL GBL SHR NOEXE RD WRT LONG 5 OUTDEV 12 PIC OVR REL GBL SHR NOEXE RD WRT LONG Total Space Allocated 75885 ENTRY POINTS Address Type Name 0-00000000 WORD VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000500 CHAR BAD 2-000003C0 CHAR BLKLIN 2-000002D0 CHAR CH1 2-00000320 CHAR CH2 2-000001E0 CHAR CHREAD 2-00000200 CHAR CHTEM 2-000001C0 CHAR CMD 2-00000240 CHAR CMD1 2-00000260 CHAR CMD2 2-00000410 CHAR CURLIN 2-000082C8 CHAR GOOD 2-000100D0 I*4 I 2-00000220 CHAR IAN 5-00000008 I*4 ICOUNT 5-00000000 I*4 IDEV 2-000100D8 I*4 II 2-000100F0 I*4 IN 4-00000000 CHAR INFILE 2-000004B0 CHAR INLIN2 2-00000280 CHAR INLINE 5-00000004 I*4 INTERFLG 2-000100F8 I*4 INX 2-000100B8 I*4 IRET 2-000100AC I*4 ISEXIT 2-000100B0 I*4 ISINFL 2-000100A8 I*4 ITIM 2-00010110 I*4 IUN 2-000100FC I*4 IX 2-000100A4 I*4 IXB 2-000100A0 I*4 IXG 2-000100E0 I*4 J 2-00010100 I*4 LDOT 2-000100D4 I*4 LN 2-000100E8 I*4 LN1 2-000100E4 I*4 LN2 2-000100F4 I*4 LN3 2-000100CC I*4 LN4 2-000100C8 I*4 LNL 2-000100EC I*4 LOC 2-00010104 I*4 LTRL 2-00010108 I*4 LTST 2-0001010C I*4 N 2-000100B4 I*4 NEWFLG 2-000100DC I*4 NLC 2-000100C0 I*4 NLINE 2-000100BC I*4 NUMB 2-000100C4 I*4 NUMG 2-00000370 CHAR OLDFILE 4-00000050 CHAR OUTFILE 2-00000460 CHAR PRTLIN 2-00010090 CHAR QUEST 2-00010094 CHAR SLINE 2-00010099 CHAR SNLINE ARRAYS Address Type Name Bytes Dimensions 3-00000000 I*4 JJUS 1024 (256) 2-00000080 I*4 LUNOPN 80 (20) 2-00000000 I*4 NUMCH 128 (32) 2-000000D0 CHAR SAVLIN 240 (3) WORD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 12 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 LABELS Address Label Address Label Address Label Address Label Address Label Address Label 1-000001BA 41' ** 42' ** 43' 1-000001BE 44' 0-000008C3 50 0-00000821 52 0-00000875 55 0-00000024 500 0-000000B5 1000 0-000000F1 1500 0-0000012B 2000 0-0000012E 2010 0-0000022C 2100 0-000002A3 2200 0-0000078A 2300 0-000008EE 2305 0-00000906 2310 0-0000054A 2311 0-0000060A 2312 0-00000A55 2500 0-00000A95 2505 0-00000DD9 2650 0-00000E47 2750 0-00000F12 2770 0-00001017 2800 0-00001020 2810 0-0000121F 2820 0-00001493 2850 0-0000149F 2900 0-000014BC 2910 0-0000157E 2912 0-000015B9 2915 0-0000175E 2920 0-000017CB 3000 0-00001912 3900 0-0000194A 4000 0-00001AAA 4100 0-00001AE3 4500 0-00001B5A 4600 0-00001BAD 4900 0-00001BE3 8000 0-00001C8A 9000 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name FOR$CLOSE FOR$OPEN I*4 IOPEN I*4 JJCTC I*4 JJJNXT I*4 JJLEN JJLOW I*4 JJUCMD I*4 JJUFIL JJUPP LIB$ERASE_LINE LIB$ERASE_PAGE LIB$GET_SCREEN I*4 LIB$INDEX LIB$PUT_SCREEN LIB$SET_CURSOR LIB$SET_SCROLL LIB$SPAWN OUTWRD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 13 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0001 FUNCTION IOPEN( iunit ) 0002 c. Check and Open if necessary, UNIT=50+iunit 0003 c. 0004 c-------------------------------------------------------------------- 0005 integer lunopn(20) !! Set 1 if open 0006 character*2 fname 0007 character*60 fdir 0008 integer JPILIST(4) 0009 data JPILIST(1)/'02070040'x/ !!Get exe dir 0010 c. 0011 c...... 0012 if( lunopn(iunit).eq.0 ) then !! Unit not open yet 0013 lunopn(iunit) = 1 0014 if( fdir.le.' ' ) then !! Find Directory of WORD 0015 JPILIST(2) = %LOC( fdir ) 0016 call SYS$GETJPI(,,,JPILIST,,,) 0017 inx = index(fdir,']') 0018 fdir(inx+1:) = 'WORDS.L' 0019 endif 0020 write(fname,110)iunit 0021 110 format(i2.2) 0022 open(unit=50+iunit,name=fdir//fname,type='OLD',readonly 0023 1 ,carriagecontrol='list' 0024 1 ,organization='indexed' 0025 1 ,form='formatted',recordtype='variable' 0026 1 ,recl=iunit 0027 1 ,access='keyed',key=(1:iunit:character) ) 0028 c. 0029 endif 0030 c. 0031 IOPEN = 1 0032 return 0033 end IOPEN 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 14 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 214 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 13 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 320 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 547 ENTRY POINTS Address Type Name 0-00000000 I*4 IOPEN VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name 2-00000062 CHAR FDIR 2-00000060 CHAR FNAME 2-000000A4 I*4 INX AP-00000004@ I*4 IUNIT ARRAYS Address Type Name Bytes Dimensions 2-00000050 I*4 JPILIST 16 (4) 2-00000000 I*4 LUNOPN 80 (20) LABELS Address Label 1-00000002 110' FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name FOR$OPEN I*4 LIB$INDEX SYS$GETJPI 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 15 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0001 SUBROUTINE OUTWRD( cmd ) 0002 c. Output a "word" 0003 c. 0004 c.Inp cmd .. Word, or \Z, or \N 0005 c.Uses JJUSWI('L') .. Force each word on a line 0006 c. JJUSWI('P') .. Pack the words 0007 c. 0008 c.Assume... That the files with the Indexed words are in the 0009 c. directory under which this program EXECUTES, and have names: 0010 c. "WORDS.Lnn", where nn is the Length of the word. 0011 c. 0012 c.Note.. These are Created, from a sequentual list of the 0013 c. words by the program WORDMAKE, and words are Added, Tested, 0014 c. or Deleted by the program WORDADD. 0015 c-------------------------------------------------------------------- 0016 common /JJU_SWI/ JJUS(256) 0017 common / OUTDEV / idev, intflg, icnt 0018 character*(*) cmd 0019 character*80 line 0020 character*4 iscnt 0021 c 0022 character*20 isaw(1000) 0023 41 format(132a) 0024 55 format(i4) 0025 53 format(i3) 0026 52 format(i2) 0027 51 format(i1) 0028 c...... 0029 if(intflg.eq.9) goto 100 0030 iscnt=' ' 0031 if( cmd.eq.'\Z' ) then 0032 inx = 0 0033 call LIB$ERASE_PAGE(10,1) 0034 icnt=0 0035 else if( cmd.eq.'\N' ) then 0036 if( inx.gt.0 ) write(idev,41) ' ',line(1:inx) 0037 inx = 0 0038 ibig=icnt 0039 icnt=0 0040 else 0041 ln = jjlen(cmd) 0042 if( inx+ln+4.gt.80 ) then 0043 write (idev,41) ' ',line(1:inx) 0044 inx = 0 0045 endif 0046 icnt=icnt+1 0047 if(cmd(1:1).eq.'<') goto 40 0048 if(icnt.gt.99) write(iscnt(1:3),53) icnt 0049 if((icnt.gt.9).and.(icnt.lt.100)) write(iscnt(1:2),52) icnt 0050 if(icnt.lt.10) write(iscnt(1:1),51) icnt 0051 if(intflg.ne.1) line(inx+1:) = cmd 0052 40 if(intflg.eq.1) line(inx+1:) = iscnt//cmd 0053 call jjupp(line(inx+1:inx+1)) 0054 if(icnt.ge.1000) goto 50 0055 isaw(icnt)=' ' 0056 isaw(icnt)=cmd 0057 50 if( JJUS(ichar('L')).lt.0 ) then OUTWRD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 16 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0058 write(idev,41) ' ',line(1:inx+1+ln) 0059 inx = 0 0060 else if( JJUS(ichar('P')).lt.0 ) then 0061 inx = inx+ln+2 0062 else 0063 inx = inx+20+(4*intflg) 0064 endif 0065 endif 0066 goto 1000 0067 c 0068 100 ln=jjlen(cmd) 0069 read(cmd(1:ln),53) icnt 0070 if(ibig.le.icnt) goto 1000 0071 if((icnt.lt.1).or.(icnt.gt.999)) goto 1000 0072 do ln1=20,1,-1 0073 if(isaw(icnt)(ln1:ln1).gt.',') goto 110 0074 enddo 0075 110 cmd(1:ln1)=isaw(icnt)(1:ln1) 0076 c. 0077 1000 return 0078 end PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 1306 PIC CON REL LCL SHR EXE RD NOWRT LONG 1 $PDATA 47 PIC CON REL LCL SHR NOEXE RD NOWRT LONG 2 $LOCAL 20160 PIC CON REL LCL NOSHR NOEXE RD WRT LONG 3 JJU_SWI 1024 PIC OVR REL GBL SHR NOEXE RD WRT LONG 4 OUTDEV 12 PIC OVR REL GBL SHR NOEXE RD WRT LONG Total Space Allocated 22549 ENTRY POINTS Address Type Name 0-00000000 OUTWRD VARIABLES Address Type Name Address Type Name Address Type Name Address Type Name AP-00000004@ CHAR CMD 2-00004E78 I*4 IBIG 4-00000008 I*4 ICNT 4-00000000 I*4 IDEV 4-00000004 I*4 INTFLG 2-00004E74 I*4 INX 2-00004E70 CHAR ISCNT 2-00004E20 CHAR LINE 2-00004E7C I*4 LN 2-00004E80 I*4 LN1 OUTWRD 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 17 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 ARRAYS Address Type Name Bytes Dimensions 2-00000000 CHAR ISAW 20000 (1000) 3-00000000 I*4 JJUS 1024 (256) LABELS Address Label Address Label Address Label Address Label Address Label Address Label 0-00000298 40 1-00000009 41' 0-00000365 50 1-00000014 51' 1-00000011 52' 1-0000000E 53' ** 55' 0-000003FA 100 0-000004C0 110 0-00000519 1000 FUNCTIONS AND SUBROUTINES REFERENCED Type Name Type Name Type Name I*4 JJLEN JJUPP LIB$ERASE_PAGE 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 18 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 0001 FUNCTION JJJNXT( upcmd, cmd ) 0002 c. Get the next word from the Command line 0003 c. 0004 c.out JJJNXT -- Number of chars in word, 0:No-more 0005 c.out UPCMD -- UPPERCASED next word 0006 c.I/O CMD -- The Inital, and final command line 0007 c---------------------------------------------------------end.of.info 0008 character*(*) upcmd, cmd 0009 c. 0010 c/// Eat up LEAD word 0011 c. 0012 JJJNXT = 0 0013 upcmd = ' ' 0014 do while( cmd(1:1).gt.' ' ) 0015 cmd = cmd(2:) 0016 enddo 0017 c. 0018 if( cmd.eq.' ' ) goto 9000 0019 c. 0020 do while( cmd(1:1).le.' ' ) 0021 cmd = cmd(2:) 0022 if( cmd.eq.' ' ) goto 9000 0023 enddo 0024 c. 0025 c/// Find end of word 0026 c. 0027 do JJJNXT=2,len(cmd)-1 0028 if( cmd(JJJNXT:JJJNXT).lt.'A' ) goto 1900 0029 enddo 0030 1900 continue 0031 upcmd = cmd(1:JJJNXT-1) 0032 c. call JJUpp(upcmd) 0033 c. 0034 9000 continue 0035 return 0036 end JJJNXT 20-May-1983 17:22:04 VAX-11 FORTRAN V3.0-2 Page 19 20-May-1983 17:22:01 DRB1:[SCI.JILL]WORD.FOR;199 PROGRAM SECTIONS Name Bytes Attributes 0 $CODE 340 PIC CON REL LCL SHR EXE RD NOWRT LONG 2 $LOCAL 32 PIC CON REL LCL NOSHR NOEXE RD WRT LONG Total Space Allocated 372 ENTRY POINTS Address Type Name 0-00000000 I*4 JJJNXT VARIABLES Address Type Name Address Type Name AP-00000008@ CHAR CMD AP-00000004@ CHAR UPCMD LABELS Address Label Address Label 0-0000011F 1900 0-0000014F 9000 COMMAND QUALIFIERS FORTRAN /NOF77/NOLIST/LIST/DEBUG/CHECK=ALL/NOOPT/CONTINUATION=30 WORD /CHECK=(BOUNDS,OVERFLOW,UNDERFLOW) /DEBUG=(SYMBOLS,TRACEBACK) /STANDARD=(NOSYNTAX,NOSOURCE_FORM) /SHOW=(NOPREPROCESSOR,NOINCLUDE,MAP) /NOF77 /NOG_FLOATING /I4 /NOOPTIMIZE /WARNINGS /NOD_LINES /NOCROSS_REFERENCE /NOMACHINE_CODE /CONTINUATIONS=30 COMPILATION STATISTICS Run Time: 19.14 seconds Elapsed Time: 21.70 seconds Page Faults: 931 Dynamic Memory: 274 pages