; ; SPELL version 2.1 February 16, 1985 ; ; written by Michael C. Adler ; ; History of SPELL's dictionary: ; The first SPELL using this dictionary was probably written ; by Ralph Gorin at Stanford. It was transported to MIT by ; Wayne Mattson. Both the program at MIT and the dictionary ; were most recently revised by William Ackerman. ; ; Thanks to all for the effort spent desigining ; the dictionary! ; -Michael ; ; .Z80 TITLE SPELL ; JMP START <--Include this line if assembled under anything ; but M80. ERRCHR: DB 0 ; This is the character that marks ; Unfound words. for wordstar, it ; Must be 0. if you are using another ; Editor, set errchr to the ascii ; Equivalent of the character that ; Should mark misspelled words. DEFDSK: DB 1 ; Default disk (1 ==> A:) DB '(C) 1982 Michael C. Adler. ' DB 'This program has been released into the public domain ' DB 'by the author. It may neither be sold for profit nor ' DB 'included in a sold software package without permission ' DB 'of the author.' ; ; SPELL will compare words in a document to a dictionary ; and mark any words that are not found. It is intended for use ; with WordStar's ^QL (Find Misspelling) command. Words are marked ; with a preceding null if they are not found. ; ; WARNING: SPELL requires a Z80 processor. ; ; MODIFICATION HISTORY: ; ; 2.1 - February 16, 1985 B.Eiben, EIBEN@DEC-MARLBORO ; -shifted ERRCHR and DEFDSK high up for easy patching ; 2.0 - December 22, 1982 Michael Adler ; -Bug fix: modified to rename files correctly at end of ; run if output drive is different from input drive. ; -Bug fix: modified to recognize hyphenated words in indented ; text. ; -Enhanced to allow user specified dictionaries on command ; line. ; 1.3 - October 10, 1982 Michael Adler ; -Bug fix: crashed if number of unique words was multiple ; of 256. ; 1.2 - October 8, 1982 Michael Adler ; -Modified MEMWRD routine to store words backwards in ; memory starting just below the BDOS. Thus, maximum ; memory is utilized since pointers to words and the words ; grow toward each other. ; -FILE.UDC is now deleted if it is empty. ; -Added messages displaying number of words, number of ; unique words, and number of words not found. ; 1.1 - August 28, 1982 Michael Adler ; -Crashed if file.ADD had a zero length word. Fixed. ; -Fixed bug in AUXDIC: stopped reading from .ADD file ; when 0 encountered. ; -Fixed compatability with WS R(un program). WS initializes ; byte at 6CH with default drive instead of 0. Caused output ; to be directed to wrong drive sometimes. ; -Set SPELL to ignore lines starting with . because WS can't ; handle misspelling markers in dot command lines. ; -SPELL did not find hyphenated words if LF had parity bit ; set. Fixed. ; ; 1.0 - August 16, 1982 Michael Adler ; -Released ; START: JP BEGIN INCLUDE SPELL0.MAC BOOT EQU 0000H BDOS EQU BOOT+0005H IFCB EQU BOOT+005CH TPA EQU BOOT+0100H CONOUT EQU 2 STROUT EQU 9 OPEN EQU 15 CLOSE EQU 16 DELETE EQU 19 READ EQU 20 WRITE EQU 21 MAKE EQU 22 RENAME EQU 23 CURDSK EQU 25 SETDMA EQU 26 ; Set dma address RANREA EQU 33 ; Read random LF EQU 10 CR EQU 13 EOF EQU 01AH ; End of file character ; ; The following are bit flags for the dictionary ; ZFLAG EQU 1 YFLAG EQU 2 RFLAG EQU 4 GFLAG EQU 8 DFLAG EQU 16 MFLAG EQU 32 SFLAG EQU 64 HFLAG EQU 256 VFLAG EQU 512 JFLAG EQU 1024 XFLAG EQU 2048 TFLAG EQU 4096 NFLAG EQU 8192 PFLAG EQU 16384 ; ; Macros ; JISIT MACRO CHAR, JMPLOC ; Jump to jmploc if (hl) .eq. char LD A,CHAR CP (HL) JP Z,JMPLOC ENDM QISIT MACRO CHAR, JMPLOC ; Quick form of jisit. character ; To compare is already in a CP CHAR JP Z,JMPLOC ENDM ISIT MACRO CHAR ; Jump to wrdnot if (hl) .ne. char LD A,CHAR CP (HL) JP NZ,WRDNOT ENDM BEGIN: LD SP,STACK ; Create a stack LD A,0C9H ; Return instruction LD (TPA),A ; Don't allow second run of program LD DE,WELCOM ; Print signon message LD C,STROUT CALL BDOS JR START0 WELCOM: DB 'SPELL V2.1 -- February 16, 1985',CR,LF DB '(C) 1982 Michael C. Adler',CR,LF,'$' START0: LD A,(BOOT+6CH) ; Get output drive PUSH PSW ; Save it LD C,OPEN ; Open the dictionary file LD DE,DICFCB CALL BDOS CP 0FFH ; Found? JP NZ,SETUP ; Jump if found LD A,(DEFDSK) ; Try drive a if not on default drive LD (DICFCB),A LD C,OPEN LD DE,DICFCB CALL BDOS CP 0FFH ; Found? JP NZ,SETUP LD C,STROUT ; Output: "CAN'T FIND DICTIONARY..." LD DE,DICERR CALL BDOS CALL 0 DICERR: DB 'Can''t find dictionary file DICT.DIC',CR,LF,'$' SETUP: LD DE,OFCB ; Copy input filename to output LD HL,IFCB LD BC,9 LDIR LD DE,P2FCB ; Copy input filename to pass 2 fcb LD HL,IFCB ; (this fcb is for input on pass 2) LD BC,12 LDIR LD DE,FILDIC ; Copy input filename to file.dic fcb LD HL,IFCB LD BC,9 LDIR LD DE,FILADD ; Copy input filename to file.add fcb LD HL,IFCB LD BC,9 LDIR LD DE,FILD$$ ; Copy input filename to file.d$$ fcb LD HL,IFCB LD BC,9 LDIR POP PSW ; Get output drive, if specified (from ; 6ch) CP 0 JR Z,NODRV LD HL,BOOT+81H ; Search for drive specification in ; Command line LD A,(BOOT+80H) ; Number of characters in command line LD B,0 LD C,A ; Counter ADD HL,BC ; Hl points to last character DEC BC ; Don't test first byte of input LD A,':' ; Searching for ":" CPDR JR NZ,NODRV ; If no drive specified, then use ; Default LD A,(HL) ; Get drive name AND 5FH ; Make upper case SUB 40H ; Make a=1 LD (OFCB),A ; Make output files on output drive LD (FILD$$),A NODRV: LD C,OPEN ; Open the input file LD DE,IFCB CALL BDOS LD C,OPEN ; With pass 1 and pass 2 fcb's LD DE,P2FCB CALL BDOS CP 0FFH JP NZ,SETUP0 ; Jump if found LD C,STROUT ; Output: "CAN'T FIND INPUT FILE" LD DE,NOINPT CALL BDOS CALL BOOT NOINPT: DB 'Can''t find input file',CR,LF,'$' SETUP0: LD C,DELETE ; Delete output file (file.$$$) LD DE,OFCB CALL BDOS LD C,MAKE ; Make a new output file LD DE,OFCB CALL BDOS CP 0FFH JP NZ,SETUP1 ; Jump if successful LD C,STROUT ; Output: "DIRECTORY FULL" LD DE,NODIR CALL BDOS CALL BOOT NODIR: DB 'Directory full',CR,LF,'$' SETUP1: CALL CTRLZ ; Fill output buffer with eof LD A,EOF ; Mark end of output buffer LD (OBUFF+512),A LD A,0 ; Mark end of dictionary buffer LD (DICBUF+256),A LD (DICBUF+257),A LD A,(PUTCHR) ; Get the normal first instruction ; At putchr LD (SAVPUT),A ; Store it for later LD A,0C9H ; Return instruction LD (PUTCHR),A ; Disable output CALL AUXDIC ; Load "SPELL.DIC", file.dic and ; File.add LD HL,IFCB ; Input file fcb LD (FILPAT),HL ; Patch getwrd: to read from it ; ; SRTFIL -- Sort the file in memory, alphabetically. Duplicate words are ; discarded. This will save a lot of time during dictionary lookups ; since the words will have to be located only once. SRTFIL: CALL GETWRD ; Get a word into srcwrd: JP Z,CHECK ; If eof then start checking LD HL,(TOTWRD) ; Keep track of total # of words INC HL LD (TOTWRD),HL CALL CREWRD ; Create word from srcwrd: LD A,0 ; Is it at least 2 chars long? CP C JR Z,SRTFIL ; Forget it if not LD A,41 ; If longer than 40, also forget it CP C JR Z,SRTFIL CALL MEMWRD ; Put word in memory AND A ; Full? JR Z,SRTFIL ; Get another word if not LD HL,(INPTR) ; Get old input buffer pointer LD (OLDPTR),HL ; Save it LD A,1 ; Mark pass 1 incomplete LD (STOPED),A LD (MLTPAS),A ; Record permanently that >1 pass LD C,36 ; Get record number of input file LD DE,IFCB CALL BDOS ; ; CHECK -- Compare the entries in the sorted table to the dictionary. ; Words that are found are marked. ; CHECK: LD A,(STOPED) ; Is read of source complete? CP 0 JR NZ,CHEC01 ; If not, no message LD DE,TOTMSG ; Output: "TOTAL # OF WORDS" LD C,STROUT CALL BDOS LD HL,(TOTWRD) ; Print number CALL DECOUT CHEC01: LD HL,(SRTTOP) ; Top entry in pointer table LD DE,(SRTBOT) ; Bottom XOR A ; Clear carry DEC HL ; Point to true end, not dummy record DEC HL SBC HL,DE ; Hl=number of words times 2 JP Z,MAIN ; If empty, write out file RRC L ; Divide hl by 2 LD A,L AND 07FH LD L,A LD A,0 RRC H ADC A,0 RRC A OR L LD L,A LD A,H AND 07FH LD H,A LD B,H ; Put counter in bc LD C,L INC B ; Make b word with dec b and jnz ; Combination LD A,0 CP C ; If c 0? JR NZ,CHEC02 DEC B ; If c=0 then readjust b because ; It would loop 256 too many times CHEC02: LD HL,(SRTBOT) ; Get address of first entry INC HL ; Bypass dummy entry at beginning INC HL CHECK0: LD E,(HL) ; Get address of word in memory INC HL LD D,(HL) INC HL PUSH BC PUSH HL LD HL,WORD LD C,0FEH ; Character counter ; At the end, c=chars-1. start of with ; -2 so that 0 and 1 character not ; Counted CHECK1: LD A,(DE) ; Get a character LD (HL),A ; Put it in word: INC C DEC DE INC HL CP 0 ; End of word? JR NZ,CHECK1 ; Loop until end LD A,C LD (LASTC),A ; Number of characters LD HL,(UNQWRD) ; Record # of unique words INC HL LD (UNQWRD),HL CALL WRDTST ; Search dictionary for word CP 1 ; Found? JR NZ,CHECK2 ; Leave unmarked if not found INC DE ; Point to end marker of word LD A,080H LD (DE),A ; Mark word as found JR CHECK3 CHECK2: LD HL,(MISWRD) ; Increment missed words counter INC HL LD (MISWRD),HL CHECK3: POP HL POP BC DEC C JP NZ,CHECK0 ; Loop DEC B JP NZ,CHECK0 ; 16 bit loop index LD HL,P2FCB ; Set to input from pass 2 fcb LD (FILPAT),HL LD HL,(P2OPTR) ; Set pass 2 input pointer LD (INPTR),HL LD A,(SAVPUT) ; Get the normal first instruction ; At putchr LD (PUTCHR),A ; Patch it into the write routine LD HL,P2BUF+512 ; Patch new buffer into getchr LD (BUFPAT),HL LD HL,P2BUF LD (BUFPA0),HL LD (BUFPA1),HL INC HL LD (BUFPA2),HL LD A,(LASTCH) ; Save last character read LD B,A LD A,(OLSTCH) ; Put old lastch back LD (LASTCH),A LD A,B LD (OLSTCH),A ; Save current lastch JR MAIN TOTMSG: DB CR,LF,LF,'Total number of words in document: $' ; ; MAIN -- Do a second pass through the input file. Compare each word to ; the memory buffer to determine whether the words were found. ; If a word was not found, mark it with the ERRCHR. MAIN: CALL GETWRD ; Get a word into srcwrd: JP Z,DONE ; If eof then stop CALL CREWRD ; Create word from srcwrd: LD A,0 ; Is word at least 2 chars long? CP C JR Z,MAIN0 ; Accept if not LD A,41 ; If longer than 40, also accept CP C JR Z,MAIN0 CALL MEMWRD ; Search for word in memory LD A,(DE) ; Get marker for word CP 080H ; Word spelled correctly? JR Z,MAIN0 LD A,(ERRCHR) ; If not, mark word CALL PUTCHR MAIN0: LD HL,SRCWRD ; Output the original word MAIN1: LD A,(HL) CP 0 ; End of word? JR Z,MAIN2 CALL PUTCHR ; Output character INC HL ; Point to next character JR MAIN1 ; Loop MAIN2: LD A,(STOPED) ; Was pass 1 incomplete AND A JR Z,MAIN ; Get next word if not LD DE,P2FCB ; Compute current record number LD C,36 CALL BDOS LD DE,(P2FCB+21H) LD HL,(IFCB+21H) ; Compare stopped record number to ; Current XOR A ; Clear carry SBC HL,DE JP NZ,MAIN ; Get next word if not the same LD HL,(OLDPTR) ; Get position in record LD DE,P2BUF-INBUF ; Offset it to compare with pass 2 buff ADD HL,DE LD DE,(INPTR) XOR A SBC HL,DE ; Compare stopped pos to current JP NZ,MAIN ; Get next word if not the same LD A,0 ; Unmark pass 1 incomplete LD (STOPED),A LD HL,(INPTR) ; Save pass 2 input pointer LD (P2OPTR),HL LD HL,(OLDPTR) ; Get old pointer to buffer LD (INPTR),HL ; Reset buffer pointer LD HL,IFCB ; Patch getchr: routine to read from ; Pass 1 fcb LD (FILPAT),HL LD HL,INBUF+512 ; Patch the correct buffer into getchr LD (BUFPAT),HL LD HL,INBUF LD (BUFPA0),HL LD (BUFPA1),HL INC HL LD (BUFPA2),HL LD A,0C9H ; Make putchr not work LD (PUTCHR),A LD HL,(SRTBOT) ; Reset memory buffer pointers INC HL INC HL LD (SRTTOP),HL LD HL,(BDOS+1) ; Get bdos vector DEC HL ; Point to free memory LD (FREE),HL ; Pointer to free memory LD A,(LASTCH) ; Save last character read LD B,A LD A,(OLSTCH) ; Put old lastch back LD (LASTCH),A LD A,B LD (OLSTCH),A ; Save current lastch JP SRTFIL ; Fill buffer again ; ; DONE -- Write out the rest of the output buffer and then close and rename ; output files. DONE: LD HL,OBUFF ; Write out remaining data in buffer LD DE,128 DONE1: LD A,EOF ; Done? CP (HL) JR Z,DONE3 PUSH DE PUSH HL LD D,H ; Set up dma address LD E,L LD C,SETDMA CALL BDOS LD DE,OFCB ; Write 128 bytes to file LD C,WRITE CALL BDOS POP HL POP DE CP 0 ; Error? JR NZ,DONE2 ; Disk full --> branch ADD HL,DE ; Point to next record JR DONE1 DONE2: LD C,STROUT ; Disk full LD DE,DSKFUL ; Disk full message (see putchr) CALL BDOS CALL BOOT DONE3: LD DE,OFCB ; Close output file LD C,CLOSE CALL BDOS LD A,'B' LD (OFCB+9),A LD A,'A' LD (OFCB+10),A LD A,'K' LD (OFCB+11),A LD A,(OFCB) ; Remember output drive name PUSH PSW LD A,(IFCB) ; Get the drive on which input was done LD (OFCB),A ; Try to delete .bak on it only LD DE,OFCB LD C,DELETE CALL BDOS LD DE,IFCB+16 ; Rename source to source.bak LD HL,OFCB LD BC,12 ; Copy filename for rename LDIR LD DE,IFCB LD C,RENAME CALL BDOS LD HL,IFCB+9 ; Rename .$$$ to source LD DE,IFCB+25 LD BC,3 LDIR LD A,'$' LD (IFCB+9),A LD (IFCB+10),A LD (IFCB+11),A POP PSW ; Restore output drive name LD (IFCB),A ; And put it in fcb LD DE,IFCB LD C,RENAME CALL BDOS ; Now take care of user dictionaries LD DE,FILADD ; Delete file.add LD C,DELETE CALL BDOS LD DE,FILDIC ; Delete file.udc LD C,DELETE CALL BDOS LD A,(MLTPAS) ; Was more than 1 pass required? CP 0 JR Z,DONE30 ; No message if not LD DE,NOTOUT ; Output: no totals printed LD C,STROUT CALL BDOS JR DONE31 DONE30: LD DE,UNQMSG ; Output: # of unique words LD C,STROUT CALL BDOS LD HL,(UNQWRD) ; Print # of words CALL DECOUT LD DE,MISMSG ; Output: # of "MISSPELLED" words LD C,STROUT CALL BDOS LD HL,(MISWRD) ; Print # CALL DECOUT DONE31: LD HL,(FILUDC) ; Delete file.d$$ if it has no words LD A,0 CP H JR NZ,DONE4 ; Rename it to file.udc if >0 words CP L JR NZ,DONE4 LD DE,FILD$$ ; Delete it LD C,DELETE CALL BDOS CALL BOOT DONE4: LD HL,FILDIC ; Rename file.d$$ to file.udc LD DE,FILD$$+16 LD BC,12 LDIR LD DE,FILD$$ LD C,RENAME CALL BDOS CALL BOOT NOTOUT: DB CR,LF,'No subtotals available due to size of document.$' UNQMSG: DB CR,LF,' Number of unique words: $' MISMSG: DB CR,LF,' Unique "misspelled" words: $' ; ; GETWRD -- Read a word from an input file. Words are any series of ; alphabetic characters (with or without parity set) and ; apostrophes. ; ; Returns: C <-- number of characters in word ; Z flag set if EOF GETWRD: CALL GETCHR ; Get a character CP EOF ; End of file? RET Z CALL LEGAL ; Test if legal LD (LASTCH),A ; Save last character JR Z,KILPER ; Exit loop if legal CALL PUTCHR ; Send character directly out JR GETWRD ; Loop until legal KILPER: LD C,A AND 07FH ; Mask parity CP '.' ; Is it a dot command? LD A,C JR NZ,GETWR0 ; Get word if not CALL PUTCHR KILPE0: CALL GETCHR ; Eradicate this line CP EOF ; End of file? RET Z CALL PUTCHR ; Output it LD (LASTCH),A AND 07FH ; Mask parity CP LF ; Is it a line terminator? JR NZ,KILPE0 ; Loop through whole line JR GETWRD ; Get a text word now GETWR0: LD C,1 ; Zero character counter LD HL,SRCWRD+1 ; Initialize pointer to srcwrd: LD (SRCWRD),A ; Store first character GETWR1: CALL GETCHR HYPTST: CP 1FH ; Soft hyphen? JP Z,ISHYP CP 1EH ; Unused soft hyphen? JP NZ,NOTHYP ISHYP: LD (LASTCH),A ; Update last character pointer LD (HL),A ; Store hyphen INC HL INC C CALL GETCHR ISHYP0: CP CR OR 80H ; Soft return after hyphen? JR NZ,HYPTST ; Test for another hyphen LD (LASTCH),A ; Update last character pointer LD (HL),A ; Store return INC HL INC C CALL GETCHR LD B,A ; Save the char AND 07FH ; Kill parity bit CP LF ; Soft line feed? LD A,B ; Restore char JR NZ,HYPTST ; Test for another hyphen LD (LASTCH),A ; Update last character pointer LD (HL),A ; Store lf INC HL INC C CALL GETCHR ISHYP1: CP ' ' OR 80H ; Eliminate soft spaces at start of line JR NZ,ISHYP0 ; Test for rest of word LD (LASTCH),A ; Update last character pointer LD (HL),A ; Store space INC HL INC C CALL GETCHR JR ISHYP1 ; Test for more spaces NOTHYP: CALL LEGAL JR NZ,GETWR2 ; Exit loop when not word character LD (LASTCH),A LD (HL),A INC HL INC C JR GETWR1 GETWR2: LD (HL),0 ; Mark end of word LD HL,(INPTR) ; Decrement point for input buffer ; So first char after word is kept DEC HL LD (INPTR),HL RET ; ; LEGAL -- Determines whether character is alphabetic, an apostrophe, ; or period for a dot command. ; ; Returns: Z flag set <-- characters was one of the above ; Z flag clear <-- was not one of the above LEGAL: LD B,A AND 05FH ; Kill parity and lower case CP 'A' ; Must be greater than "A" JP C,LEGAL0 CP 'Z'+1 ; Greater than "Z" JP NC,LEGAL0 LD A,B CP A ; Set zero flag RET LEGAL0: LD A,B AND 07FH ; Kill only parity CP 27H ; "'" JR Z,LEGAL1 LD A,(LASTCH) ; Was last character a lf? AND 7FH ; Mask parity CP LF JR NZ,LEGAL1 LD A,B CP '.' ; Accept periods so dot command accepted LEGAL1: LD A,B RET ; ; GETCHR -- Read a character from an input file into a buffer. This routine ; is used for a number of different purposes. The file from which ; to read is patched into FILPAT. The buffer to which writes should ; occur is patched into BUFPAT-BUFPA2. ; ; Returns: A <-- next character from input file GETCHR: PUSH BC PUSH DE PUSH HL LD HL,(INPTR) ; Pointer for input LD DE,INBUF+512 ; End of input buffer BUFPAT EQU $-2 ; Patch for input buffer XOR A ; Clear carry PUSH HL SBC HL,DE ; At end of buffer? POP HL JP Z,GETCH0 ; Refill buffer LD A,(HL) ; Get the character INC HL ; Incremented pointer LD (INPTR),HL GETRET: POP HL POP DE POP BC RET GETCH0: LD HL,INBUF BUFPA0 EQU $-2 ; Patch for input buffer LD DE,128 LD C,4 GETCH2: PUSH BC PUSH DE PUSH HL LD A,EOF ; Mark with eof in case no record LD (HL),A LD D,H ; Set up dma address for read LD E,L LD C,SETDMA CALL BDOS ; Set dma address LD DE,IFCB FILPAT EQU $-2 ; Fcb patch address LD C,READ ; Read 128 bytes of input file CALL BDOS POP HL POP DE POP BC CP 0 ; Success? JR NZ,GETCH3 ; Jump if eof ADD HL,DE ; Point to next record address DEC C JP NZ,GETCH2 ; Loop for 4 records GETCH3: LD A,(INBUF) ; Get first character BUFPA1 EQU $-2 ; Another buffer patch LD (HL),EOF ; Put eof at beginning of first unused ; Record in memory LD HL,INBUF+1 BUFPA2 EQU $-2 ; And yet another buffer patch LD (INPTR),HL ; Set up pointer to records JP GETRET ; ; CREWRD -- Converts the word in SRCWRD to a word in WORD. Parity bits ; are cleared, lower case is converted to upper case, and apostrophes ; that are not imbedded in words are discarded. CREWRD: LD HL,WORD ; Pointer to desination buffer LD DE,SRCWRD ; Source buffer LD C,0 CREWR0: LD A,(DE) ; Get a character CP 0 ; End of word? JP Z,CREWR2 AND 07FH ; Mask parity CP 027H ; "'" character? JR Z,CREWR3 AND 05FH ; Mask parity and convert to upper case CP 'A' ; Is it only a hyphen? JR C,CREWR1 ; If so, skip it CREADD: INC C LD (HL),A ; Put character in word buffer LD A,41 ; Maximum of 40 characters in word CP C RET Z ; Word too long. accept it INC HL CREWR1: INC DE JP CREWR0 CREWR2: LD (HL),0 ; Mark end of word LD HL,LASTC ; Put number of characters in lastc DEC C ; C=number of characters - 1 JP P,CREWS2 ; Jump if c wasn't already 0 INC C CREWS2: LD (HL),C RET CREWR3: LD A,0 ; If first character in word, ignore ; "'" CP C JR Z,CREWR1 INC DE LD A,(DE) ; If last char in word, ignore CP 0 DEC DE JR Z,CREWR1 LD A,27H ; Otherwise, keep "'" JR CREADD ; ; PUTCHR -- write a character to output file ; ; Input: A --> character to output PUTCHR: PUSH PSW PUSH BC PUSH DE PUSH HL LD HL,(OPOSS) ; Get current position in obuff LD (HL),A ; Put character in buffer INC HL LD (OPOSS),HL ; Update pointer LD DE,OBUFF+512 ; At end of buffer? XOR A ; Clear carry SBC HL,DE JR Z,PUTCH0 ; Write out data if end of buffer PUTRET: POP HL POP DE POP BC POP PSW RET PUTCH0: LD C,4 ; Loop counter LD HL,OBUFF ; Address of data LD DE,128 ; Length of each record PUTCH1: PUSH BC PUSH DE PUSH HL LD D,H ; Set up dma address LD E,L LD C,SETDMA CALL BDOS LD DE,OFCB ; Write record to output file OUTPAT EQU $-2 ; Patch address for output file fcb LD C,WRITE CALL BDOS CP 0 ; Success? JR NZ,PUTCH2 ; Jump if disk full POP HL POP DE POP BC ADD HL,DE ; Point to next record DEC C JP NZ,PUTCH1 ; Loop for 512 byte buffer LD HL,OBUFF ; Reset pointer LD (OPOSS),HL CALL CTRLZ ; Fill buffer with eof character JP PUTRET ; Return PUTCH2: LD C,STROUT ; Disk full error LD DE,DSKFUL CALL BDOS CALL BOOT ; Give up DSKFUL: DB CR,LF,'Disk full -- aborting',CR,LF,'$' ; ; CTRLZ -- Fill the output buffer with EOF characters to prepare it for ; writing CTRLZ: LD HL,OBUFF ; Buffer address LD B,2 ; Loop 256 bytes 2 times LD C,0 CTRLZ0: LD (HL),EOF ; Put eof in buffer INC HL DEC C ; Fast counter JR NZ,CTRLZ0 DEC B ; Slow counter JR NZ,CTRLZ0 RET ; ; MEMWRD -- put word in WORD into memory. If word already exists in memory ; then its the address of its status byte is returned in DE. If the ; word is not found, the word is placed in memory and the pointers ; that alphabetize the words are updated. If memory is full, a ; 1 is returned in A. Otherwise 0 is returned in A. MEMWRD: LD BC,(SRTBOT) ; Get address of bottom of word pointer LD DE,(SRTTOP) ; Top of word pointer JR MEMSKP MEMWR0: POP HL POP DE POP BC JP M,MEMW00 LD D,H ; Move high pointer down LD E,L JR MEMSKP MEMW00: LD B,H ; Move low pointer up LD C,L MEMSKP: LD H,D ; Hl is pointer to record between de and LD L,E ; Bc XOR A ; Clear carry SBC HL,BC LD A,0 ; Is bc+1=hl? CP H JP NZ,MEMWR1 LD A,2 CP L JP NZ,MEMWR1 LD HL,(SRTTOP) ; Update srttop=srttop+2 INC HL INC HL LD (SRTTOP),HL XOR A ; Clear carry PUSH HL SBC HL,DE ; Number of bytes in table to move LD B,H ; Put number of counter for lddr LD C,L POP HL PUSH DE ; Save the address for new word LD D,H ; Put destination address in de LD E,L DEC HL ; Source in hl DEC HL LDDR ; Put a space for new pointer in table POP DE LD HL,(FREE) ; Address to store new word EX DE,HL LD (HL),E ; Store address of word in table INC HL LD (HL),D LD HL,WORD LD A,(LASTC) ; Get number of characters LD B,A INC B ; B = number of characters in word + 1 INC B MEMW01: LD A,(HL) ; Get a character LD (DE),A ; Put it in memory DEC DE ; Store word backwards INC HL ; Next char in word DJNZ MEMW01 LD (FREE),DE ; Update free memory pointer EX DE,HL LD DE,45 ; Allow room for another word XOR A ; Clear carry SBC HL,DE LD DE,(SRTTOP) ; Pointer to top of pointer table XOR A SBC HL,DE ; Is any memory left? JR C,MEMFUL ; If not, no more memory LD A,0 ; Indicate memory left RET MEMFUL: LD A,1 ; No memory left RET MEMWR1: RRC L ; Divide hl by 2 LD A,L AND 07EH ; Make it even LD L,A LD A,0 RRC H ADC A,0 ; If bit 0 of h set, then c set RRC A OR L LD L,A LD A,H AND 07FH LD H,A ADD HL,BC ; Hl points to record between bc and ; De PUSH BC PUSH DE PUSH HL LD E,(HL) ; De= address of comparison word in buff INC HL LD D,(HL) LD HL,WORD ; Hl= address of new word buffer MEMWR2: LD A,(DE) ; Get a character AND 07FH ; Kill carry (for 0 byte of corrected ; Words) CP (HL) ; Compare them JP NZ,MEMWR0 ; If .ne. then try another word LD A,0 CP (HL) ; End of word? DEC DE ; Decrement word table pointer (words ; Are stored backwards INC HL ; Increment pointer (don't affect ; Flags) JR NZ,MEMWR2 POP HL POP BC ; Trash old de POP BC INC DE ; Point to 0 or 080h at end of word ; (80h is corrected and word found) RET ; Don't bother to buffer the same word ; ; AUXDIC -- Open SPELL.DIC and load it into memory. Open FILE.UDC and load ; it as well. If FILE.ADD exists (wordstar dictionary addition file), ; load it and put its contents in FILE.UDC. AUXDIC: LD HL,NEXT ; Zero the memory dictionary LD A,0 LD (HL),A AUXDI2: LD DE,FILD$$ ; Make temporary .dic output file LD C,DELETE CALL BDOS LD DE,FILD$$ LD C,MAKE CALL BDOS LD HL,FILD$$ ; Patch this fcb into output routine LD (OUTPAT),HL LD A,(SAVPUT) ; Make putchr: write to a file LD (PUTCHR),A LD DE,FILDIC ; Try to open file.udc LD C,OPEN CALL BDOS CP 0FFH ; Found? JP Z,AUXDI4 ; Jump if not LD HL,FILDIC ; Patch getchr: to read from this file LD (FILPAT),HL LD HL,INBUF+512 ; Patch inptr to read on first call LD (INPTR),HL AUXDI3: CALL GETWRD ; Get a word into srcwrd: JP Z,AUXDI4 ; If eof then start checking CALL CREWRD ; Create word from srcwrd: LD A,0 ; Is it at least 2 chars long? CP C JR Z,AUXDI3 ; Forget it if not LD A,41 ; If longer than 40, also forget it CP C JR Z,AUXDI3 PUSH HL LD HL,(FILUDC) ; Increment counter for words output INC HL ; To file.udc LD (FILUDC),HL POP HL CALL SAVWRD ; Put word in memory LD HL,WORD ; Put word in output file AUXDH3: LD A,(HL) ; Get a character CP 0 ; End of word? JR Z,AUXDI3 ; Quit output if end CALL PUTCHR ; Output character INC HL JR AUXDH3 AUXDI4: LD DE,FILADD ; Try to open file.add LD C,OPEN CALL BDOS CP 0FFH ; Found? JP Z,AUXDI7 ; Return if not LD HL,FILADD ; Patch getchr: to read from file.add LD (FILPAT),HL LD HL,INBUF+512 ; Set inptr to read on first call LD (INPTR),HL LD A,CR ; Put cr lf in output file CALL PUTCHR LD A,LF CALL PUTCHR AUXDI5: CALL GETCHR ; Get a character from file.add ; Ignore all word types except 0ffh ; (eof) CP 0FFH ; End of words in current record? JR Z,AUXDI5 ; If yes, loop through record CP 0 ; Zero used as filler character? JP Z,AUXDI5 CP EOF ; Eof? JP Z,AUXDI7 CALL GETCHR ; This character is length of word CP 0 ; No characters? JR Z,AUXDI5 LD B,A LD HL,WORD ; Buffer it in word AUXDI6: CALL GETCHR ; Get a character LD (HL),A ; Save it in word: INC HL DJNZ AUXDI6 ; Get whole word LD A,0 ; Mark end of word LD (HL),A CALL SAVWRD ; Put word in memory JP Z,AUXDI5 ; If word already in memory then don't ; Output to file.udc PUSH HL LD HL,(FILUDC) ; Increment counter for words output INC HL ; To file.udc LD (FILUDC),HL POP HL LD HL,WORD ; Output word AUXDH6: LD A,(HL) ; Get a character INC HL CP 0 ; End? JR Z,AUXDK6 CALL PUTCHR JR AUXDH6 AUXDK6: LD A,CR ; Put cr lf in output file CALL PUTCHR LD A,LF CALL PUTCHR JP AUXDI5 ; Get another character AUXDI7: LD HL,OBUFF ; Write out remaining data in buffer LD DE,128 AUXDI8: LD A,EOF ; Done? CP (HL) JR Z,AUXDJ0 PUSH DE PUSH HL LD D,H ; Set up dma address LD E,L LD C,SETDMA CALL BDOS LD DE,FILD$$ ; Write 128 bytes to file LD C,WRITE CALL BDOS POP HL POP DE CP 0 ; Error? JR NZ,AUXDI9 ; Disk full --> branch ADD HL,DE ; Point to next record JR AUXDI8 AUXDI9: LD C,STROUT ; Disk full LD DE,DSKFUL ; Disk full message (see putchr) CALL BDOS CALL BOOT AUXDJ0: CALL RDICT ; Read spell.dic LD HL,BOOT+81H ; Point to input line buffer LD A,(BOOT+80H) ; Number of characters LD B,A LD A,' ' ; Look for a space to indicate end of ; Input file name AUXDJ1: CP (HL) JR Z,AUXDJ2 ; Exit loop if space INC HL ; Next character DJNZ AUXDJ1 ; Loop while characters left JR AUXRET ; Nothing after file. just return. AUXDJ2: LD A,'$' ; Now look for $ to indicate more dicts. AUXDJ3: CP (HL) JR Z,AUXDJ4 ; Exit loop if found INC HL DJNZ AUXDJ3 ; Continue while characters left JR AUXRET ; Not found AUXDJ4: LD A,' ' ; Elminate spaces INC HL ; Skip '$' DJNZ AUXDJ5 ; Continue if char left JR AUXRET AUXDJ5: CP (HL) JR NZ,AUXDJ6 ; Stop if not space INC HL DJNZ AUXDJ5 JR AUXRET ; Done if just spaces AUXDJ6: LD A,0 LD (SPLDIC),A ; Use default drive LD DE,SPLDIC+1 ; Fcb buffer to use LD A,' ' ; Null file name (spaces) PUSH BC LD B,8 ; First do filename, not extension AUXDJ7: LD (DE),A INC DE ; Clear entire filename DJNZ AUXDJ7 LD DE,SPLDIC+12 ; Get rest of fcb LD B,24 LD A,0 ; Zero rest of fcb AUXDJ8: LD (DE),A INC DE DJNZ AUXDJ8 POP BC LD DE,SPLDIC+1 ; Point to fcb LD C,0 ; No characters written to fcb yet LD A,2 ; Are at least 3 char left? CP B JP NC,AUXDJ9 ; If not, can't be a drive specified INC HL LD A,(HL) ; See if next char is a ':' DEC HL CP ':' JR NZ,AUXDJ9 ; Jump if no drive specified LD A,(HL) ; Get the drive INC HL ; Point to next char after : INC HL DEC B DEC B AND 11011111B ; Make sure it's upper case SUB 'A'-1 ; Make drive number based at 0 LD (SPLDIC),A ; Store it in fcb AUXDJ9: LD A,(HL) ; Get a character CP ' ' ; End of filename? JR Z,AUXDK2 ; Read the file CP '.' ; Period? discard extension if yes. JR Z,AUXDK0 LD (DE),A ; Fcb it INC DE INC C LD A,8 ; 8 characters written yet? CP C JR Z,AUXDK0 INC HL DJNZ AUXDJ9 JR AUXDK2 ; Read the file AUXDK0: LD A,' ' ; Search for space to end filename ; Discard extra characters AUXDK1: CP (HL) JR Z,AUXDK2 INC HL ; Try next char DJNZ AUXDK1 AUXDK2: DEC HL ; Point to char before end or space INC B ; 1 more left now CALL RDICT ; Read from the dictionary JP AUXDJ4 ; Try for another dictionary AUXRET: LD DE,FILD$$ ; Close temporary file LD C,CLOSE CALL BDOS LD HL,OFCB ; Patch putchr: to output to file.$$$ LD (OUTPAT),HL LD A,0C9H ; Return opcode LD (PUTCHR),A ; Make putchr: do not output CALL CTRLZ ; Clear output buffer LD HL,OBUFF ; Clear output buffer position LD (OPOSS),HL LD HL,(FREE) ; Get address of next free byte INC HL LD (SRTBOT),HL ; Point to table for input file index INC HL INC HL LD (SRTTOP),HL ; Top of table LD HL,(BDOS+1) ; Get address of bdos DEC HL ; Point to free memory LD (FREE),HL LD HL,INBUF+512 LD (INPTR),HL ; Set input file pointer to read record ; On next getchr: call CALL CTRLZ ; Clean output file buffer LD A,LF ; Reset lastch for input LD (LASTCH),A LD DE,UDCMSG ; Output: "Words read from...FILE.UDC" LD C,STROUT CALL BDOS LD HL,(FILUDC) ; Number of words written LD B,H ; Goes in bc LD C,L LD HL,FILD$$ ; Fcb address in hl LD A,'U' ; Change 'filename.d$$' to '.udc' LD (FILD$$+9),A LD A,'D' LD (FILD$$+10),A LD A,'C' LD (FILD$$+11),A CALL TYPFIL ; Write filename and # to console LD A,'D' ; Change it back to '.d$$' LD (FILD$$+9),A LD A,'$' LD (FILD$$+10),A LD (FILD$$+11),A RET UDCMSG: DB CR,LF,'Words written to dictionary $' ; ; RDICT - Read dictionary in SPLDIC FCB ; RDICT: PUSH PSW PUSH BC PUSH DE PUSH HL LD HL,INBUF+512 LD (INPTR),HL ; Set input file pointer to read record ; On next getchr call LD HL,0 LD (SPLDC),HL ; Reset # words read LD DE,SPLDIC ; Fcb for spell.dic LD C,OPEN CALL BDOS PUSH PSW LD C,CURDSK ; Get the default drive before its CALL BDOS ; Too late INC A LD (DEFDRV),A POP PSW CP 0FFH ; Found? JR NZ,RDICT0 ; Yes, read from it LD A,(SPLDIC) ; Was default drive tested? CP 0 JR NZ,RDICT2 ; If specific drive tested and not ; Found then give up LD A,(DEFDSK) ; Try drive "A" LD (SPLDIC),A LD DE,SPLDIC LD C,OPEN CALL BDOS CP 0FFH ; Found? JP Z,RDICT2 ; If not, give up RDICT0: LD HL,SPLDIC ; Patch fcb address into getwrd LD (FILPAT),HL RDICT1: CALL GETWRD ; Get a word into srcwrd: JP Z,RDICT3 ; If eof then start checking CALL CREWRD ; Create word from srcwrd: LD A,0 ; Is it at least 2 chars long? CP C JR Z,RDICT1 ; Forget it if not LD A,41 ; If longer than 40, also forget it CP C JR Z,RDICT1 PUSH HL LD HL,(SPLDC) ; Increment counter for words in INC HL ; Spell.dic LD (SPLDC),HL POP HL CALL SAVWRD ; Put word in memory JR RDICT1 RDICT2: LD DE,RNT ; Print cr,lf LD C,STROUT CALL BDOS LD A,(SPLDIC) ; Default drive used? CP 0 JR NZ,RDICU0 ; Jump if not LD A,(DEFDRV) ; Get default drive LD (SPLDIC),A ; And put it in fcb RDICU0: LD A,(SPLDIC) ; Get drive ADD A,'A'-1 ; Make it a letter LD C,CONOUT LD E,A CALL BDOS ; Print drive name LD E,':' LD C,CONOUT CALL BDOS ; And a colon LD DE,SPLDIC+1 ; Point to filename LD HL,SPLDIC+12 ; Point to first byte after name LD A,'$' LD (SPLDIC+12),A ; Mark end for ouptut LD C,STROUT CALL BDOS ; Print the file name LD DE,RNT0 ; Print not found LD C,STROUT CALL BDOS JR RDICTR RNT: DB CR,LF,'$' RNT0: DB ' not found$' RDICT3: LD DE,RDIWRD ; Found message LD C,STROUT CALL BDOS LD HL,(SPLDC) ; Store # words read in bc LD B,H LD C,L LD HL,SPLDIC ; Fcb address CALL TYPFIL ; Type file name and # words in it JR RDICTR RDIWRD: DB CR,LF,'Words read from dictionary $' RDICTR: POP HL POP DE POP BC POP PSW RET ; ; TYPFIL -- print name of dictionary file being read and words found in it ; ; Input: BC --> Number of words found in file ; HL --> Address of file's FCB ; TYPFIL: PUSH PSW PUSH BC PUSH DE PUSH HL LD A,(HL) ; Default drive used? CP 0 JR NZ,TYPFI0 ; Jump if not LD A,(DEFDRV) ; Get default drive LD (HL),A ; And put it in fcb TYPFI0: LD A,(HL) ; Get drive ADD A,'A'-1 ; Make it a letter PUSH BC PUSH HL LD C,CONOUT LD E,A CALL BDOS ; Print drive name LD E,':' LD C,CONOUT CALL BDOS ; And a colon POP HL LD D,H LD E,L INC DE ; Point to filename LD BC,12 ADD HL,BC ; Hl points to end of filename LD A,'$' LD (HL),A ; Mark end for ouptut LD C,STROUT CALL BDOS ; Print the file name LD DE,TYPSPA ; Print spaces after name LD C,STROUT CALL BDOS POP BC LD H,B ; Number of words found LD L,C CALL DECOUT ; Print number POP HL POP DE POP BC POP PSW RET TYPSPA: DB ': $' ; ; SAVWRD -- put WORD in memory dictionary ; SAVWRD: CALL USRTST ; Was word already marked? CP 1 RET Z ; Return with z set if already marked LD HL,(FREE) ; Get next available byte LD DE,WORD ; Point to word SAVWR0: LD A,(DE) ; Get a character LD (HL),A ; Store it in buffer INC DE ; Increment pointers INC HL CP 0 ; End of word? JR NZ,SAVWR0 LD (HL),A ; Mark end of table with 0 LD (FREE),HL ; Update free memory pointer LD A,1 AND A ; Make for z not set RET ; ; WRDTST -- Search for WORD in dictionary. If it is not found, try ; stripping of suffixes and looking for new word with a flag set. ; ; Returns in A: 0 <-- WORD not found ; 1 <-- WORD found ; 2 <-- root word found but necessary ; suffix flag not set. Returned ; only if suffixes were stripped. WRDTST: PUSH BC PUSH DE PUSH HL LD HL,0 LD (FLAG),HL ; No flags for first lookup CALL FINDIT ; Look for word in dictionary PUSH PSW LD A,1 ; Assume that word was found and ; Indicate working in alphabetical order ; Still (decoding of current record ; By lookup routine can continue from ; Current position) LD (ALPHA),A POP PSW CP 0 ; Not found? JP Z,WRDTS0 ; Keep trying if not found WRDRET: POP HL POP DE POP BC RET WRDTS0: CALL USRTST ; Test user dictionary CP 1 ; Found? JP Z,WRDRET LD A,0 ; Not working in alphabetical order ; Any more LD (ALPHA),A LD HL,LASTC ; Put number of characters -1 in c LD C,(HL) LD B,0 ; Make bc an offset to last char LD HL,WORD ; Point to word ADD HL,BC ; Point to last character in word LD A,(HL) QISIT 'E',FLGV ; Word ends in "E" QISIT 'H',FLGH ; "H" QISIT 'Y',FLGY ; "LY" QISIT 'G',FLGG ; "ING" QISIT 'N',FLGN ; "TION", "en" QISIT 'D',FLGD ; "ed", "ied" QISIT 'T',FLGT ; "est", "iest" QISIT 'R',FLGR ; "er", "ier" QISIT 'S',FLGS ; Lots of words ending in "s" LD A,0 JP WRDRET ; No flags fit FLGV: LD A,2 ; Word must be 4 chars long CP C JP P,WRDNOT ; Not found if too short LD DE,VFLAG ; Looking for v flag LD (FLAG),DE DEC HL ; Character before ISIT 'V' DEC HL ISIT 'I' LD (HL),'E' ; Get "creative" INC HL LD (HL),0 CALL FINDIT CP 0 ; Found? JP NZ,WRDRET ; Branch if found DEC HL ; Point to char before new "e" DEC HL JISIT 'E',WRDNOT ; Kill "createive" INC HL LD (HL),0 CALL FINDIT JP WRDRET FLGH: LD A,2 ; Must be 4 chars long CP C JP P,WRDNOT LD DE,HFLAG ; Seeking word with h flag set LD (FLAG),DE DEC HL ISIT 'T' DEC HL JISIT 'Y',WRDNOT ; Kill "twentyth" INC HL LD (HL),0 ; New end of word CALL FINDIT ; Get "hundredth" CP 0 ; Found? JP NZ,WRDRET ; Return is found LD A,4 ; Words with "ieth" must be 6 chars long CP C JP P,WRDNOT DEC HL ISIT 'E' DEC HL ISIT 'I' LD (HL),'Y' ; Modify word to end in "y" INC HL LD (HL),0 CALL FINDIT ; Get "twentieth" JP WRDRET FLGY: LD A,2 ; Must be 4 characters long (at least) CP C JP P,WRDNOT LD DE,YFLAG ; Words must have y flag set LD (FLAG),DE DEC HL ISIT 'L' LD (HL),0 ; Mark new end of word CALL FINDIT ; Get "quickly" JP WRDRET FLGG: LD A,2 ; Must be at least 4 chars long CP C JP P,WRDNOT LD DE,GFLAG ; Set g flag LD (FLAG),DE FLGGE: DEC HL ISIT 'N' DEC HL ISIT 'I' LD (HL),'E' INC HL LD (HL),0 CALL FINDIT ; Get "filing" CP 0 JP NZ,WRDRET ; Return if found DEC HL DEC HL JISIT 'E',WRDNOT ; Kill "fileing" INC HL LD (HL),0 CALL FINDIT ; Get "crossing" JP WRDRET FLGN: LD A,2 ; Must be 4 chars long CP C JP P,WRDNOT LD DE,NFLAG ; Set n flag LD (FLAG),DE FLGNEE: DEC HL JISIT 'O',FLGNO ; Word with "tion" ISIT 'E' ; If .eq. "tion" then .eq. "en" DEC HL JISIT 'E',WRDNOT ; Kill "createen" JISIT 'Y',WRDNOT ; Kill "multiplyen" INC HL LD (HL),0 CALL FINDIT ; Get "fallen" JP WRDRET FLGNO: LD A,3 ; Must be 4 chars long CP C JP P,WRDNOT DEC HL ISIT 'I' LD (HL),'E' INC HL LD (HL),0 CALL FINDIT ; Get "creation" CP 0 JP NZ,WRDRET ; Return if found LD A,7 ; Must be at least 9 chars long CP C JP P,WRDNOT DEC HL DEC HL ISIT 'T' DEC HL ISIT 'A' DEC HL ISIT 'C' DEC HL ISIT 'I' LD (HL),'Y' INC HL LD (HL),0 CALL FINDIT JP WRDRET FLGD: LD A,2 ; Must be 4 characters long CP C JP P,WRDRET LD DE,DFLAG ; Set d flag LD (FLAG),DE FLGDE: DEC HL ISIT 'E' INC HL LD (HL),0 CALL FINDIT ; Get "created" CP 0 JP NZ,WRDRET DEC HL DEC HL JISIT 'E',WRDNOT ; Kill "createed" LD A,(HL) CP 'Y' ; If .ne. "y" try other suffixes JP NZ,FLGD5 DEC HL CALL VOWEL ; Vowel must be before "y" JP NZ,WRDNOT INC HL INC HL LD (HL),0 CALL FINDIT ; Get "conveyed" JP WRDRET FLGD5: INC HL LD (HL),0 CALL FINDIT ; Get "crossed" CP 0 JP NZ,WRDRET ; Return if found DEC HL ISIT 'I' DEC HL CALL VOWEL ; Can't be a vowel JP Z,WRDNOT INC HL LD (HL),'Y' INC HL LD (HL),0 CALL FINDIT ; Get "implied" JP WRDRET FLGT: LD A,2 ; Must be at least 4 chars long CP C JP P,WRDNOT LD DE,TFLAG ; T flag must be set LD (FLAG),DE DEC HL JISIT 'S',FLGDE ; Same rules as 'd' flag if ends ; In "st" JP WRDNOT ; Not found if not "st" FLGR: LD A,2 ; Must be at least 4 chars long CP C JP P,WRDNOT LD DE,RFLAG ; Set r flag LD (FLAG),DE FLGRE: JP FLGDE ; Same rules as d flag FLGS: LD A,2 ; Must be 4 chars long CP C JP P,WRDNOT LD DE,SFLAG ; Try pure "s" flag first LD (FLAG),DE DEC HL JISIT 'S',FLGP ; "ness", "iness" JISIT 27H,FLGM ; "'s" CALL SXZH ; Is it s, x, z or h? JP Z,WRDNOT ; If yes, then illegal word LD A,(HL) ; Pure "s" legal if .ne. "y" CP 'Y' JR NZ,FLGS2 DEC HL CALL VOWEL JP NZ,WRDNOT ; Illegal word if not a vowel INC HL FLGS2: INC HL LD (HL),0 CALL FINDIT ; Get "conveys", "bats" CP 0 JP NZ,WRDRET ; Return if found DEC HL LD A,(HL) QISIT 'R',FLGZ ; "ers", "iers" QISIT 'N',FLGX ; "ions", "ications", "ens" QISIT 'G',FLGJ ; "ings" ISIT 'E' DEC HL CALL SXZH JP NZ,FLGS5 ; If letter not s,x,z or h try "ies" INC HL LD (HL),0 CALL FINDIT ; Get "fixes" JP WRDRET FLGS5: ISIT 'I' DEC HL CALL VOWEL JP Z,WRDNOT ; Can't be a vowel INC HL LD (HL),'Y' INC HL LD (HL),0 CALL FINDIT ; Get "implies" JP WRDRET FLGX: LD DE,XFLAG ; Set x flag LD (FLAG),DE JP FLGNEE ; Save as "n" flag now FLGJ: LD DE,JFLAG ; Set j flag LD (FLAG),DE JP FLGGE ; Save as "g" flag now FLGZ: LD DE,ZFLAG ; Set z flag LD (FLAG),DE JP FLGRE ; Save as "r" flag now FLGP: LD A,3 ; Must be 5 chars long CP C JP P,WRDNOT LD DE,PFLAG ; Set p flag LD (FLAG),DE DEC HL ISIT 'E' DEC HL ISIT 'N' DEC HL LD A,(HL) CP 'Y' JP NZ,FLGP4 ; Legal if .ne. "y" DEC HL CALL VOWEL JP NZ,WRDNOT ; Illegal if "y" and no vowel INC HL FLGP4: INC HL LD (HL),0 CALL FINDIT ; Get "lateness", "grayness" CP 0 JP NZ,WRDRET ; Return if found DEC HL ISIT 'I' DEC HL CALL VOWEL JP Z,WRDNOT ; Can't be a vowel INC HL LD (HL),'Y' INC HL LD (HL),0 CALL FINDIT ; Get "cloudiness" JP WRDRET FLGM: LD DE,MFLAG ; Set m flag LD (FLAG),DE LD (HL),0 CALL FINDIT ; Get "dog's" JP WRDRET WRDNOT: LD A,0 ; Not found JP WRDRET ; ; VOWEL -- determine whether character in (HL) is a vowel. ; ; Returns: Z flag SET <-- is a vowel ; Z flag CLEAR <-- is not a vowel VOWEL: PUSH BC PUSH HL LD A,(HL) ; Get character LD HL,VOWELS ; Pointer to vowels LD BC,5 ; 5 vowels CPIR ; Test against all vowels ; Set status bits to be used after ret POP HL POP BC RET VOWELS: DB 'AEIOU' ; ; SXZH -- same as VOWEL put for the characters S, X, Z and H SXZH: PUSH BC PUSH HL LD A,(HL) ; Get character LD HL,SXZH0 ; Pointer to character list LD BC,4 ; 4 potential matches CPIR ; Test against s, x, z, h POP HL POP BC RET SXZH0: DB 'SXZH' ; ; Determine which record of dictionary would contain WORD. Puts record in ; BC FINDIT: PUSH BC PUSH DE PUSH HL LD A,(ALPHA) ; Still in alphabetical order? AND A JP NZ,FINLO5 ; Don't decrement pointers if yes LD HL,(LSTADR) ; Get address of last dictionary pointer ; Used FINLOW: LD DE,WORD EX DE,HL LD BC,4 FINLO1: LD A,(DE) ; Make sure that current record is ; Before word INC DE CPI JP M,FINLO5 ; If earlier, jump JR NZ,FINLO2 ; If later, then decrement JP PE,FINLO1 ; Loop while bc-1 .ne. 0 FINLO2: LD BC,(LSTREC) ; Decrement the pointers DEC BC LD HL,0 ; Is it too low? XOR A SBC HL,BC JR Z,FINLO5 ; If so, then forget it LD (LSTREC),BC LD HL,(LSTADR) LD DE,4 XOR A ; Clear carry SBC HL,DE LD (LSTADR),HL JP FINLOW ; Try again FINLO5: LD BC,(LSTREC) ; Get last record number read LD HL,(LSTADR) ; Get address of last dictionary pointer ; Used FINDI0: PUSH BC PUSH HL LD DE,WORD EX DE,HL LD BC,4 ; Comparing up to 4 characters FINDI1: LD A,(DE) ; Get a character from pointer table INC DE CPI ; Compare to word: JR NZ,FINDI2 ; Jump if different JP PO,FINDI3 ; Jump if all 4 characters equal JR FINDI1 ; Try another FINDI2: JP P,FINDI3 ; Too far in dictionary LD DE,4 POP HL POP BC ADD HL,DE ; Point to next record index INC BC JP FINDI0 FINDI3: POP HL POP BC FINDI4: DEC BC LD DE,4 XOR A ; Clear carry SBC HL,DE LD (LSTREC),BC ; Update pointers LD (LSTADR),HL ; ; LOOKUP -- loop through as many records as it takes to be sure that word is ; not in dictionary LOOKUP: CALL DICFND CP 0FFH ; If return status=0ffh then word could ; Be in next record JR NZ,LOOKU0 ; Return if not in next record INC BC LD HL,0+(TABBOT-TABTOP)/4 ; Make sure not past last record XOR A ; Clear the carry bit SBC HL,BC JR NZ,LOOKUP ; Try next record if not at end LD A,0 LOOKU0: POP HL ; Restore the stack POP DE POP BC RET ; ; DICFND -- read record in BC from dictionary. Determine whether WORD is ; in it. ; ; Returns in A: 0 <-- word not found ; 1 <-- word found ; 2 <-- word found but flag not set ; 0FFH<-- word not found but it may be in next ; record DICFND: PUSH HL PUSH DE PUSH BC RLC B ; Multiply bc by 2 so it points to ; 256 byte record RLC C LD A,0 ADC A,B ; Get the carry from rlc c LD B,A LD A,C AND 0FEH ; Kill bit 0 LD C,A LD HL,(DICREC) ; Get the current record in ram DEC HL ; Point to first 128 bytes of 256 ; Byte dictionary records XOR A ; Clear carry bit SBC HL,BC ; Attempt to read the same record? JR NZ,DICDSK ; If no, read from disk LD A,(ALPHA) ; Working in aphabetical order? AND A JP NZ,DICFO1 ; Just get another word if yes LD A,(CURBIT) ; Rotate current byte so it is the right ; Position in case same record used AND 0111B ; Is it on correct rotation now? JR Z,DICFN0 LD HL,(CURBYT) ; Address of current byte LD B,A LD A,8 ; Must complete 8 rotations, total SUB B ; Subtract number already done LD B,A ROTATE: RLC (HL) DJNZ ROTATE JP DICFN0 ; Start testing words DICDSK: PUSH BC LD (DICREC),BC ; New record to read LD C,SETDMA ; Set dma to dictionary buffer LD DE,DICBUF ; Dicionary buffer in ram CALL BDOS LD C,RANREA ; Bdos random read code LD DE,DICFCB ; Fcb of dictionary CALL BDOS POP BC INC BC ; Get 256 bytes LD (DICREC),BC ; Next record number LD C,SETDMA ; Dma address 256 bytes higher LD DE,DICBUF+128 CALL BDOS LD C,RANREA LD DE,DICFCB CALL BDOS ; Read next record DICFN0: LD HL,DICBUF-1 ; Initialize pointer to dictionary ; Buffer LD (CURBYT),HL LD A,0 ; Current bit=0 LD (CURBIT),A DICFN1: CALL MOVWRD ; Get a word DICFO1: LD HL,WORD ; Point to word LD BC,DICWRD ; Pointer to dictionary word DICFN2: LD A,(BC) ; Get a letter from dictionary word CP (HL) ; The same? INC HL ; Point to next character INC BC JR NZ,DICFN4 ; If not, try some more or end CP 0 ; End of word? JR NZ,DICFN2 ; Try another character LD C,1 ; Indicate word found LD HL,(DICFL) LD A,(FLAG) ; Get first flag CP 0 ; No flag wanted? JR Z,DICFN3 ; Try next byte of flag if none AND L CP 0 ; Indicate word found if .ne. 0 JR NZ,DICRET LD C,2 ; Indicate main word found/no flag JR DICRET DICFN3: LD A,(FLAG+1) ; Try next flag byte CP 0 ; No flag wanted? JR Z,DICRET ; If none wanted then word found AND H CP 0 ; Found if .ne. 0 JR NZ,DICRET LD C,2 ; Indicate main word found/no flag JR DICRET DICFN4: JP M,DICFN1 ; If test word is earlier in alphabet, ; Try next dictionary word LD C,0 ; Not found ; JP DICRET DICRET: LD A,C ; Put status byte in a POP BC POP DE POP HL RET ; ; MOVWRD -- read a word from the dictionary by decoding the flags. ; ; Returns: DICWRD <-- word from dictionary MOVWRD: LD A,0 LD B,4 CALL GETBIT ; Get 4 bits into a LD HL,DICWRD ; Point to dictionary word buffer LD B,0 LD C,A ; Number of characters to keep ADD HL,BC MOVWR1: LD A,0 LD B,3 ; Get first 3 of 5 bits for character CALL GETBIT ; Bits in a CP 0111B ; Is it an end of word mark? JR Z,GETFLG ; Get the flags now LD B,2 ; Get remaining 2 bits CALL GETBIT CP 0 ; If zero then end of record JP Z,MOVMOR ; Indicate may be in next record ADD A,40H ; Make it ascii CP 'Z'+1 ; Is it an encoded "'"? JR NZ,MOVWR4 ; Jump if not LD A,027H ; Make it a "'" MOVWR4: LD (HL),A ; Buffer the character INC HL JR MOVWR1 ; Get another character MOVMOR: LD C,0FFH ; Indicate may be in next record POP DE ; Get useless return word JP DICRET ; Return ; ; GETFLG -- read suffix flags from buffer. ; ; Returns: DICFL <-- 16 byte flag word GETFLG: LD A,0 LD (HL),A ; Mark the end of the word LD B,4 ; Get 4 bits for number of flags value CALL GETBIT LD B,A ; Number of bits in b LD HL,0 CP 0 ; Are any bits there to copy? JP Z,GETFL8 ; Return if none PUSH BC CP 8 ; More than 8 bits? JP M,GETFL1 ; Jump if not LD B,7 ; Get 7 bits for first byte GETFL1: LD A,0 CALL GETBIT POP BC LD L,A ; This is the low byte of flags LD A,B CP 8 ; Get more if greater than 8 bits JP P,GETFL4 LD A,7 ; Compute number of rotations necessary ; To put it in the right place SUB B JP Z,GETFL8 ; If exactly 7 then done LD B,A ; Counter GETFL3: RLC L DJNZ GETFL3 JP GETFL8 ; No return GETFL4: SUB 7 ; Get number of bits needed for byte 2 LD B,A LD A,0 PUSH BC CALL GETBIT ; Get bit for high byte of status flag POP BC LD H,A ; Save high byte LD A,7 ; Compute number of rotations left SUB B JR Z,GETFL8 ; Return if none LD B,A GETFL6: RLC H DJNZ GETFL6 GETFL8: LD (DICFL),HL ; Save the flag RET ; ; GETBIT -- read number of bits in B from dictionary buffer. ; ; Returns: A <-- byte value of B bits GETBIT: PUSH DE PUSH HL EX AF,AF' ;A HOLDS DESIRED DECODED BYTE. ; A' hold current bit value LD A,(CURBIT) LD HL,(CURBYT) ; Address of current byte for output LD D,(HL) ; D = current byte value EX AF,AF' GETBI0: EX AF,AF' ;GET CURRENT BIT VALUE AND 0111B ; Mask 1st three bits JR NZ,GETBI1 ; If .ne. 0 then not time to inc curbyt LD (HL),D ; Restore old byte to original value INC HL LD (CURBYT),HL LD D,(HL) ; Update d = current byte value GETBI1: INC A EX AF,AF' ;BACK TO DECODED BYTE RLC D ; Move byte so next bit in right place RLC A ; Make a ready to receive BIT 0,D ; Is the bit on? JR Z,GETBI2 ; Don't set a if it isn't OR 1 ; Set bit 1 of a GETBI2: DJNZ GETBI0 ; Loop through desired number of bits EX AF,AF' ;GET CURRENT BIT LD (CURBIT),A ; Update it EX AF,AF' LD (HL),D ; Update byte for next call POP HL POP DE RET ; ; USRTST -- test user dictionary in memory for WORD. ; ; Returns in A: 0 <-- word not found ; 1 <-- word found USRTST: LD HL,NEXT ; Beginning of user dictionary buffer LD A,0 CP (HL) ; Does one exist? RET Z ; Can't find element of an empty set! LD DE,WORD ; Address of word for comparing USRTS1: LD A,(DE) ; Get a character CP (HL) ; Are they the same? JR NZ,USRTS2 ; If not same, try another word INC DE INC HL CP 0 ; End of word? JR NZ,USRTS1 ; Loop through whole word LD A,1 ; Found it! RET USRTS2: LD A,0 USRTS3: CP (HL) ; Look for end of word INC HL JR NZ,USRTS3 CP (HL) ; If next byte also 0 then end of table RET Z LD DE,WORD JR USRTS1 ; Test another word ; ; DECOUT - Output number in HL to console in decimal ; DECOUT: PUSH PSW PUSH BC PUSH DE PUSH HL LD B,0 ; B will be 1 once non-zero char output LD DE,10000 ; Start by trying 10,000's CALL NUMOUT ; Output a number LD DE,1000 ; 1000's CALL NUMOUT LD DE,100 CALL NUMOUT LD DE,10 CALL NUMOUT LD B,1 ; Guarantee that 0 will print LD DE,1 CALL NUMOUT POP HL POP DE POP BC POP PSW RET NUMOUT: LD C,0 ; Counter for number of subtractions NUMOU0: INC C ; Count loops through subtraction XOR A ; Clear carry SBC HL,DE ; Subtract units until carry JP NC,NUMOU0 ADD HL,DE ; Reset to last positive value DEC C ; Don't count last subrtraction JR NZ,NUMOU1 ; If not zero, then output CP B ; Anything output yet? RET Z ; If not, then don't print a 0 NUMOU1: LD B,1 ; Indicate output sent LD A,C ADD A,'0' ; Convert to ascii LD E,A ; Output to console LD C,CONOUT ; Console output code PUSH BC PUSH HL CALL BDOS POP HL POP BC RET INPTR: DW INBUF+512 ; Pointer to current byte in input buff OPOSS: DW OBUFF ; Pointer to current byte in output buff SRTBOT: DW NEXT ; Pointer to beginning of memory pointer ; Table of alphabetized words from input ; File SRTTOP: DW NEXT+2 ; Pointer to top of memory pointer table FREE: DW NEXT ; Pointer to next free byte in tpa LASTCH: DB LF ; Last character indicator OLSTCH: DB LF ; Buffer for old last character when ; Multiple input fcb's in use SAVPUT: DS 1 ; Buffer for normal first instruction ; At putchr. used while output is ; Disabled DICFL: DW 0 ; Dictionary flag for compare CURBYT: DW DICBUF-1 ; Current byte of dicbuf (for getbit) CURBIT: DB 0 ; Current bit of byte (for getbit) ALPHA: DB 0 ; 0 if not working in alphabetical ; Order (did flag seek). 1 if in order LSTREC: DW 1 ; Record number of last dictionary ; Record read LSTADR: DW TABTOP+4 ; Pointer to table where first 4 bytes ; Of last record read are found OLDPTR: DW 0 ; Pointer for pass 1 of input file is ; Saved here during pass 2 if all of ; File did not fit in memory P2OPTR: DW P2BUF+512 ; Pointer for pass2 of input file is ; Saved here during pass 1 if all of ; File did not fit in memory STOPED: DB 0 ; Is 1 if all of file did not fit in ; Memory MLTPAS: DB 0 ; Same as stoped but never reset once ; Set DEFDRV: DB 0 ; Receives default drive value SPLDC: DW 0 ; Stores number of words in spell.dic FILUDC: DW 0 ; Stores number of words written to ; File.udc TOTWRD: DW 0 ; Records total number of words in doc UNQWRD: DW 0 ; Number of unique words in doc MISWRD: DW 0 ; Number of misspelled words OFCB: DB 0,' $$$' ; Fcb for output file DB 0,0,0,0,0,0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0,0,0,0 P2FCB: DB 0,' ' ; Fcb for pass 2 of input file DB 0,0,0,0,0,0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0,0,0,0 FILDIC: DB 0,' UDC' ; Fcb file file.udc DB 0,0,0,0,0,0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0,0,0,0 FILADD: DB 0,' ADD' ; Fcb for file.add DB 0,0,0,0,0,0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0,0,0,0 FILD$$: DB 0,' D$$' ; Fcb for temporary file file.d$$ DB 0,0,0,0,0,0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0,0,0,0 SPLDIC: DB 0,'SPELL DIC' ; Fcb for spell.dic DB 0,0,0,0,0,0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0,0,0,0 DICFCB: DB 0,'DICT DIC' ; Fcb for dictionary file DB 0,0,0,0,0,0,0,0,0,0,0,0,0 DB 0,0,0,0,0,0,0,0 DICREC: DB 0,0,0 ; Record number for random read ; (still part of fcb) STACK EQU $+50 ; Stack SRCWRD EQU STACK ; Buffer for unfixed word WORD EQU SRCWRD+100 ; Buffer for fixed word DICWRD EQU WORD+41 ; Buffer for words read from dictionary FLAG EQU DICWRD+41 ; Buffer for desired dictionary flag LASTC EQU FLAG+2 ; Buffer for last character read DICBUF EQU LASTC+1 ; Buffer for dictionary record INBUF EQU DICBUF+258 ; Input buffer for pass 1 P2BUF EQU INBUF+513 ; Input buffer for pass 2 OBUFF EQU P2BUF+513 ; Output buffer NEXT EQU OBUFF+513 ; Address of next free byte END START