; ; DICCRE V2.0 March 21, 1983 ; ; written by Michael C. Adler ; ; Creates a dictionary file DICT.DIC and a pointer file SPELL0.MAC ; from dictionary source files. Flags are converted into bit values and ; characters are stored in 5-bit. ; ; Modification history: ; ; V1.0 - August 16, 1982: Created. ; ; V2.0 - March 21, 1983: ; Added code to print double ' for words with apostrophes listed ; in SPELL0.MAC. ; TITLE DICCRE .Z80 ; JP START DB '(C) 1983 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.' BOOT EQU 0000H BDOS EQU 0005H IFCB EQU 005CH STROUT EQU 9 OPEN EQU 15 CLOSE EQU 16 DELETE EQU 19 READ EQU 20 WRITE EQU 21 MAKE EQU 22 RENAME EQU 23 SETDMA EQU 26 ; Set dma address RANREA EQU 33 ; Read random LF EQU 10 CR EQU 13 EOF EQU 01AH ; End of file character QUOTE EQU 027H ; "'" ; ; 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 START: LD SP,STACK ; Create a stack LD DE,WELCOM ; Print signon message LD C,STROUT CALL BDOS JR HIDONE WELCOM: DB 'DICCRE V2.0 -- March 21, 1983',CR,LF DB '(C) 1983 Michael C. Adler',CR,LF,'$' HIDONE: LD A,EOF ; Mark eof for buffers LD (OBUFF+512),A LD (INBUF+512),A LD (INBUF+513),A LD A,(BOOT+06CH) ; Get drive for output files LD (OFCB),A LD (DICFCB),A LD A,0C9H ; Return instruction LD (100H),A ; This program is can not be goed LD DE,IFCB ; Open input file LD C,OPEN CALL BDOS CP 0FFH ; File found? JR NZ,START0 LD DE,NOTFOU ; Error LD C,STROUT CALL BDOS CALL BOOT NOTFOU: DB 'Input file not found',CR,LF,'$' START0: LD DE,DICFCB LD C,OPEN CALL BDOS CP 0FFH ; Does "DICT.DIC" already exist? JR Z,START1 ; If not, continue LD DE,EXDIC ; Delete dict.dic message LD C,STROUT CALL BDOS CALL YESNO ; Ask whether delete it CALL NZ,BOOT ; Don't run if don't delete LD DE,DICFCB LD C,DELETE CALL BDOS START1: LD DE,DICFCB LD C,MAKE CALL BDOS LD DE,OFCB LD C,OPEN ; Does "SPELL0.MAC" exist? CALL BDOS CP 0FFH JR Z,START2 ; If not, continue LD DE,EXSPEL ; Delete spell0.mac message LD C,STROUT CALL BDOS CALL YESNO ; Ask whether delete it CALL NZ,BOOT ; Don't run if save file LD DE,OFCB LD C,DELETE CALL BDOS START2: LD DE,OFCB LD C,MAKE CALL BDOS CALL CTRLZ ; Put ^z in obuff LD A,01AH ; Also at end of it LD (OBUFF+512),A CALL DICZER ; Zero dictionary buffer LD HL,TABTOP ; Character string for tabtop:: LD B,8 ; Output 10 characters LOOP: LD A,(HL) CALL PUTCHR INC HL DJNZ LOOP CALL GETWRD ; Get the first word LD A,0 ; End of file? unlikely! CP C CALL Z,BOOT LD B,C LD C,0 CALL MAKTBL ; Put word in record table JR MAINSK MAIN: CALL GETWRD ; Get a word LD A,0 ; If 0 length word then end CP C JP Z,DONE LD B,C ; Put number of characters read in b LD C,0 ; Zero counter MAINSK: LD HL,SRCWRD LD DE,OLDWRD MAIN0: LD A,(DE) ; Compare this word to last (get # of ; Similar characters) CP (HL) JR NZ,MAIN1 INC DE INC HL INC C JR MAIN0 MAIN1: LD A,15 ; May copy maximum of 15 characters CP C JP NC,MAIN2 ; Jump if less than 15 LD C,15 LD HL,SRCWRD+15 ; Point to 1st character to use MAIN2: PUSH BC ; Compute number of bits in word LD A,B ; Compute number of characters in word- ; Number to copy SUB C LD B,A LD A,0 MAIN3: ADD A,5 ; 5 bits per letter DJNZ MAIN3 POP BC ADD A,25 ; 4 bits for copy amount ; 14 bits for status flags ; 4 bits for length of status flags ; 3 bits for end of word PUSH DE PUSH HL LD HL,(BITS) ; Number of bits left in 256 byte record LD E,A ; Put bits in this word in de LD D,0 XOR A ; Clear carry SBC HL,DE ; Number of bits left after this JP NC,MAIN4 ; Jump if word will fit CALL DWRITE ; Write this record CALL DICZER ; Zero dictionary buffer LD C,0 ; Beginning of record. copy 0 CALL MAKTBL ; Write to table file LD HL,2048 ; Number of bits in 256 bytes LD (BITS),HL ; Reset counter POP HL POP DE LD HL,SRCWRD JP MAIN2 ; Recalculate length of word MAIN4: LD (BITS),HL POP HL POP DE PUSH BC PUSH HL LD C,B ; Number of characters in srcwrd to bc LD B,0 LD HL,SRCWRD ; Put srcwrd in oldwrd LD DE,OLDWRD LDIR LD A,1 LD (DE),A ; Mark end of word POP HL POP BC CALL BUFWRD ; Buffer word in record JP MAIN ; Get next word DONE: LD A,(IFCB) ; If input file on different disk than ; Output file, ask if more LD HL,OFCB CP (HL) JR Z,ENDIT LD DE,MOREST ; More question LD C,STROUT CALL BDOS LD HL,INBUF+512 ; Get prepared in case more LD (INPTR),HL CALL YESNO JR NZ,NOMORE ; End if no more LD HL,IFCB+0CH ; Clear the ifcb record pointers LD B,23 LD A,0 DONF: LD (HL),A INC HL DJNZ DONF LD DE,IFCB ; Open the file LD C,OPEN CALL BDOS CP 0FFH ; Found? JP NZ,MAIN ; Get next word LD DE,NOTFOU ; Not found message LD C,STROUT CALL BDOS NOMORE: LD A,(IFCB) ; Is it on drive other than a? CP 2 JP P,ENDIT ; Just boot if so LD DE,TYPECR ; Message: insert bootable disk... LD C,STROUT CALL BDOS LD DE,BOOT+80H ; Wait for a line from terminal LD C,0AH CALL BDOS ENDIT: LD HL,TBTSTR ; "TABBOT::" LD B,24 ; 12 characters with cr,lf DONE0: LD A,(HL) ; Get the character INC HL CALL PUTCHR DJNZ DONE0 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 HL,(CURBYT) ; See if data left in dictionary rec LD BC,DICBUF-1 XOR A ; Clear carry SBC HL,BC JR Z,DONE4 ; Don't write if no data CALL DWRITE ; Write out current dictionary record DONE4: LD DE,DICFCB ; Close file LD C,CLOSE CALL BDOS CALL BOOT BUFWRD: RRC C ; Output number of bytes to copy RRC C RRC C RRC C LD B,4 ; Send 4 bits BUFWR0: LD A,0 RLC C ; Set/clear carry based on bit ADC A,0 CALL PUTBIT DJNZ BUFWR0 BUFWR1: LD A,(HL) ; Get character to output INC HL CP '%' ; Stop if end of word JR Z,BUFWR3 CP 0 JR Z,BUFWR3 LD B,5 ; 5 bits CP 027H ; Is it "'"? JR NZ,NORMAL LD A,'Z'+1 ; If it is, encode as z+1 NORMAL: SUB 'A'-1 ; Make it based at 1 LD C,A RLC C ; Put bits in position to be read RLC C RLC C BUFWR2: LD A,0 RLC C ; Set/clear carry based on bit ADC A,0 CALL PUTBIT DJNZ BUFWR2 JR BUFWR1 ; Get next character BUFWR3: LD A,1 ; Mark end of word with 111b CALL PUTBIT CALL PUTBIT CALL PUTBIT DEC HL LD D,H ; Put pointer to srcwrd in de LD E,L BUFWR4: LD A,(DE) CP 0 ; Any flags? JP Z,BUFFLG ; Write null flags if not CP '%' ; Another flag? INC DE JR Z,BUFWR4 CP ' ' ; Illegal if space JP Z,BUFWR4 LD HL,FLGDAT ; Table of flags LD BC,29 ; 14 word flags. if reaches end, error. CPIR ; Search through table JP PO,BUFWR4 ; Just skip if illegal flag LD BC,FLGDA0-FLGDAT-1 ; Offset to table of values for flags ADD HL,BC ; Point to word with flag LD C,(HL) ; Put it in de INC HL LD B,(HL) LD HL,(CURFLG) ; Get current value of flag LD A,B ; Make sure flag not repeated OR H LD H,A LD A,C OR L LD L,A LD (CURFLG),HL JP BUFWR4 ; Get another flag BUFFLG: LD HL,(CURFLG) ; Get current flag CALL PUTFLG ; Output the flag LD HL,0 LD (CURFLG),HL ; Clear current flag value RET PUTFLG: LD A,14 ; Find first used bit PUSH HL PUTFL0: RRC H JP C,PUTFL2 ; If bit set, exit DEC A CP 7 JR NZ,PUTFL0 ; Loop through whole byte PUTFL1: RRC L JP C,PUTFL2 DEC A CP 0 JR NZ,PUTFL1 PUTFL2: POP HL RRC A ; Put a in a position for output RRC A RRC A RRC A LD B,4 ; 4 bits LD C,A PUTFL4: LD A,0 RLC C ADC A,0 CALL PUTBIT DJNZ PUTFL4 LD A,C PUSH PSW PUSH HL LD HL,(BITS) ; Update number of bits left (greater?) LD C,A ; Compute number of bits saved LD A,14 SUB C LD B,0 ; Update bits LD C,A ADD HL,BC LD (BITS),HL POP HL POP PSW CP 0 ; Any bits to copy? RET Z PUSH PSW CP 8 ; Greater than 7? JP M,PUTFM4 LD A,7 ; Do all 7 bits PUTFM4: LD B,A ; Number of bits to copy RLC L ; Get to first bit PUTFL5: LD A,0 RLC L ADC A,0 CALL PUTBIT DJNZ PUTFL5 POP PSW SUB 7 ; Number of bits to copy in byte 2 RET M ; Return if none RET Z LD B,A RLC H ; Get to first bit PUTFL6: LD A,0 RLC H ADC A,0 CALL PUTBIT DJNZ PUTFL6 RET PUTBIT: PUSH PSW PUSH DE PUSH HL LD HL,CURBIT ; Get bit index LD E,(HL) LD HL,(CURBYT) ; Address of current byte for output PUSH PSW LD A,0111B ; Mask 1st three bits AND E JR NZ,PUTBI0 ; If .ne. 0 then not time to inc curbyt INC HL LD (CURBYT),HL PUTBI0: INC E POP PSW RLC (HL) ; Move byte so next bit in right place OR (HL) ; Put desired bit in output buffer LD (HL),A LD HL,CURBIT ; Update mask LD (HL),E POP HL POP DE POP PSW RET DWRITE: PUSH BC PUSH DE PUSH HL LD HL,(CURBYT) ; Get current byte LD A,(CURBIT) ; Current bit LD E,A DWRIT0: LD A,0111B ; Rotate last byte into place AND E JR Z,DWRIT1 RLC (HL) INC E JR DWRIT0 DWRIT1: LD HL,DICBUF-1 ; Reset pointers LD (CURBYT),HL LD A,0 LD (CURBIT),A LD DE,DICBUF ; Set dma for first 128 bytes LD C,SETDMA CALL BDOS LD DE,DICFCB ; Write it LD C,WRITE CALL BDOS CP 0FFH ; Error? JR Z,DWRERR LD DE,DICBUF+128 ; Set dma for second half LD C,SETDMA CALL BDOS LD DE,DICFCB ; And write it LD C,WRITE CALL BDOS CP 0FFH ; Error? JR Z,DWRERR POP HL POP DE POP BC RET DWRERR: LD DE,DSKFUL ; Disk full error LD C,STROUT CALL BDOS CALL BOOT DSKFUL: DB 'Disk full',CR,LF,'$' MAKTBL: PUSH HL PUSH BC LD HL,DBSTR ; String with cr,lf," DB '" LD B,7 ; 7 characters MAKTB0: LD A,(HL) INC HL CALL PUTCHR DJNZ MAKTB0 LD HL,SRCWRD ; Word LD B,4 ; At most 4 characters go in table LD C,0 ; Counter MAKTB1: LD A,(HL) INC HL CP 0 ; End of word? JR Z,MAKTB2 CP '%' JR Z,MAKTB2 PUSH PSW CALL PUTCHR POP PSW CP QUOTE JR NZ,MAKTBP CALL PUTCHR ; "'" must be sent twice MAKTBP: INC C DJNZ MAKTB1 LD A,QUOTE ; "'" character CALL PUTCHR JR MAKRET MAKTB2: LD A,4 ; Get number of characters left to go SUB C LD B,A LD A,QUOTE ; "'" character CALL PUTCHR MAKTB3: LD A,',' ; Use ,0 istead of character CALL PUTCHR LD A,'0' CALL PUTCHR DJNZ MAKTB3 MAKRET: POP BC POP HL RET GETWRD: LD A,0 ; Zero length LD (LENGTH),A LD C,0 ; Zero counter GETWS0: CALL GETCHR ; Get a character CP EOF ; End of file? RET Z CALL LEGAL ; Test if legal JR Z,GETWR0 ; Exit loop if legal JR GETWS0 ; Loop until legal GETWR0: LD C,1 ; Update character counter LD HL,SRCWRD+1 ; Initialize pointer to srcwrd: LD (SRCWRD),A ; Store first character GETWR1: CALL GETCHR CALL LEGAL JR NZ,GETWR2 ; Exit loop when not word character LD (HL),A INC HL INC C JR GETWR1 GETWR2: LD (HL),0 ; Mark end of word LD A,(LENGTH) ; Was % already reached? CP 0 RET Z ; Return value in c if not LD C,A RET 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 CP '%' ; "%" JR NZ,LEGAL1 PUSH PSW LD A,(LENGTH) ; End already marked? CP 0 JR NZ,LEGRET LD A,C LD (LENGTH),A ; Mark length of word LEGRET: POP PSW LEGAL1: LD A,B RET GETCHR: PUSH BC PUSH DE PUSH HL LD HL,(INPTR) ; Pointer for input LD DE,INBUF+512 ; End of 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 AND 07FH ; Kill parity INC HL ; Incremented pointer LD (INPTR),HL GETRET: POP HL POP DE POP BC RET GETCH0: LD HL,INBUF LD DE,128 LD C,4 GETCH2: PUSH BC PUSH DE PUSH HL LD A,01AH ; Mark start of record with eof in case ; Eof LD (HL),A INC HL LD (HL),A DEC HL LD D,H ; Set up dma address for read LD E,L LD C,SETDMA CALL BDOS ; Set dma address LD DE,IFCB 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 LD (HL),EOF ; Put eof at beginning of first unused ; Record in memory LD HL,INBUF+1 LD (INPTR),HL ; Set up pointer to records JP GETRET DICZER: PUSH PSW PUSH BC PUSH HL LD B,0 LD A,0 LD HL,DICBUF DICZE0: LD (HL),A INC HL DJNZ DICZE0 POP HL POP BC POP PSW RET PUTCHR: 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 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 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 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 YESNO: LD C,6 ; Direct console i/o LD E,0FFH ; Input CALL BDOS AND 05FH ; Make upper case CP 0 ; No character yet? JR Z,YESNO CP 'Y' ; Yes? JR Z,YESNO1 CP 'N' JR Z,YESNO2 LD C,6 ; Ring the bell (bad input) LD E,7 CALL BDOS JR YESNO ; Try again YESNO1: LD DE,YESSTR ; Echo y LD A,0 ; Indicate yes JR YESNO3 YESNO2: LD DE,NOSTR ; Echo n LD A,1 ; Indicate no YESNO3: LD C,STROUT PUSH PSW CALL BDOS POP PSW AND A RET INPTR: DW INBUF+512 CURBYT: DW DICBUF-1 CURBIT: DB 0 CURFLG: DW 0 BITS: DW 256*8 LENGTH: DB 0 OPOSS: DW OBUFF EXDIC: DB 'Delete current version of DICT.DIC? $' EXSPEL: DB 'Delete current version of SPELL0.MAC? $' YESSTR: DB 'Y',CR,LF,'$' NOSTR: DB 'N',CR,LF,'$' TYPECR: DB 'Insert a bootable disk in drive A and type CR$' MOREST: DB 'More? (if Y, insert new disk in input drive) $' DICFCB: DB 0,'DICT DIC' DB 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 OFCB: DB 0,'SPELL0 MAC' DB 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 TABTOP: DB 'TABTOP::' TBTSTR: DB CR,LF,' DB ',QUOTE,'[[[[',QUOTE,CR,LF,'TABBOT::',CR,LF DBSTR: DB CR,LF,' DB ',QUOTE FLGDAT: DB 'Z Y R G D M S H V J X T N P ' FLGDA0: DW ZFLAG DW YFLAG DW RFLAG DW GFLAG DW DFLAG DW MFLAG DW SFLAG DW HFLAG DW VFLAG DW JFLAG DW XFLAG DW TFLAG DW NFLAG DW PFLAG OLDWRD: DB 0FFH STACK EQU $+50 SRCWRD EQU STACK+80 INBUF EQU SRCWRD+80 OBUFF EQU INBUF+514 DICBUF EQU OBUFF+513 NEXT EQU DICBUF+256 END START