title Type Huffman coded files name ('TYPELZH') ; Modified DASMed version of TYPELZ.COM ; By W.Cirsovius ; This program implements the enhancement of the standard ; CP/M command TYPE. It allows printing of SQUEEZED files ; as well as CRUNCHED ones. Of course, normal ASCII files ; will be printed, too. ; Files may reside in a LIBRARIAN generated by (NU)LU. ; Files may be printed on screen or printer ; ; From the UNSQUEEZER: ; ; Copyright (c) Steven Greenberg 6/28/86 ; 201-670-8724; may be copied for ; non-profit use only ; ; From the UNCRUNCHER: ; ; Copyright (c) Steven Greenberg 8/31/86 ; 201-670-8724. May be reproduced for ; non-profit use only. $$Prg macro db 'TYPELZ' endm FALSE equ 0 TRUE equ NOT FALSE $$Vers macro db 'v24' endm OS equ 0000h BDOS equ 0005h CCP equ 0080h DMA equ 0080h CPM3 equ 30h _nam equ 1 _ext equ 9 _rrn equ 33 .nam equ 8 .ext equ 3 _FN equ 11 FCBlen equ 36 RecLng equ 128 .conout equ 2 .lstout equ 5 .dircon equ 6 .string equ 9 .vers equ 12 .open equ 15 .rdseq equ 20 .setdma equ 26 .UsrCod equ 32 .rdrnd equ 33 .mulsec equ 44 .SCB equ 49 .parse equ 152 _get equ -1 $$Row equ 1ch CtrlC equ 'C'-'@' tab equ 09h lf equ 0ah CtrlK equ 'K'-'@' ff equ 0ch cr equ 0dh CtrlS equ 'S'-'@' CtrlX equ 'X'-'@' eof equ 1ah eot equ '$' MSB equ 10000000b NoMSB equ 01111111b LoMask equ 00001111b Ctrl equ 00011111b ColMask equ 00000111b .JP equ 0c3h ; Z80 JP code Page equ 256 LBRidx equ 12 LBRlen equ 32 USQhead equ 76ffh UNChead equ 76feh U??end equ 0feh U??sync equ 090h USQlen equ 256 ; 256 bytes, 0..255 USQmax equ 32 ; Max descriptor UNCstk equ 8 ; Stack pages for UNCR BufSpc equ 1024 MaxData equ 26880 U??spc1 equ 4096 U??spc2 equ 5120 U??spc3 equ 8192 U??spc4 equ 10240 U??spc5 equ 16384 UNC?len equ -5003 HI.spc equ HIGH U??spc1 HI.sum equ HIGH (U??spc1+U??spc3) @CRTLINE: db 0,'[CRTLINES>' @CRTCOL: db 80,'[PRTCOLS>' @PRTCOL: db 80,'[NEXTLN>' @WHEEL: db 60,'[WHLTEST>' ; @ROWS: ds 1 ; ; $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ; $$$ Here after parsing files and option $$$ ; $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ; DO.LZ: ld a,(@ROWS) ; Get rows sub 2 ; .. fix ld (Rows),a ld a,(L.FCB+_nam) ; Test LIBRARY file cp ' ' jp nz,ProcLBR ; ..yeap ld de,FCB call Open ; Open file ld hl,FCB+_nam QZY: push hl ld a,'(' call fputc call PrFN ; Print name of file pop hl ld de,_ext add hl,de ld a,(hl) cp 'Q' ; Test types jp z,USQ ; .. squeezed cp 'Z' jp z,UNCR ; .. crunched cp 'Y' ; .. LZH'd jp nz,TYPE ; .. normal ; ; &&&&&&&&&&&&&&&&&&&&&&&&& ; &&& Type a LZH'd file &&& ; &&&&&&&&&&&&&&&&&&&&&&&&& ; UNCRLZH:: call CR.HEAD ; Give header so far ld de,$NO.SUPP call String ; .. currently not supported call NL jp HALT $NO.SUPP: db ')',cr,lf,'LZH Currently not supported',eot ; ; &&&&&&&&&&&&&&&&&&&&&&&&&&&& ; &&& Type a crunched file &&& ; &&&&&&&&&&&&&&&&&&&&&&&&&&&& ; UNCR: call CR.HEAD ; Get header ld hl,UNCR.Task call Proc.Task ; Go uncrunch jp nc,ProcEOF ; Process end cp 1 ; Test revision number jp nz,IncCRErr ld de,$ILL.REV jp HALT.LN ; Invalid revision ; ; &&&&&&&&&&&&&&&&&&&&&&&&&&&& ; &&& Type a squeezed file &&& ; &&&&&&&&&&&&&&&&&&&&&&&&&&&& ; USQ: call InitRd ; .. init reading call .fgetc ; Skip word call .fgetc ld b,USQmax USQ.loop: call .fgetc ; Get name or a jr z,USQ.end.name call fputc ; .. tell it djnz USQ.loop jr USQ.error ; .. bad if we're here USQ.end.name: ld hl,USQ.Task call Proc.Task ; Go unsqueeze jp nc,ProcEOF ; Process end USQ.error: ld de,$INV.SQ jp HALT.LN ; Invalid squeezed file ; ; &&&&&&&&&&&&&&&&&&&&&&&&&&&& ; &&& Type an uncoded file &&& ; &&&&&&&&&&&&&&&&&&&&&&&&&&&& ; TYPE: call TellAction ; Tell action exx ld hl,(DiskBuff) ; Get disk buffer exx call .fgetc ; Get character jr c,Empty ; .. end of file Type.Loop: call fputc ; .. echo call .fgetc ; Get character jp c,ProcEOF ; .. end of file jr Type.Loop Empty: ld de,$EMPTY ; Tell empty file jp HALT.LN ; ; $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ; $$$ Here on LIBRARY file found $$$ ; $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ; ProcLBR: ld hl,'B'*256+'L' ld (FCB+_ext),hl ; Set .LBR ld a,'R' ld (FCB+_ext+2),a ld de,FCB call Open ; Open file ld hl,(DiskBuff) ; Set disk buffer call fgetc ; Get character jr c,Empty ; .. end of file dec l ; Fix buffer call EmpName ; Find empty 1st name jr nz,LBR.err ; .. should be ld l,_FN+1 ; Set over length xor a cp (hl) ; Test zero 1st record jr nz,LBR.err ; .. should be inc l cp (hl) ; Test next zero jr nz,LBR.err ; .. should be inc l ld b,(hl) ; Get record length ld l,LBRlen ; Set offset jr LBR.chk ; .. skip 1st entry LBR.err: ld de,$INV.LBR jp HALT.LN LBR.chk.entry: call CmpName ; Find member jr z,LBR.getFile ; .. got it LBR.chk: call CmpName ; Find member jr z,LBR.getFile call CmpName ; .. maybe next jr z,LBR.getFile call CmpName ; .. or next jr z,LBR.getFile dec b ; Test more jr z,LBR.noMem call fgetc ; Get character for next jr c,LBR.noMem ; .. end of file dec l ; .. fix buffer jr LBR.chk.entry ; keep on searching LBR.noMem: ld de,$NO.MEMB jp HALT.LN ; Cannot find member LBR.getFile: ld de,DMA call setDMA ; Set disk buffer ld de,LBRidx add hl,de ; Point to index ld e,(hl) ; Get sector number inc hl ld d,(hl) inc hl ld c,(hl) ; Get record count inc hl ld b,(hl) inc bc ld (RecCnt),bc ; Set record count ld (FCB+_rrn),de ; Set record xor a ld (FCB+_rrn+2),a ld de,FCB call PosFile ; Position file xor a ld (EOFflg),a ; Clear end of file inc a ld (LBRflag),a ; Indicate LIBRARY ld (RecsRead),a ; Set one record read ld hl,L.FCB+_nam jp QZY ; Process file ; ; <<<<<<<<<<<<<<<<<<<< START UTILITIES >>>>>>>>>>>>>>>>>>>> ; ; Find empty entry ; EXIT Reg HL points to buffer ; EmpName: ld de,$EMP.NAM ; Set source jr ..CmpName ; .. compare ; ; Compare names ; ENTRY Reg HL points to buffer ; EXIT Zero flag set if found ; Reg HL points to next member ; CmpName: ld de,L.FCB+_nam ; Set LIBRARY name ..CmpName: push bc push hl xor a cp (hl) ; Find active entry jr nz,CmpName.no ; .. nope ld b,_FN ; .. set length CmpName.cmp: ld a,(de) inc de inc hl cp (hl) ; Compare jr nz,CmpName.no djnz CmpName.cmp pop hl pop bc ret CmpName.no: pop hl ld de,LBRlen add hl,de ; .. fix for next pop bc ret ; ; Initialize read I/O ; InitRd: ld de,$ARROW call Write ; Indicate action exx ld hl,(DiskBuff) ; Init disk buffer exx call .fgetc ; Get hi type jp c,Empty ; .. end of file call .fgetc ; .. skip low type ret ; ; Process CRUNCH/LZH header ; CR.HEAD: call InitRd ; .. init reading ld b,_FN+1 ; Set max length CR.pr.name: call .fgetc ; Get name or a ; .. till zero ret z and NoMSB ; Mask MSB call fputc cp '.' ; Test extension jr z,CR.dot djnz CR.pr.name jr CR.descr? ; Test descriptor follows CR.dot: ld b,.ext ; Set length of extension jr CR.pr.name CR.descr?: ld b,255 ; Set max descriptor length CR.src.desc: djnz CR.valid? jr IncCRErr ; .. error CR.valid?: call .fgetc ; Get descriptor or a ret z ; .. none cp '[' ; Test descriptor jr nz,CR.src.desc ; .. wait for it ld de,$SPC call Write ; .. give delimiter ld a,'[' ; Indicate descriptor CR.desc.loop: djnz CR.desc.pr IncCRErr: ld de,$INV.CR jp HALT.LN ; Invalid crunch file CR.desc.pr: call fputc call .fgetc ; Get descriptor string or a jr z,CR.end.desc ; Find end cp ']' jr nz,CR.desc.loop CR.end.desc: ld a,']' call fputc ret ; ; Get character from file ; ENTRY Reg HL' holds buffer address started at page boundary ; EXIT Accu holds character ; Carry set on end of file ; .fgetc: exx ; Get buffer call fgetc ; Get character exx ret nc ; .. ok jp ProcEOF ; Else process end ; ; Get character from file ; ENTRY Reg HL holds buffer address started at page boundary ; EXIT Accu holds character ; Carry set on end of file ; fgetc: ld a,l sla a ; Test record boundary or a call z,RdDsk ; .. get from disk if so ret c ; .. end of file ld a,(hl) ; Get character inc hl ; .. bump buffer ret ; ; Read from disk ; EXIT Carry set on end of file ; Reg HL points to start of buffer ; RdDsk: ld a,(LBRflag) ; Test LIBRARY or a jr z,RdNormal ; .. nope push hl ld hl,(RecCnt) dec hl ; Count down member records ld (RecCnt),hl ld a,l or h ; Test remainder pop hl scf ; .. set end ret z ; .. leave if no more RdNormal: or a ld a,(RecsRead) dec a ; Count down records read ld (RecsRead),a call z,RdBuff ; Read buffer if no more ret ; ; Read disk buffer ; EXIT Carry set on end of file ; Reg HL points to start of buffer ; RdBuff: push bc push de ld e,BufSpc/RecLng ; Get page count call MulSec ; Set sectors ld de,(DiskBuff) ; Get disk buffer call RdRec ; Read records ld a,(RecRes) ; Get records read jr nz,RdEnd ld a,BufSpc/RecLng ; Get default count on success RdEnd: ld (RecsRead),a ; Set record result push af ld e,1 call MulSec ; Reset count pop af pop de pop bc ld hl,(DiskBuff) ; Get disk buffer ret z ; No EOF and a ret nz scf ; .. EOF ret ; ; Read a sequential record from file ; ENTRY Reg DE holds buffer to be read into ; EXIT Zero flag set on success ; RdRec: push de call SetDMA ; Set buffer ld de,FCB call RdRecord ; .. read record pop de ret z ; .. ok ld a,(EOFflg) ; Test end of file or a jp nz,ProcEOF ; .. yeap inc a ld (EOFflg),a ; Set it ret ; ; Print name of file ; ENTRY Reg HL points to name field of FCB ; PrFN: ld b,_FN+1 ..PrFN: ld a,(hl) ; Get character cp ' ' call nz,fputc ; .. filter blanks dec b ret z ld a,b cp .ext+1 ; Test extension ld a,'.' call z,fputc ; .. give dot if so inc hl jr ..PrFN ; ; Give new line and print string on console ; ENTRY Reg DE holds string ; WriteLN: call NL ; Close line ; ; Print string on console ; ENTRY Reg DE holds string ; Write: push bc ; Save reg call String ; .. print string pop bc ret ; ; Give new line on console ; NL: ld a,cr ; Give CR call fputc ld a,lf ; .. and LF ; ; Print formatted character to console ; ENTRY Accu holds character ; fputc: and NoMSB ; Strip off MSB cp eof ; .. test end of file jp z,ProcEOF ; ..yeap push bc ; .. save regs push de push hl push af ld a,(ListIO) ; Test printer or a jp nz,PutPr ; .. yeap pop af push af cp tab ; Test tab jr z,putTab ; .. yeap call Conout ; Print if not pop af push af cp lf ; Test new line jp nz,fput.noNL ; .. nope ld a,(@CRTLINE) ; Test line count enabled or a jr z,skp.lin.cnt ; .. nope dec a ; .. bump ld (@CRTLINE),a or a jr nz,skp.lin.cnt ld de,$EXCEED call WriteLN ; .. lines exceeded jp ProcEOF skp.lin.cnt: ld a,(@ROWS) ; Test rows enabled or a jr z,CIn ; .. nope fputc.pos.set: ld hl,Rows dec (hl) ; Count down rows jr nz,CIn ld de,$MORE call Write ; Tell more to put call Conin cp ' ' ; Test single line processing jr z,put.one.line ; .. yeap and Ctrl cp CtrlC ; Test break jp z,ProcEOF cp CtrlK jp z,ProcEOF cp CtrlX jp z,ProcEOF ld a,(@ROWS) ; Get rows dec a ; .. less 1 jr fput.row put.one.line: ld a,1 ; Set one line only fput.row: ld (Rows),a ; Set rows ld de,$CR call Write ; Clear line, get character ; ; Get character from console and check control ; CIn: call ConStat ; Get console state and Ctrl ; Get control bits cp CtrlC ; Test break jp z,ProcEOF cp CtrlX ; .. dtto. jp z,ProcEOF cp CtrlS ; .. or wait call z,Conin pop af pop hl pop de pop bc ret ; ; Execute tab processing ; putTab: ld a,' ' call Conout ; Give blank ld a,(ColPos) ; Test right position and ColMask jr z,fput.noNL ld a,(ColPos) inc a ; .. bump position ld (ColPos),a ld hl,ColPos ld a,(@CRTCOL) cp (hl) ; Test max jr nc,putTab fputc.set.1: ld (hl),1 ; .. truncate jr fputc.pos.set ; ; Proceed printing ; fput.noNL:: ld a,(@CRTCOL) ld b,a ld hl,ColPos pop af push af sub cr ; Test start of line jr nz,fput.noCR ld (hl),a ; .. clear position fput.noCR: inc (hl) ; .. bump ld a,(hl) cp b jr z,CIn jr c,CIn jr fputc.set.1 ; .. reset ; ; Process line printer ; PutPr: ld hl,ColPos pop af push af cp tab ; Test tab jr z,pr.tab call Lstout ; .. print cp cr ; Test line start jr z,pr.cr cp lf ; .. or new line jr z,pr.lf inc (hl) ; Bump count ld a,(@PRTCOL) cp (hl) ; Test max jr nc,CIn ld (hl),1 ; .. reset position pr.lf: ld a,(Wheel) ; Test wheel or a jr z,CIn ; .. empty dec a ; .. bump down ld (Wheel),a or a jr z,pr.ff ; .. new page ld a,(@CRTLINE) ; Get lines or a ; Test any jp z,CIn ; .. nope dec a ; .. bump down ld (@CRTLINE),a or a jp nz,CIn ld de,$EXCEED call WriteLN ; .. lines exceeded jp ProcEOF pr.inc.col: inc (hl) ; Bump position jp CIn pr.ff: ld a,ff ; Give new page call Lstout ld a,cr call Lstout ld a,(@WHEEL) ; Unpack wheel ld (Wheel),a pr.cr: ld (hl),1 ; Clear position on return jp CIn pr.tab: ld a,' ' call Lstout ; Print blanks ld a,ColMask and (hl) ; Test position reached jr z,pr.inc.col ; .. yeap inc (hl) ; .. bump ld a,(@PRTCOL) cp (hl) jr nc,pr.tab ld (hl),1 ; Reset position jr pr.lf ; ; Tell action on start of printing ; TellAction: push af ld a,(ListEna) ; Test listing enabled or a jr z,Act.CON ; .. nope ld de,$PRINTING call Write ; Tell action on printer ld a,(ListEna) ld (ListIO),a ; Change output device pop af ret Act.CON: ld de,$CTRL.PAG call Write ; Tell how to control printing pop af ret ; ; Give new line and halt the program ; HALT.LN: call WriteLN ; .. new line ; ; Halt the program - same as end of file ; HALT: ; ; Prcess end of file ; ProcEOF: call NL ; Close line ld a,(ListIO) ; Test printer or a ld a,ff call nz,Lstout ; Give line feed ld a,(User) call SetUsr ; Reset user jp OS ; Leave ; ; Process task ; ENTRY Reg HL points to routine to be called ; Proc.Task: push hl call TellAction ; Tell action exx ld hl,(DiskBuff) ; Reset disk buffer exx ld a,(RecsRead) inc a ; Fix disk counts ld (RecsRead),a ld hl,(RecCnt) inc hl ld (RecCnt),hl pop hl jp (hl) ; .. go ; ; Get memory pointer at page boundary ; EXIT Reg HL holds pointer ; _alloc: ld hl,(MemPtr) ; Get base pointer ld de,Page-1 add hl,de ; Get page boundayr ld l,0 ret ; ; ============== BDOS INTERFACE ============== ; ; Get character from console ; EXIT Accu holds character ; Conin: call ConStat ; Get state jr z,Conin ; Wait for any key ret ; ; Get state of console ; EXIT Zero set if no character found ; ConStat: push bc push de ld c,.dircon ld e,_get call .BDOS ; .. get it or a jr ..pop ; ; Print character on console ; ENTRY Accu holds character to be printed ; Conout: push bc push de ld c,.conout ld e,a call .BDOS ; Print ..pop: pop de pop bc ret ; ; Print string on console ; ENTRY Reg DE points to string ; String: ld c,.string call .BDOS ; .. print ret ; ; Print character on printer ; ENTRY Accu holds character ; Lstout: ld c,.lstout ld e,a push af call .BDOS ; .. print pop af ret ; ; Set disk buffer ; ENTRY Reg DE holds buffer ; setDMA: ld c,.setdma call .BDOS ; Set buffer ret ; ; Position file ; ENTRY Reg DE points to FCB with record position set ; PosFile: ld c,.rdrnd call .BDOS ; Read record or a ; Test success ret z jr OpnErr ; .. error ; ; Open file ; ENTRY Reg DE points to FCB ; Open: ld c,.open call .BDOS ; Open file inc a ; .. fix for error ret nz ; .. ok OpnErr: ld de,$OPN.ERR ; .. tell error jp HALT.LN ; ; Read record of file ; ENTRY Reg DE points to FCB ; EXIT Zero set on success ; RdRecord: ld c,.rdseq call .BDOS ; .. read record or a ret ; ; Get OS version ; EXIT Accu holds version ; GetVer: ld c,.vers call .BDOS ; .. get version ret ; ; Set multisector count ; ENTRY Reg E holds count ; MulSec: ld c,.mulsec call .BDOS ; .. set it ret ; ; Get user area ; EXIT Accu holds area ; GetUsr: ld a,_get ; .. get user ; ; Set user area ; ENTRY Accu holds area ; SetUsr: ld e,a ld c,.UsrCod ; .. set user ; ; Do sytem call ; ENTRY Reg C holds function to be selected ; Other regs set as defined by function ; EXIT As defined by function ; .BDOS: push bc ; Save all regs push de push hl exx push hl exx call BDOS ; .. do it push af ld a,h ld (RecRes),a ; Save possible record count pop af exx pop hl exx pop hl pop de pop bc ret ; ; ============================================ ; $OPN.ERR: db lf,'Input file not found.',eot $ARROW: db ' ---> ',eot $MORE: db '[more] ',eot $CR: db cr $EMP.NAM: db ' ',cr,eot $INV.CR: db lf,'Invalid Crunched File.',eot $ILL.REV: db lf,'File needs newer program revision.',eot $CTRL.PAG: db ')',cr,lf,' [ ^X = abort ' db ' = next line = next page ]' db cr,lf,eot $PRINTING: db ')',cr,lf,lf db ' ==>> Sending file to printer',cr,lf,eot $INV.SQ: db lf,'Invalid Squeezed File.',eot $INV.LBR: db lf,'Invalid Library File.',eot $EMPTY: db lf,'File empty.',eot $NO.MEMB: db lf,'Member not found in Library.',eot $EXCEED: db lf,'Line count limit exceeded. ' db ' Please download the file.',eot $SPC: db ' ',eot LBRflag: db 0 RecsRead: db 1 RecRes: db 0 ColPos: db 1 EOFflg: db 0 PPB: dw 0,0 ; ; !!!!!!!!!!!!!!!!!!!!!!!!!! ; !!! The UNSQUEEZE task !!! ; !!!!!!!!!!!!!!!!!!!!!!!!!! ; ; ENTRY Reg HL points to free memory ; EXIT Carry set on error ; USQ.Task: call _alloc ; Get memory pointer ld (USQ.base),hl ; .. save ld (USQ.SavStk),sp ; Save stack ld hl,USQ.cell ld de,(USQ.base) ld bc,USQclen ldir ; Move code for one cell ld hl,(USQ.base) ld bc,USQclen*(USQlen-1) ldir ; .. now the main part call USQ.fgetc ; Get character cp HIGH USQhead ; .. verify correct header jr nz,USQ.Err call USQ.fgetc cp LOW USQhead jr z,USQ.go USQ.Err: ld a,2 ; Return error scf USQ.end: ld sp,(USQ.SavStk) ; Get back stack ret USQ.go: ld b,USQmax ; <<=== WHY HERE ???? call USQ.fgetc ; Skip over name or a jr z,USQ.tree ; .. end, so start djnz USQ.go jr USQ.Err ; ; -------------- Code to be moved into memory ------------- ; USQ.cell: srl b call z,USQ.fget.hi jr c,USQ.cell.C USQ.Code: ld a,$-$ ;; OR: JP $-$ ret ;; USQ.cell.C: ld a,$-$ ;; OR: JP $-$ ret ;; ds 3 ; Filler for 16 bytes USQclen equ $-USQ.cell ; ; --------------------------------------------------------- ; ; Build tree ; USQ.tree: call USQ.fgetc ; Get length of tree ld c,a call USQ.fgetc ld b,a sub HIGH (2*Page) ; Test max jp nc,USQ.Err ; .. error ld hl,(USQ.base) ; Get first cell ld de,USQ.Code-USQ.cell add hl,de ; Set start ld de,USQclen-2*3 ; .. set increment USQ.tree.loop: call USQ.bld.tree ; Set 1st node call USQ.bld.tree ; .. 2nd node add hl,de ; Point to next cell dec bc ld a,b ; Test end or c jr nz,USQ.tree.loop jr USQ.main ; .. no go ; ; Build tree element ; USQ.bld.tree: push bc call USQ.fgetc ; Get code ld c,a call USQ.fgetc or a ; Test < 0 jp m,USQ.isEnd? ; .. yeap sla c ; Multiply by cell length (16) rla sla c rla sla c rla sla c rla ld b,a ld a,(USQ.base+1) add a,b ; Add base ld b,a USQ.tree.JP: push bc ld (hl),.JP ; Set JP inc l pop bc ld (hl),c ; .. save address inc l ld (hl),b inc l pop bc ret USQ.isEnd?: cp U??end ; Test end jr z,USQ.set.end ; .. yeap ld a,c cpl ; Set complement inc l ld (hl),a inc l ; .. fix pointer inc l pop bc ret USQ.set.end: ld bc,USQ.done ; Set end as cell jr USQ.tree.JP ; .. store ; ; Get HI part of squeezed data ; USQ.fget.hi: call USQ.fgetc ; Get byte ld b,a scf rr b ret ; ; +++++++++++++++++++++ ; +++ MAIN USQ LOOP +++ ; +++++++++++++++++++++ ; USQ.main: exx ld bc,0 ; Init a bit exx ld hl,(USQ.base) ; Load base push hl pop ix ; .. as start ld b,0 ; Clear on USQ.main.loop: call USQ.jp.cell ; Goto cell call USQ.data.set ; .. fix data jr USQ.main.loop ; ; Enter a cell ; USQ.jp.cell: jp (ix) ; ; End of USQ code ; USQ.done: and a ; Clear error jp USQ.end ; .. and leave ; ; The data set routine ; USQ.data.set:: exx srl b jr c,l0cc4 ; Test bit cp U??sync ; Test sync jr z,l0cc1 ; .. yeap ld c,a exx call USQ.fputc ; .. else print ret l0cc1: inc b ; Count up exx ret l0cc4: or a jr z,l0cd3 dec a ld b,a ld a,c l0cca: exx call USQ.fputc ; Print character exx djnz l0cca exx ret l0cd3: ld a,U??sync exx call USQ.fputc ; Print character ret ; ; Get character from file ; EXIT Accu holds byte ; USQ.fgetc: push bc push de push hl exx push bc exx push ix call .fgetc ; .. get from file pop ix exx pop bc exx pop hl pop de pop bc ret ; ; Print character to device ; ENTRY Accu holds character ; USQ.fputc: push af push bc push de push hl exx push bc exx push ix call fputc ; .. put to device pop ix exx pop bc exx pop hl pop de pop bc pop af ret ; ; !!!!!!!!!!!!!!!!!!!!!!!!! ; !!! The UNCRUNCH task !!! ; !!!!!!!!!!!!!!!!!!!!!!!!! ; ; ENTRY Reg HL points to free data ; EXIT Carry set on abnormal end ; Accu holds error code ; UNCR.Task: call _alloc ; Get memory pointer ld (UNC.base),hl ld a,HI.sum ; Add pages required add a,h ld h,a ld (UNC.dat),hl ld a,HIGH U??spc4 add a,h ; .. once more ld h,a push hl ld de,0 ex de,hl and a sbc hl,de ; Get complement ld (UNC.top),hl pop hl ld a,h add a,UNCstk ; Fix for stack ld h,a ld (UNC.stk),sp ld sp,hl ld hl,UNC?len ; <<< ==== HOW CALCULATED ld de,(UNC.dat) and a sbc hl,de ; Get gap ld (UNC.gap),hl call IniUNCR ; Init data call UNCR.fgetc cp HIGH UNChead ; Test valid header jr nz,UNCR.HeadErr ; .. nope call UNCR.fgetc cp LOW UNChead jr z,l0dc2 UNCR.Ovfl: ld a,4 jr UNCR.Err UNCR.DatErr: ld a,3 jr UNCR.Err UNCR.HeadErr: ld a,2 jr UNCR.Err UNCR.RevErr: ld a,1 UNCR.Err: scf ; Set error l0dba: ld sp,(UNC.stk) ; Get back stack ret ; .. leave task UNCR.end: xor a jr l0dba ; ; ++++++++++++++++++++++ ; +++ MAIN UNCR LOOP +++ ; ++++++++++++++++++++++ ; l0dc2: call UNCR.fgetc ; Get bytes or a ; .. till zero jr nz,l0dc2 call UNCR.fgetc ; Skip next call UNCR.fgetc push af call UNCR.fgetc ; .. dto. call UNCR.fgetc pop af cp ' ' ; Test character jp nc,l0f83 call l0ed6 ld de,-1 l0de1: ld (l12a6),de call l0ea4 jp c,UNCR.end ; .. that's all push de call l0e13 ld hl,l12a8 srl (hl) jr c,l0dff ld hl,(l12a6) ld a,(l12b3) call l0e5d l0dff: pop de ld a,(l12a5) or a jr z,l0de1 l0e06: call l0ea4 jp c,UNCR.end ; .. that's all push de call l0e13 pop de jr l0e06 l0e13: push hl ld hl,(UNC.top) add hl,sp jp nc,UNCR.Ovfl ; .. data overflow ld a,(UNC.base+1) add a,d ld h,a ld l,e ld a,(hl) cp MSB jr nz,l0e3c ld a,1 ld (l12a8),a push hl ld hl,(l12a6) ld a,(l12b3) call l0e5d pop hl ld a,(hl) cp MSB jp z,UNCR.DatErr l0e3c: ld d,(hl) ld a,h add a,HI.spc ; .. add page ld h,a ld e,(hl) bit 7,d jr nz,l0e53 call l0e13 ld a,h add a,HI.spc ; .. add page ld h,a ld a,(hl) l0e4e: call l10dc pop hl ret l0e53: ld a,h add a,HI.spc ; .. add page ld h,a ld a,(hl) ld (l12b3),a jr l0e4e l0e5d: push af push hl call l0f57 ld h,a ld a,(UNC.base+1) add a,h ld h,a pop de pop af ld c,a l0e6b: ld b,h ld a,(hl) cp MSB jr z,l0e87 ld a,h add a,HI.sum ; Add amount ld h,a ld a,(hl) or a jr z,l0e83 ld b,a ld a,h add a,HI.spc ; .. add page ld h,a ld l,(hl) ld h,b jp l0e6b l0e83: ld h,b call l0f08 l0e87: ld (hl),d ld a,h add a,HI.spc ; .. add page ld h,a ld (hl),e ld a,h add a,HI.spc ; .. add page ld h,a ld (hl),c ld bc,(l12c1) dec bc ld (l12c1),bc ld a,b or c ret nz ld a,-1 ld (l12a5),a ret l0ea4: ex de,hl ld hl,l12b0 rlc (hl) ex de,hl jr c,l0ec6 call UNCR.fgetc ; Get code ld d,a call UNCR.fgetc ld (l12c3),a srl d rra srl d rra srl d rra srl d rra ld e,a jr l0ed0 l0ec6: call UNCR.fgetc ; Get byte ld e,a ld a,(l12c3) and LoMask ld d,a l0ed0: ld a,d or e add a,-1 ccf ret l0ed6: ld hl,U??spc1-1 ld (l12c1),hl call l0eec xor a l0ee0: push af ld hl,-1 call l0e5d pop af inc a jr nz,l0ee0 ret l0eec: ld hl,(UNC.base) ld d,h ld e,l inc de ld a,MSB ld bc,U??spc1 ld (hl),a ; Set area ldir ld (hl),0 ld bc,U??spc5 ldir ; .. clear ld a,NoMSB ld hl,(UNC.base) ld (hl),a ; Init start ret l0f08: push bc push de push hl ld a,l add a,65h ;;; ???? ld l,a jr nc,l0f1e inc h ld a,(UNC.base+1) add a,HI.spc ; .. add page cp h jr nz,l0f1e ld a,(UNC.base+1) ld h,a l0f1e: ld a,(UNC.base+1) add a,HI.spc-1 sub h ld b,a ld a,l cpl inc a jr nz,l0f2b inc b l0f2b: ld c,a ld d,h ld e,l ld a,MSB cpir jr z,l0f46 ld hl,(UNC.base) ld a,(UNC.base+1) ld b,a ld a,d sub b ld b,a ld c,e ld a,MSB cpir jp nz,UNCR.HeadErr ; .. not found l0f46: dec hl ex de,hl pop hl ld a,h add a,HI.sum ; Add amount ld h,a ld (hl),d ld a,h add a,HI.spc ; .. add page ld h,a ld (hl),e ex de,hl pop de pop bc ret l0f57: ld de,0 ld b,d ld c,a add hl,bc set 3,h sra h rr l ld c,h ld a,l adc hl,de jr c,l0f78 ld b,12 l0f6b: srl c rra jr nc,l0f73 ex de,hl add hl,de ex de,hl l0f73: add hl,hl djnz l0f6b ex de,hl add hl,hl l0f78: rla add hl,hl rla add hl,hl rla add hl,hl rla ld l,h and LoMask ret l0f83: cp ' ' jp c,UNCR.RevErr ; .. revision error call l1115 ld de,-1 l0f8e: ld (l12a6),de call l10aa jp c,l0fd7 push de call l1007 ld hl,l12a8 srl (hl) jr c,l0fac ld hl,(l12a6) ld a,(l12b3) call l1068 l0fac: pop de ld a,(l12a5) or a jr z,l0f8e cp U??end jr nz,l0fbd inc a ld (l12a5),a jr l0f8e l0fbd: ld (l12a6),de call l10aa jp c,l0fd7 push de call l1007 ld hl,(l12a6) ld a,(l12b3) call l119a pop de jr l0fbd l0fd7: ld a,e cp 0 jr z,l1003 cp 1 jp nz,UNCR.HeadErr ; .. should be ld hl,0 ld (l12a9),hl xor a ld (l12a5),a call l1115 ld a,9 ld (l12ac),a ld a,2 ld (l12ad),a ld de,-1 ld a,1 ld (l12a8),a jp l0f8e l1003: xor a jp UNCR.end ; .. that's all l1007: push de ex de,hl ld a,(UNC.base+1) add a,h ld h,a set 5,(hl) pop de l1011: push hl ld hl,(UNC.top) add hl,sp jp nc,UNCR.Ovfl ; .. data exhausted ld a,(UNC.base+1) add a,d ld h,a ld l,e ld a,(hl) and 0dfh cp MSB jr nz,l1045 ld a,1 ld (l12a8),a push hl ld hl,(l12a6) ld a,' ' ld (l12b8),a ld a,(l12b3) call l1068 xor a ld (l12b8),a pop hl ld a,(hl) cp 80h jp z,UNCR.DatErr l1045: ld d,(hl) ld a,h add a,HI.spc ; .. add page ld h,a ld e,(hl) bit 7,d jr nz,l105e res 5,d call l1011 ld a,h add a,HI.spc ; .. add page ld h,a ld a,(hl) l1059: call l10dc pop hl ret l105e: ld a,h add a,HI.spc ; .. add page ld h,a ld a,(hl) ld (l12b3),a jr l1059 l1068: push af push hl call l1164 pop de ld hl,(l12a9) ld a,(UNC.base+1) add a,h ld h,a ld a,(l12b8) or d ld (hl),a ld a,h add a,HI.spc ; .. add page ld h,a ld (hl),e ld a,h add a,HI.spc ; .. add page ld h,a pop af ld (hl),a ld hl,(l12a9) inc hl ld (l12a9),hl inc hl ld a,(l12ad) cp h ret nz sla a ld (l12ad),a ld a,(l12ac) inc a cp 13 jr z,l10a4 ld (l12ac),a ret l10a4: ld a,U??end ld (l12a5),a ret l10aa: ld de,0 ld a,(l12ac) ld b,a ld a,(l12ab) ld c,a l10b5: sla c call z,l10d5 rl e rl d djnz l10b5 ld a,c ld (l12ab),a ld a,d dec a and a ret nz ld a,e cp 4 ret nc cp 2 jr z,l10aa cp 3 jr z,l10aa ret l10d5: call UNCR.fgetc ; Get byte scf rla ld c,a ret l10dc: ld bc,(l12ae) srl b jr c,l10f7 cp U??sync jr z,l10f1 ld c,a ld (l12ae),bc call UNCR.fputc ; Print character ret l10f1: inc b ld (l12ae),bc ret l10f7: or a jr z,l110b dec a ld b,a xor a ld (l12af),a ld a,c ld (l12ae),a ld a,c l1105: call UNCR.fputc ; Print djnz l1105 ret l110b: ld a,U??sync ld (l12ae),bc call UNCR.fputc ; Print ret l1115: call l113d ld a,' ' ld (l12b8),a xor a ld hl,-1 l1121: push hl push af call l1068 pop af pop hl inc a jr nz,l1121 ld b,4 l112d: push bc ld hl,07fffh xor a call l1068 pop bc djnz l112d xor a ld (l12b8),a ret l113d: ld hl,(UNC.base) ld d,h ld e,l inc de ld bc,U??spc1 ld (hl),MSB ldir ; .. init area ld (hl),0 ld bc,U??spc3 ldir ; .. clear ld hl,(UNC.dat) ld d,h ld e,l inc de ld bc,U??spc4 ld (hl),MSB ldir ; .. init ld hl,(UNC.dat) ld (hl),NoMSB ret l1164: ld b,a call l11e4 l1168: ld c,h ld a,(hl) cp MSB jr z,l1173 call l1188 jr l1168 l1173: ld de,(l12a9) ld (hl),d ld a,h add a,HIGH U??spc2 ld h,a ld (hl),e ld a,(UNC.dat+1) ld h,a ld a,c sub h ld h,a ld (l12b4),hl ret l1188: ld de,(l12b9) add hl,de ld a,(UNC.dat+1) ld d,a ld a,h cp d jr nc,l1199 ld de,l138b add hl,de l1199: ret l119a: ld b,a ld a,-1 ld (l12b7),a ld a,b call l11e4 l11a4: ld c,h ld a,(hl) cp MSB jr z,l11ca ld a,(l12b7) cp -1 jr nz,l11c5 push hl ld d,(hl) ld a,h add a,HIGH U??spc2 ld h,a ld l,(hl) ld a,(UNC.base+1) add a,d ld h,a bit 5,(hl) jr nz,l11c4 ld (l12b6),hl l11c4: pop hl l11c5: call l1188 jr l11a4 l11ca: ld hl,(l12b6) ld a,h cp -1 ret z ld de,(l12a6) ld a,(l12b3) ld b,a ld (hl),d ld a,h add a,HI.spc ; .. add page ld h,a ld (hl),e ld a,h add a,HI.spc ; .. add page ld h,a ld (hl),b l11e4: ld e,l add hl,hl add hl,hl add hl,hl add hl,hl xor h ld l,a ld a,e and LoMask ld h,a ld a,(UNC.dat+1) add a,h ld h,a inc hl push hl ld de,(UNC.gap) add hl,de ld (l12b9),hl pop hl ret ; ; Get character from file ; EXIT Accu holds character ; UNCR.fgetc: push bc push de push hl call .fgetc ; .. get pop hl pop de pop bc ret ; ; Put character to device ; ENTRY Accu holds character ; UNCR.fputc: push af push bc push de push hl call fputc ; .. put pop hl pop de pop bc pop af ret ; ; Init data field ; IniUNCR: ld hl,l1222 ld de,l12a5 ld bc,DatLen ldir ret l1222: db 0 dw -1 db 1 dw 0 db 128 db 9 db 2 db 0 db 0 db 'U' DatLen equ $-l1222 ; RecCnt: ds 2 Rows: db 0 ListEna: db FALSE ListIO: db FALSE Wheel: db 0 CCPptr: ds 2 User: ds 1 DiskBuff: ds 2 ; Page boundary start of data MemPtr: ds 2 ; Next free data FCB: ds FCBlen L.FCB: db 0,' ' ds FCBlen-2 ; ds 2*64 LocStk: ; USQ.SavStk: ds 2 USQ.base: ds 2 ; ; -------------- Initialized data ------------------------- ; l12a5: db 0 ; 0 l12a6: dw 0 ; -1 l12a8: db 0 ; 1 l12a9: dw 0 ; 0 l12ab: db 0 ; 128 l12ac: db 0 ; 9 l12ad: db 0 ; 2 l12ae: db 0 ; 0 l12af: db 0 ; 0 l12b0: db 0 ; 'U' ; ; --------------------------------------------------------- ; UNC.stk: ds 2 l12b3: db 0 l12b4: ds 2 l12b6: db 0 l12b7: db 0 l12b8: db 0 l12b9: ds 2 UNC.base: ds 2 UNC.dat: ds 2 UNC.gap: ds 2 l12c1: ds 2 l12c3: db 0 UNC.top: ds 2 TOP:: l138b equ TOP+197 ; ; ===== >>>>> DYNAMIC STORAGE <<<<< ===== ; ; Following code will be *OVERWRITTEN* ; ; ################ ; ## COLD START ## ; ################ ; TYPELZ: sub a ; Test right CPU ld de,$ILL.CPU jp pe,Str8080 ; Give sorry, and break ld sp,LocStk call GetVer cp CPM3 ; Test right CP/M ld de,$ILL.OS jp c,HALT ; .. should be ld a,$$Row call GetSCB ; Get row count ld (@ROWS),a ; .. save ld hl,TOP ; Get top ld de,Page-1 add hl,de ld l,0 ; Get next page boundary ld (DiskBuff),hl ; .. save ld a,h add a,BufSpc / Page ; Get buffer pages ld h,a ld (MemPtr),hl ; .. save ld de,MaxData add hl,de ; Get top ld a,(BDOS+2) sub h ; Test enough room ld de,$MEM.ERR ; .. tell error jp c,ExStr ; .. and break ld hl,CCP ld a,(hl) ; Get length of command or a call nz,GetOption ; .. get any option xor a ld (@CRTLINE),a ; .. clear lines ld de,$HEAD call Write ; Give header call GetUsr ; Get user ld (User),a ld hl,CCP ld b,0 ld c,(hl) ; Get length of line ld a,c or a ; Test any jr z,Help ; .. nope ld hl,CCP+1 ; Init pointer push hl add hl,bc ; Point to end ld (hl),' ' ; .. clear last entry pop hl ld b,c call SkipBlank ; Skip blanks jr z,Help ; .. give help if only blanks ld (CCPptr),hl ; Save start pointer call SkipItem ; Fix for non blank jr nz,l029c call SkipBlank ; Test blank ld de,L.FCB call nz,Parse ; Get LIBRARY if more l029c: ld hl,(CCPptr) dec hl ; Fix pointer ld (CCPptr),hl ld a,':' inc hl inc hl cp (hl) ; Test drive delimiter jr z,GetDrv ; .. got it inc hl cp (hl) ; .. again jr z,UsrGet inc hl cp (hl) jr nz,l02fe ld (CCPptr),hl dec hl dec hl ld a,'1' cp (hl) ; Verify range 1..15 jp nz,UsrErr ; .. should be inc hl call GetDigit ; Get ones add a,10 ; Add tens dec hl jr ..SetUsr UsrGet: ld (CCPptr),hl ; Save pointer dec hl call GetDigit ; Get user ..SetUsr: call SetUsr ; Set user jr l02e7 Help: ld de,$HELP call String ; Give help jp HALT ; ; Fetch drive and parse file - then start typing ; DrvErr: ld de,$DRV.ERR call WriteLN ; Tell drive error jp HALT GetDrv: ld (CCPptr),hl ; Save pointer l02e7: dec hl ; Fix pointer ld a,(hl) ; Get character call UPcase sub 'A' ; Convert drive jr c,DrvErr ; .. inavlid inc a ; Fix drive ld (FCB),a ; .. set it l02fe: ld hl,(CCPptr) inc hl ld de,FCB call Parse ; Parse file jp DO.LZ ; .. start ; ; Leave program after less memory ; ExStr: call WriteLN ; Give message jp OS ; Leave ; ; Print string on console ; ENTRY Reg DE points to string ; Str8080: ld c,.string call BDOS ret ; ; Get value from system control block ; ENTRY Accu holds offset ; EXIT Accu holds byte value ; Reg HL holds word value ; GetSCB: ld de,SCBpb ld (de),a ; Set offset ld c,.SCB call BDOS ; .. get it ret ; ; Decode options ; GetOption: inc hl ld a,(hl) ; Find end of command or a jr nz,GetOption dec hl ; .. get back three palces dec hl dec hl ld a,(hl) cp ' ' ; Test blank ret nz ; .. nope inc hl ld a,(hl) ; Test prefix cp '$' jr z,l01f4 cp '/' ; .. or alternative ret nz l01f4: inc hl ld a,(hl) ; Get option cp 'N' ; Test N.o page break jr z,l020f cp 'L' ; Test L.ist ret nz ; .. nope ld a,TRUE ld (ListEna),a ; Set flag ld a,(@WHEEL) ; Unpack wheel ld (Wheel),a l020f: xor a ld (hl),a ; Clear option entries dec hl ld (hl),a dec hl ld (hl),a ld (@ROWS),a ; Clear rows ld a,(CCP) sub 3 ; .. fix length of command ld (CCP),a ret ; ; Skip blank characters ; ENTRY Reg HL points to line ; EXIT Reg HL points to non-blank ; Zero set if blanks only ; SkipBlank: ld a,' ' l03a3: cp (hl) ret nz inc hl djnz l03a3 ret ; ; Skip non blank characters ; ENTRY Reg HL points to line ; EXIT Reg HL points to blank ; EXIT Zero set if blank ; SkipItem: ld a,' ' l03ab: cp (hl) ret z inc hl djnz l03ab or a ret ; ; Parse file name ; ENTRY Reg HL points to command line ; Reg DE points to FCB ; Parse: ld (PPB),hl ; Save entries ld (PPB+2),de ld de,PPB ld c,.parse call .BDOS ld a,h and l inc a ; Test error ret nz ld de,$NAM.ERR call WriteLN ; Tell invalid file name jp HALT ; ; Get user area digit ; ENTRY Reg HL points to digit ; EXIT Accu holds binary ; GetDigit: ld a,(hl) ; Get digit sub '0' ; .. strip off ASCII jr c,UsrErr ; .. error cp 9+1 ; Check range ret c UsrErr: ld de,$USR.ERR call WriteLN ; Tell user error jp HALT ; ; Get UPPER case of character ; ENTRY Accu holds character in any case ; EXIT Accu holds character in UPPER case ; UPcase: cp 'a' ; Test range ret c cp 'z'+1 ret nc sub 'a'-'A' ; .. convert ret ; SCBpb: db 0,0 $HEAD: db lf,' ' $$Prg db ' ' $$Vers db ' ',eot $ILL.CPU: db lf,'Program requires Z-80.',eot $ILL.OS: db lf,'Program requires CP/M 3.x.',eot $MEM.ERR: db lf,'Not enough memory.',eot $HELP: db cr,lf,lf db ' Usage: ' $$Prg db ' [D [U]:] [ ] ' db ' [/O]',cr,lf db ' [/O] is optional /N for no ' db 'page breaks.' db cr,lf db ' or optional /L ' db 'for printer output.',eot $DRV.ERR: db lf,'Invalid drive specification.',eot $NAM.ERR: db lf,'Invalid filename.',eot $USR.ERR: db lf,'Invalid user code.',eot D.TOP:: end TYPELZ