;************************************************************************ ;* * ;* UNCRunch LZH v1.1 * ;* 04 Sept 1989 * ;* - Roger Warren * ;************************************************************************ ; ; With the kind permission of Mr. Steven Greenberg, author of ; UNCR, this program was generated from his UNCRunch v2.4 code ; dated 15 Sept 1987. Accordingly, the following notifications ; are in order: ; ; Copyright (c) R. Warren 09/04/89 ; Portions Copyright (c) S. Greenberg 09/15/87 ; May be reproduced for non-profit use only ; .Z80 .SALL TITLE 'UNCRrunch LHZ v1.1 04 Sep 1989' EXTRN UNCR1,PARSEU,USQREL,UNLZH ENTRY GETBYT,OUT,PLZHUN,GLZHUN CSEG ;============================================================================== ; MEMPAG EQU 2300H ; <=== set! [see comment near end of program] ; ;============================================================================== ;.............................................................................. ;UNCRLZH HISTORY: ; v1.1 Official first release. No functional changes from Beta version. ; Added user configurable character to use on wild card extension expansion ; and stepped version for differentiation. ; v1.0 Beta test version ; ;UNCR HISTORY: ; v2.4 Update Note: As explained in the CRUNCH24 general release LBR, ; v2.4 will generate identical files (except embedded revision level ; byte) to CRUNCH v2.3. The great majority of the changes are user ; interface related, and are described in the CRUNCH24 documentation ; files. Some changes were made in the implementation of the "core" of ; the algorithms for both CRUNCH and UNCRunch- in the case of CRUNCH, ; conditionals were removed by splitting into three separate loops. In ; the case of UNCRunch, an unnecessary chase to the end of "virtual ; links" was eliminated by aborting the search as soon as an available ; reassignment slot is found. Other performance improving changes in ; clude less time updating the screen and dynamic I/O buffer sizing. ; Non-time-critical "user-interface" changes (eg the "tag mode" code, ; etc.) were coded in as straightforward a manner as possible, with ; little regard to code space minimization and even less to speed. ; ; While some documentation of the code has been cleaned up in the sev ; eral month interim between the CRUNCH24.LBR release and the release of ; this source code, I have been very careful to avoid any temptation to ; change any of the code itself, thus insuring that this source code can ; be used to create the identical COM files included in the v2.4 release ; of CRUNCH. ;.............................................................................. FALSE EQU 0 TRUE EQU NOT FALSE CRUNCH EQU FALSE ; True for crunch, false for uncr (for common) REV EQU 24H ; Program revision level SIGREV EQU 20H ; "significant" revision level (compatibility) LREV EQU 11H ; Program revision level (LZH) LSIGREV EQU 10H ; "significant" revision level (LZH compatibility) VREV EQU 11H ; VERSION Revision NOPRED EQU 0FFFFH ; "no predecessor" IMPRED EQU 07FFFH ; Pred that can't be matched or bumped SCRUPT1 EQU 01H ; Screen update speeds SCRUPT2 EQU 07H ; ; --- reserved codes --- EOFCOD EQU 100H ; Eof code RSTCOD EQU 101H ; Adaptive reset code NULCOD EQU 102H ; Null code SPRCOD EQU 103H ; Spare code ;--- Ascii equates --- ; CTRLC EQU 03H ; ^c BELL EQU 07H ; Beep BS EQU 08H ; Backspace LF EQU 0AH ; Linefeed CR EQU 0DH ; Carriage return ;--- CP/M address equates --- ; DFCB EQU 5CH ; Default fcb #1 DFCB2 EQU 6CH ; Default fcb #2 DDMA EQU 80H ; Default dma address BDOS EQU 0005H ; Bdos entrypoint ;--- BDOS function equates --- ; CONIN EQU 1 ; Input a character from the console CONOUT EQU 2 ; Output single char to console PRTSTR EQU 9 ; Print string to console CONST EQU 11 ; Get console status GETVER EQU 12 ; Get cp/m version# SELDSK EQU 14 ; Select disk OPEN EQU 15 ; Open file CLOSE EQU 16 ; Close file SFIRST EQU 17 ; Search for first file SNEXT EQU 18 ; Search for next file ERASE EQU 19 ; Erase file READ EQU 20 ; Read file (sequential) WRITE EQU 21 ; Write file (sequential) MAKE EQU 22 ; Make file GETDSK EQU 25 ; Get currently logged drive SETDMA EQU 26 ; Set dma address GSUSER EQU 32 ; Get/set user code RSTDRV EQU 37 ; Reset drive SETMS EQU 44 ; Set multi-sector count (cp/m+ only) ;______________________________________________________________________________ ; ; Macros to facilitate "horizontal" movement through the table. ; See "Table structure" comment near "initbl" for more information. ; RIGHT1 MACRO LD A,H ; } ADD A,10H ; } move "right" one column (same row) LD H,A ; } ENDM ;============================================================================== ; START: JP STRT ; <--- entry ; ;============================================================================== DB 'Z3ENV',01H ; Zcpr3 environment descriptor Z3ED: DB 00H,00H ; ---------------------------------------------- Z3FLG: DB 0 ; Zcpr flag SPFLG: DB 0 ; Spare flag (archive mode for crunch) INSREV: DB 23H ; Program rev for install program reference QUIFL: DB 0 ; Quiet mode flag NPROFL: DB 0 ; No prompt before overwrite flag TRBOFL: DB 0 ; Defeat multi-sector i/o flag CNFRFL: DB 0 ; Confirm every file flag WRMFLG: DB 0 ; Warm boot flag BIGFLG: DB 0 ; Override larger file question flag MAXDRV: DB 0FFH ; Max drive MAXUSR: DB 0FFH ; Max user SPARFL: DB 0 ; Spare flag or value EXTBL: DB 0,0,0,0,0,0 ; Room for the "exclusion list". used in DB 0,0,0,0,0,0 ; - crunch, but want compatible overlays. DB 0,0,0,0,0,0 ; (enough for 10 3-letter filname extensions) DB 0,0,0,0,0,0 ; DB 0,0,0,0,0,0 ; DB 0 ; Termination zero WILDEF: DB 'Y' ; Default character for substitution in ; extension when .* is used (If 'Y', then ; use .?Y?) ;-=*=-=*=-=*==*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=- CPYRT: DB CR,LF,LF DB 'UNCRLZH v1.1 Copyright (c) R. Warren 09/04/89',CR,LF DB ' Portions Copyright (c) S. Greenberg 09/15/87',CR,LF DB 'May be used/reproduced for non-profit use only$ 619-270-3148' ;-=*=-=*=-=*==*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=-=*=- STRT: SUB A ; Z-80 test [RAF] JP PO,Z80 ; LD DE,WRNGUP ; "program requires z-80 processor" JP MESS80 ; No frills exit w/ message Z80: LD (OLDSTK),SP ; Save os's stack LD SP,TOPSTK ; Set local stack CALL STRTUP ; Does a lot of stuff ;============================================================================== ; ; ***** Re-enter here for each matching file ***** ; ; General wildcard operation: When the program is first invoked, all ; matching filenames are put end to end in FNBUFF, 12 bytes apeice, in ; alphabetical order. Since a filename is only 11 characters long the ; spare byte, which precedes each filename, is used as a "tag/flag". By ; the time file processing starts (now), a number of routines have already ; run (parts of the STRTUP routine). These routines set the tag-flag ; which indicates to us now in what manner the file should be processed: ; "00" = "skip it", "01" = process it", "02" = "perform a direct copy (if ; possible)", "FF" = "no more files". ; NXTFIL: LD SP,TOPSTK ; 'just in case' LD A,0 ; Clear LD (LZHFLG),A ; LZH flag LD A,(QUIFM) ; conditional CR/LF depending on "quiet mode" OR A ; CALL Z,CRLF ; LD DE,INFCB ; Input file fcb CALL CLRFCB ; Init it to blanks and zeroes INC DE ; Leave "DE" pointing at infcb+1 for below LD HL,(BUFPTR) ; Pntr to name of next file from expansion bfr NXTSEL: LD A,(HL) ; OR A ; If zero, the file is "unselected" JR NZ,ISSEL ; Br if it is selected LD BC,12 ; Else just quietly skip to the next file ADD HL,BC ; LD (BUFPTR),HL ; JR NXTSEL ; ;................................ ; ISSEL: CP 0FFH ; An "FF" means done JP Z,RETCCP ; Br if that is the case PUSH AF ; Save stat (to see if file is "excluded" blw) PUSH DE ; LD DE,DASHES ; "-----" for visual separation CALL MESAG2 ; POP DE ; INC HL ; Skip to 1st filename char LD BC,11 ; Filename character count LDIR ; Put next file name into input fcb LD (BUFPTR),HL ; Save new pointer for next file CALL INTRAM ; Initialize all ram LD A,80H ; (init'd by "INTRAM", but must be init'd LD (CSAVE),A ; - differently for crunch & uncrunch) POP AF ; Get file's status byte back again CP 02H ; 02 if file matched the "exclusion" list JR NZ,COPNIN ; If not, definitly attempt to uncompress it LD A,(WLDFLG) ; If so, see if prgm was invoked w/ wildcards OR A ; JP NZ,COPY9 ; If so, do not uncompress; do a straight copy ;.............................................................................. ; ; Now open the input file. A failure here is unusual, since the file existed ; at the time the filename expansion took place. There are "normal" series of ; events which could lead up to this, however. COPNIN: CALL OPNIN ; Attempt to open the next input file "INFCB" JR NC,OPOK ; Br if ok LD DE,ERR1 ; "input file not found" JP SKIP1 ; Skip to next file ;.............................................................................. ; ; If we got here, the input file is open. The output file is not ; OPOK: LD DE,OUTFCB ; Now for the output fcb CALL CLRFCB ; Clear it INC DE ; Leave "DE" pointing at filename area LD A,' ' ; For proper alignment CALL TYPE ; LD HL,INFCB ; Print input filename to console CALL PRNFIL ; XOR A ; Init 1st char of date stamp bfr to zero LD (STAMP),A ; (nulls the buffer; zero is the eof char) CALL GETCHR ; Get a char from the input stream JR NC,NTMT ; If carry set on first byte, file is empty LD DE,ERR0 ; "[ file empty ]" JR NCR2 ; Treat same as "Not compressed" NTMT: CP 76H ; Check for crunched file header "76FE" JR NZ,NCRNCH ; Br if not CALL GETCHR ; CP 0FEH ; JR Z,YCRNCH ; CP 0FFH ; Squeezed? JR Z,YESQZ ; Br if so CP 0FDH ; JR Z,YESLZH ; Br if LZH encoded NCRNCH: CALL CLSIN ; Not squeezed or crunched; close input file LD DE,MSG43 ; "[not compressed]" NCR2: CALL MESAG2 ; LD A,(WLDFLG) ; Invoked w/ wildcards? OR A ; JP NZ,COPY9 ; Do straight copy ("copy" chks for diff du) JP NXTFIL ; Else go on to next file ;................................ ; YESLZH: LD (LZHFLG),A ; Flag as LZH ENCODED JR YCRNCH ; Continue YESQZ: LD (SQZFLG),A ; Flag file as squeezed using ff already in a CALL GETCHR ; Get checksum byte #1 LD L,A ; Hold that CALL GETCHR ; Checksum byte #2 LD H,A ; LD (SQCKSM),HL ; Save for later reference YCRNCH: LD DE,OUTFCB+1 ; Where output filename will be copied to LD B,12 ; Loop limiter (11 char filename + ".") EATLP: CALL GETCHR ; Get next char OR A ; A zero byte indicates end of filename JR Z,ATEIT ; Br when that is encountered AND 7FH ; Force valid ascii (should be already) CALL UCASE ; Upcase the char- (may be lc if squeezed) CP '.' ; Check for name / ext division char JR Z,ISDOT ; Br when encountered LD (DE),A ; Else copy char to output fcb INC DE ; And incr that pointer DJNZ EATLP ; Continue, but not past end of filename JR IGNORE ; If no 0 detected, ignore following info ;.............................................................................. ; ; When "." is encountered, skip to the file extension bytes of the ; output FCB. Any remaining non-extension bytes were init'd to blank). ; Do not copy the "." to the output FCB. ISDOT: LD DE,OUTFCB+9 ; Skip... LD B,3 ; Update loop limiter counter JR EATLP ; And continue ;................................ ; IGNORE: LD A,(SQZFLG) ; For squeezed files, nothing else to do OR A ; JP NZ,USQZIT ; Go to it IGNRLP: CALL GETCHR ; Loop absorbs extraneous header info JR C,NCRNCH ; Circumvent possible hangup (eof before 0) OR A ; Wait for the terminating zero JR Z,ATEIT ; If terminating zero is reached CP '[' ; Else check for date stamp bof char JR NZ,IGNRLP ; Other chars are extraneous at this point ;................................ ; LD DE,STAMP ; Start copying file stamp info to this buffer JR ENTSLP ; ; STMPLP: CALL GETCHR ; Get a char JR C,NCRNCH ; Circumvent hangup ENTSLP: LD (DE),A ; Put char in dest INC DE ; Incr dest pntr OR A ; JR NZ,STMPLP ; Loop till zero is reached ;................................ ATEIT: LD A,(LZHFLG) ; Get LZH flag OR A ; Test JP NZ,ATEITL ; There if LZH ; CALL GETCHR ; Get revision level, do nothing with it CALL GETCHR ; Get significant revision level CP SIGREV ; Compare to this prog JP C,OLDTYP ; Br if old type1x crunched file JR Z,SIGOK ; If equal, ok, else... LD DE,ERR5 ; "can't uncrunch that file. newer revision of JP SKIP2 ; - this program needed" or some such remark SIGOK: CALL GETCHR ; Get checksum flag LD (CKSMFL),A ; Put it there CALL GETCHR ; Get spare byte, do nothing with it CALL OPNOUT ; Open output file & type "---> " PUSH AF ; Save stat from above CALL PRNID ; Type any embedded date stamp info also POP AF ; JP C,SKIP2A ; If user wants to skip it ;.............................................................................. ; ; Now both files are open. Eventually either both will be closed, or the ; input file will be closed and the output deleted. LD A,(QUIFM) ; Skip column headings if in quiet mode OR A ; JR NZ,QUIET1 ; LD DE,HEADNG ; Type all the "in / out ca cr" stuff CALL MESAGE ; QUIET1: CALL INITB2 ; Initialize the lzw table LD DE,NOPRED ; Init to "NOPRED" (null value) PAGE ;============================================================================== ; ; *** Main Decoding loop(s). *** ; MAINLP: LD (LASTPR),DE ; Always keep a copy of the last "pred" here CALL GETCOD ; Get bits to form a a new code in "DE" JP C,DUN ; Br if eof node or physical end-of-file PUSH DE ; Push a copy of the new pred CALL DECODE ; Decode new pred LD HL,ENTFLG ; Flag is "01" if "decode" made the entry SRL (HL) ; Check (and zero) the flag JR C,NOENTR ; Don't make the same entry twice! LD HL,(LASTPR) ; Get old pred LD A,(CHAR) ; And suffix char generated from the new pred CALL ENTERX ; Make new table entry from those two NOENTR: POP DE ; Get newest pred again (not that new anymore) LD A,(FULFLG) ; Monitor the table full flag OR A ; JR Z,MAINLP ; Continue decoding & entering 'till full ;................................ ; CP 0FEH ; When this becomes "FF", we are done JR NZ,FASTLP ; First it will become "FE", though. in that INC A ; - case perf 1 more loop & change it to "FF" LD (FULFLG),A ; JR MAINLP ; One more! ;.............................................................................. ; FASTLP: LD (LASTPR),DE ; Table full loop similar to above ,except CALL GETCOD ; - don't bother checking table full flag JP C,DUN ; - call "ENTFIL", not "ENTERX" (for possible PUSH DE ; - code reassignment CALL DECODE ; Call to actually decode chars LD HL,(LASTPR) ; Get old pred LD A,(CHAR) ; And suffix char generated from the new pred CALL ENTFIL ; Possibly make new table entry from those two POP DE ; JR FASTLP ; Continue in code reassignment mode ; ; *** End of Main Processing Loop(s) ;______________________________________________________________________________ ; Come here when one of the special codes is encountered (we may not ; really be "dun"). Actually, a null code should have been intercepted ; by the get12 routine, leaving only EOF (actually done) or adaptive ; reset. DUN: LD A,E ; Some kind of special code encountered CP LOW(EOFCOD) ; Actually done? JR Z,DUNDUN ; Br if do CP LOW(RSTCOD) ; Else better be reset (null was intercepted) JP NZ,FATBAD ; File is invalid ;.............................................................................. ; --- perf an adaptive reset --- LD HL,0000 ; Reset entry# prior to table re-initialization LD (ENTRY),HL ; LD (TTOTAL),HL ; Reset "codes reassigned" XOR A ; LD (FULFLG),A ; Reset "table full" flag CALL INITB2 ; Reset the entire table LD A,9 ; Reset the code length to "9" LD (CODLEN),A ; LD A,02H ; Reset the target mask value accordingly LD (TRGMSK),A ; LD DE,NOPRED ; Set pred to "nopred" LD A,1 ; 1st entry is always a special case LD (ENTFLG),A ; (trick it to make no table entry) JP MAINLP ; And continue where we left off ;______________________________________________________________________________ ; DUNDUN: ; --- actually done, close things up --- CALL GETCHR ; Get the checksum, always next LD E,A ; CALL GETCHR ; Get checksum (hi-byte) LD D,A ; Checksum (from input file) now in "DE" LD A,(CKSMFL) ; Checksum override flag (not currently used) AND A ; Check flag, also clear carry for below JR NZ,CHKSOK ; If flag > 0, don't check checksum DUNDUQ: LD HL,(CHKSUM) ; Checksum (as computed) SBC HL,DE ; Else check by subtraction JR Z,CHKSOK ; Br if match LD DE,BADCHK ; Bad checksum, issue warning CALL MESAGE ; ;................................ ; CHKSOK: CALL DONE ; Write out remaining output buffer CLOSE2: CALL CLSOUT ; Close output file CALL CLSIN ; Close input file JR NEXT ; ;------------------------------------------------------------------------------ ; COPY9: CALL COPY ; Perform a straight copy JP C,NXTFIL ; If copy didn't take place, don't count it NEXT: LD HL,NFP ; If we got here, the file has been "processed" INC (HL) ; So incr the "files processed" counter JP NXTFIL ; Go start next file ;______________________________________________________________________________ ;................................ ; Entry if neither in nor output files open yet SKIP1: CALL MESAGE ; SKIP1A: JP NXTFIL ; (entry here if no error text desired) ;................................ ; Entry here if input file open only SKIP2: CALL MESAGE ; SKIP2A: CALL CLSIN ; (entry here for no message) JP NXTFIL ; ;................................ ; Entry here if in & output files to be closed SKIP3: CALL MESAGE ; SKIP3A: CALL CLSOUT ; (rest is same as above) CALL CLSIN ; JP NXTFIL ; ;................................ ; Entry here to erase output & close input file SKIP4: CALL MESAGE ; SKIP4A: CALL CLSOUT ; (entry here for no message) LD DE,OUTFCB ; Erase ouptut file, already started LD C,ERASE ; CALL BDOSAV ; CALL CLSIN ; Close input file as well JP NXTFIL ; ;...............................; ;______________________________________________________________________________ ; ; The following routine actually performs the decoding. The top sec- ; tion, "DECODE", flags the entry as "referenced". It then calls the ; recursive section below it, "DECODR", to do the actual work. DECODE: PUSH DE ; Save code. the code provides us an immediate EX DE,HL ; - index into the main logical table LD A,H ; (add offset to beg of table, of course) ADD A,TABLHI ; LD H,A ; SET 5,(HL) ; Set bit 5 of pred (hi) to flag entry as POP DE ; - "referenced" (ie not bumpable) ;.............................................................................. ; DECODR EQU $ ; Decode and output the index supplied in "DE" LD IY,STKLIM ; Stack overflow check as a safety precaution ADD IY,SP ; (limit allows extra for this invocation lvl) JP NC,STKOVF ; Br on overflow (shouldn't happen) PUSH HL ; Only "HL" need be saved LD A,D ; Convert index in "DE" to address in "HL" ADD A,TABLHI ; LD H,A ; LD L,E ; Address now in "HL" LD A,(HL) ; Make sure the entry exists AND 0DFH ; < CP 80H ; (value for a vacant entry) JR NZ,OK1 ; Br if so (normal case) ;................................ ; LD A,01H ; The "ugly" exception, wswsw LD (ENTFLG),A ; Set flag so entry isn't made twice PUSH HL ; Save current stuff. LD HL,(LASTPR) ; Get the last pred.. LD A,20H ; (setting this flag will flag the entry as LD (FFFLAG),A ; - referenced,) LD A,(CHAR) ; Get the last char CALL ENTERX ; Make an on the fly entry... XOR A ; LD (FFFLAG),A ; Put this back to normal POP HL ; And presto... ; LD A,(HL) ; It had better exist now! CP 80H ; JR Z,FATBAD ; *** else file is fatally invalid *** ;................................ OK1: LD D,(HL) ; Normal code- get "pred" (hi) RIGHT1 ; Move to "pred" (lo) LD E,(HL) ; Get that. if msb of hi byte is set, val must BIT 7,D ; - be "FF" (nopred) because it isn't "80H" JR NZ,TERM ; If so, branch. this terminates recursion. RES 5,D ; Else clear flag bit & decode pred we found CALL DECODR ; Decode and output the "pred" (recursive call) RIGHT1 ; Move pointer ahead to the "suffix" byte LD A,(HL) ; Get it SAMABV: CALL SEND ; Output the "suffix" byte POP HL ; Restore reg and return RET ; TERM: RIGHT1 ; Move pointer ahead to the suffix byte LD A,(HL) ; Get it & save it. it is the 1st char of the LD (CHAR),A ; - decoded string, and will be used later to JR SAMABV ; - attempt to make a new table entry. ; (rest is same as above) ;______________________________________________________________________________ ; FATBAD: LD DE,ERR4 ; "invalid crunched file" CALL MESAGE JP CHKSOK ; Write out whatever we have, then next file ; (stack gets reloaded before next file) ;______________________________________________________________________________ ; ; Enter { , } into the table, as defined in { HL, A } ; ENTERX: PUSH AF ; Save the suffix till we're ready to enter it PUSH HL ; Save pred, xferred to "DE" just below CALL FIGURE ; Puts result in "phyloc" only, affects nothing POP DE ; Put pred in "DE" (pushed as "HL" above) LD HL,(ENTRY) ; Get next avail entry# LD A,H ; Convert that to an address ADD A,TABLHI ; LD H,A ; ; Entries are made here, but not normally flagged as "referenced" until ; the are received by "DECODE". Until they are flagged as referenced, ; they are "bumpable", that is available for code reassignment. If ; "FFFLAG" is set to 20H, however, they will be flagged now. This only ; occurs during initialization (bumping an atomic entry would be most ; unfortunate) and when a WsWsW string encounter initiates an emergency ; entry, despite the code never having been received by "DECODE". LD A,(FFFLAG) ; Normally zero, as described above OR D ; LD (HL),A ; Make the entry- pred (hi) first RIGHT1 ; Move to pred (lo) position LD (HL),E ; Put that in RIGHT1 ; Move to suffix position POP AF ; Retrieve the suffix, saved on entry LD (HL),A ; Stick it in LD HL,(ENTRY) ; Increment the entry# counter INC HL ; LD (ENTRY),HL ; INC HL ; See if a new code length is indicated. the LD A,(TRGMSK) ; - extra inc "HL" above is to account for CP H ; - skew delays of uncruncher vs. cruncher RET NZ ; Normally just return SLA A ; Change to a new code length LD (TRGMSK),A ; This will be the next target mask LD A,(CODLEN) ; Get the old code length, as a #of bits INC A ; Increment it, too CP 13 ; Check for overflow (12 bits is the max) JR Z,FLGFUL ; If so, flag table as full LD (CODLEN),A ; Else this is the new code length RET ; ;................................ ; FLGFUL: LD A,0FEH ; Flag table as full LD (FULFLG),A ; RET ; ;______________________________________________________________________________ ; ; Get the next code by stripping the appropriate #of bits off the input ; stream, based on the current code length "CODLEN". If the code is ; "NULL", don't even return; just get another one. If the code is one ; of the other special codes, return with the carry flag set. "Spare" is ; actually treated like a "null" for the time being, since it's use has ; yet to be defined. ; GETCOD: LD DE,0000 ; Init "shift register" to zero LD A,(CODLEN) ; Get current code length LD B,A ; Will be used as a loop counter LD A,(CSAVE) ; "leftover" bits GETLP: SLA A ; Shift out a bit CALL Z,REF ; Refill when necessary RL E ; Shift in the bit shifted out RL D ; Likewise DJNZ GETLP ; Loop for #of bits needed LD (CSAVE),A ; Save "leftover" bits for next time LD A,D ; If hi-byte = "01", we may have a special code DEC A ; Set z if it was "1" AND A ; Clr carry RET NZ ; Rtn w/ clr carry if byte wasn't "01" ;................................ ; LD A,E ; Else further analysis necessary CP 4 ; Set carry on 100, 101, 102, 103 RET NC ; Else code is normal, rtn with clr carry CP LOW(NULCOD) ; Is it the "NULL" code? JR Z,GETCOD ; If so, just go get another code CP LOW(SPRCOD) ; (treat the unimplemented "spare" like a null) JR Z,GETCOD ; As above SCF ; < rtn w/ carry set indicating special code RET ; (presumably "eof" or "reset") ;______________________________________________________________________________ ; ; Routine to reload "A" with more bits from the input stream. Note ; we pre-shift out the next bit, shifting in a "1" from the left. ; Since the leftmost bit in the reg is a guaranteed "1", testing ; the zero stat of the accumulator later is a necessary and suf- ; ficient condition for determining that all the bits in the accum- ; ulator have been used up. ; ; The only things to be careful of is that the last bit is NOT used ; later, and that the bit now in the carry flag IS used upon return ; from this subroutine. (This is the identical scheme used in ; USQFST. A exact complement to it is incorporated for shifting ; bits out in the CRUNCH program). ; REF: CALL GETCHR ; Get the char JR C,PHYEOF ; Br if unexpected physical eof encountered SCF ; To shift in the "1" from the right RLA ; Do that, shifting out a "real" bit RET ; Rtn (w/ that real bit in the carry flag) ;______________________________________________________________________________ ; PHYEOF: LD SP,TOPSTK ; "emergency exit"- reset stack LD DE,UNXEOF ; "unexpected eof." CALL MESAGE ; JP CHKSOK ; Write out what we have, then continue ;______________________________________________________________________________ ; ; Send character to the output buffer, plus related processing SEND: EXX ; Alt regs used for output processing SRL B ; If reg is "1", repeat flag is set ; (note, clears itself automatically) JR C,REPEAT ; Go perf the repeat CP 90H ; Else see if char is the repeat spec JR Z,SETRPT ; Br if so LD C,A ; Else nothing special- but always keep EXX ; Back to normal regs CALL OUTC ; Else just output the char; RET ; ;.............................................................................. ; ; Set repeat flag; count value will come as the next byte. (Note: don't ; clobber C with the "90H"- it still has the prev character, the one to ; be repeated) ; SETRPT: INC B ; Set flag EXX ; Switch to primary regs & return. RET ;.............................................................................. ; ; Repeat flag was previously set; current byte in a is a count value. ; A zero count is a special case which means send 90H itself. Otherwise ; use B (was the flag) as a counter. The byte itself goes in A. ; REPEAT: OR A ; Check for special case JR Z,SND90H ; Jump if so DEC A ; Compute "count-1" LD B,A ; Juggle registers PUSH BC ; The count and the char LD B,0 ; Zero the count in advance EXX ; POP BC ; AGAIN: LD A,C ; PUSH BC ; CALL OUTC ; Repeat b occurrences of byte in 'c' POP BC ; DJNZ AGAIN ; Leaves b, the rpt flag, 0 as desired RET ;................................ ; SND90H: LD A,90H ; Special case code to send the byte 90h EXX ; CALL OUTC ; RET ; ;______________________________________________________________________________ ; ; Send the char in "A" to the output buffer, & add it to the running checksum ; OUT EQU $ ; OUTC: CALL OUTB ; Output it CALL CKSUM ; Add to the checksum RET ; ;______________________________________________________________________________ ; ; Convert the middle letter of the filename extension to a what is sepcified ; in WILDEF if middle char is '?' AND "difdu" = 0. ; If we are uncrunching to a different DU:, get all files. ; FIXFCB: LD A,(DIFDU) ; OR A ; RET NZ ; If this flag is set, leave ext char untouched LD HL,INFCB+10 ; Point to middle letter of extension LD A,'?' ; CP (HL) ; See if it is ambiguous RET NZ ; If not, we'll allow any letter (rev v1.2) LD A,(WILDEF) ; Get user defined character LD (HL),A ; Else force it to character. this is mainly so RET ; The command line uncr *.* will work well ;______________________________________________________________________________ ; EXCLUD: ; Flag files to be copied, not uncompressed LD BC,12 ; Leave 12 in bc for incrementing ix LD IX,FNBUFF ; Points to beg of filenames OUTLP: LD A,(IX+0) ; Get flag byte for this entry CP 0FFH ; Final [non-] entry? RET Z ; (return if so) OR A ; Is it an untagged filename? JR Z,NXTFN ; If so, leave it that way & move to next LD A,(IX+10) ; Otherwise check middle letter of fn ext CP 'Z' ; JR Z,NXTFN ; If 'z', do not exclude it CP 'Q' ; JR Z,NXTFN ; Likewise 'q', else "exclude" it CP 'Y' ; JR Z,NXTFN ; Likewise 'y', else "exclude" it ; ---------------------------------------------- AUTOM3: LD A,02H ; Flag file as "excluded" LD (IX+0),A ; NXTFN: ADD IX,BC ; Move to next filename in "fnbuff" JR OUTLP ; ;______________________________________________________________________________ ; ; Type the stuff in the "stamp" buffer to the console. ; PRNID: LD DE,SPACE3 ; Precede w/ 3 spaces CALL MESAG2 ; LD HL,STAMP ; Point to that buffer LD B,40 ; Practical limit of 40 char "stamp" PRFILP: LD A,(HL) ; Get a char OR A ; Zero terminates the field RET Z ; Return when encountered CALL TYPE ; Else type the char CP ']' ; This terminates stamp also (after typing it) RET Z ; Return if that happened INC HL ; Else incr pointer DJNZ PRFILP ; And loop RET ; ;______________________________________________________________________________ ; STKOVF: LD DE,ERR6 ; "*** stack overflow ***" LD SP,TOPSTK ; Shouldn't happen, but we're still in control JP FATBAD ; Reset & continue w/ next file, if any ;______________________________________________________________________________ ; ; Initialize the table to contain the 256 "atomic" entries- ; { "NOPRED", }, for all values of from 0 thru 255 INITB2: CALL PRESE2 ; "pre-initializes" the table (mostly zeroes) LD A,20H ; LD (FFFLAG),A ; < XOR A ; Start with a suffix of zero LD HL,NOPRED ; Pred for all 256 atomic entries INILP: PUSH HL ; < PUSH AF ; < CALL ENTERX ; POP AF ; < POP HL ; < INC A ; Next suffix JR NZ,INILP ; Loop 256 times ;.............................................................................. ; ; Now reserve the four reserved codes 100H - 103H (EOF, RESET, NULL, and ; SPARE. This is easily achieved by inserting values in the table which ; cannot possibly be matched, and insuring that they cannot be reas- ; signed. An occurrence of any of these codes is possible only when the ; cruncher explicitely outputs them for the special cases for which they ; are designated. LD B,4 ; Loop counter for the 4 reserved entries RSRVLP: PUSH BC ; < LD HL,IMPRED ; An "impossible" pred XOR A ; Any old suffix will do CALL ENTERX ; Make the entry POP BC ; < DJNZ RSRVLP ; Loop 4 times XOR A ; Now restore this flag to its normal value LD (FFFLAG),A ; RET ; ;.............................................................................. ; ; Low level table preset called before initialization above. This routine ; presets the main table as follows: (see description of table elsewhere): ; Column 1: 4096 x 80H, Columns 2 and 3: 4096 x 00H ; PRESE2: LD HL,TABLE ; Beg of main table, 4096 rows x 3 columns LD DE,TABLE+1 ; LD BC,1000H ; LD (HL),80H ; LDIR ; Put in 1000h "80H"'s LD (HL),0 ; LD BC,2*1000H-1 ; Note "-1" LDIR ; And 2000h more "00H"'s ;.............................................................................. ; ; The auxiliary physical translation table is 5003 rows, 2 columns ; (logically speaking). Actually 5120 rows, 2 columns are allocated. All ; entries are initialized to 80H. LD HL,XLATBL ; Physical <--> logical xlation table LD DE,XLATBL+1 ; LD BC,2800H ; Total entries = 1400h x 2 LD (HL),80H ; LDIR ; LD A,7FH ; < LD (XLATBL+0),A ; < RET ; ;______________________________________________________________________________ ; ; Figure out what physical location the cruncher put it's entry by ; reproducing the hashing process. Insert the entry# into the correspon- ; ding physical location in XLATBL. FIGURE: LD B,A ; < suffix supplied goes into b CALL HASH ; Get initial hash value into "HL" PHYLP: LD C,H ; C <-- extra copy of h LD A,(HL) ; Check if any entry exists at that location CP 80H ; Value for a vacant spot JR Z,ISMT ; Br if vacant CALL NM ; Else find next in chain JR PHYLP ; And continue ;................................ ; ISMT: LD DE,(ENTRY) ; Get the logical entry# LD (HL),D ; Stick in hi-byte LD A,H ; Move "right1" for this table ADD A,14H ; LD H,A ; LD (HL),E ; Lo-byte goes there RET ; ;................................ ; NM EQU $ ; No match yet... find next "link" in chain LD DE,(DISP) ; Secondary probe- add disp computed by "HASH" ADD HL,DE ; LD A,H ; CP XLATBH ; Check for loop around JR NC,NC9 ; Br if not LD DE,5003 ; Else loop ADD HL,DE ; NC9: RET ; ;______________________________________________________________________________ ; ENTFIL EQU $ ; Try to enter the pred/suffix in hl|a CALL HASH ; Get initial hash value into "HL" ;.............................................................................. ; PHYLP2: LD A,(HL) ; Check if any entry exists at that location CP 80H ; RET Z ; End of chain, return w/o reassignment ;................................ PUSH HL ; Save physical table pointer LD D,(HL) ; Get entry#, hi LD A,H ; } ADD A,14H ; } right 1 for this table LD H,A ; } LD L,(HL) ; Entry#, lo byte LD A,D ADD A,TABLHI ; Convert to an addr in "HL" LD H,A BIT 5,(HL) ; See if entry is bumpable JR Z,MAKIT ; If so bumpable, go do it POP HL ; Else restore physical tbl pointer CALL NM ; Find next "link" in chain JR PHYLP2 ; And continue ;______________________________________________________________________________ ; ; Reassign the entry pointed to by "avail", if any. Re-define the "last ; pred entered" and "last suffix" variables. ; MAKIT: POP DE ; Get rid of extraneous physical pointer LD DE,(TTOTAL) ; Increase user's display count INC DE ; LD (TTOTAL),DE ; LD DE,(LASTPR) ; Get the pred LD A,(CHAR) ; And suffix LD B,A ; Put suffix here, ("right1" kills a) LD (HL),D ; Actually make the entry RIGHT1 ; LD (HL),E ; [pred(lo)] RIGHT1 ; LD (HL),B ; [suffix] RET ; Done ;------------------------------------------------------------------------------ ; ; For additional details about the hashing algorithm, see CRUNCH. ; HASH EQU $ ; LD E,L ; Save so low nybble of pred can be used below ADD HL,HL ; ADD HL,HL ; ADD HL,HL ; ADD HL,HL ; Shift whole pred value left 4 bits XOR H ; Xor hi-byte of that with suffix LD L,A ; Goes there as lo-byte of result LD A,E ; Get pred(lo) saved above AND 0FH ; Want only low nybble of that ADD A,XLATBH ; Convenient time to add in table offset LD H,A ; Goes here as hi-byte of result INC HL ; Except add one. this eliminates poss. of 0. PUSH HL ; Save hash val for return LD DE,-5003-XLATBL ; Compute displacement value, - (5003-hash) ADD HL,DE ; (displacement has table offset removed again) LD (DISP),HL ; Secondary hashing value, a negative number. POP HL ; Get back orig hash address RET ; And return it ;============================================================================== ; LZH stuff ; ATEITL: CALL GETCHR ; Get revision level, do nothing with it CALL GETCHR ; Get significant revision level CP LSIGREV ; Compare to this prog JR Z,SIGOKL ; If equal, ok, else... LD DE,ERR5 ; "can't uncrunch that file. newer revision of JP SKIP2 ; - this program needed" or some such remark SIGOKL: CALL GETCHR ; Get checksum flag LD (CKSMFL),A ; Put it there CALL GETCHR ; Get spare byte, do nothing with it CALL OPNOUT ; Open output file & type "---> " PUSH AF ; Save stat from above CALL PRNID ; Type any embedded date stamp info also POP AF ; JP C,SKIP2A ; If user wants to skip it CALL CRLF ; More aesthetics EXX ; Go back to start of file (already read some) LD HL,IBUF ; EXX ; LD HL,SECNT ; Bugger up the sector count since we just INC (HL) ; - reset the input pointer LD HL,(INCTR) ; [rev 2.1 fix] DEC HL ; Decr "inctr" for same reason LD (INCTR),HL ; LD A,'0' ; [rev 2.1 fix] LD (PROGBF+5),A ; Reset ascii display to zero ;.............................................................................. ; ; Now both files are open. Eventually either both will be closed, or the ; input file will be closed and the output deleted. LD A,(QUIFM) ; Skip column headings if in quiet mode OR A ; JR NZ,QUIETL ; LD DE,HEADNG ; Type all the "in / out ca cr" stuff CALL MESAGE ; QUIETL: LD A,0FFH ; Not zero LD (OLDFLG),A ; Set LD HL,TABLE ; Point to memory area CALL UNLZH ; Go it JP NC,DUNDUN ; No carry is ok CP 4 JP Z,INSUFF ; Insufficient memory JP FATBAD ; Already checked out everything else...do ; bad file ;...............................; ; UNLZH file I/O entry points PLZHUN: JP OUT ; Continue output there GLZHUN: JP GETBYT ; Continue input there ;============================================================================== ; ; For old style (v1.x) type crunched files, simply call the "UNCR1" module. ; Squeezed files are handled identically, except call "USQREL" module. ; All I/O will be done by this program- UNCR1 will get and feed data thru ; calls to entrypoints "GETBYT" and "OUT". ; OLDTYP: CALL GETCHR ; Get checksum flag LD (CKSMFL),A ; Put it there CALL GETCHR ; Get spare byte, do nothing with it *** nec?? USQZIT: LD A,0FFH ; Flag this as an old style uncrunch LD (OLDFLG),A ; (controls type of screen updating) CALL OPNOUT ; Open output file & type "---> " PUSH AF ; Save stat from abv call LD A,(SQZFLG) ; *** necessary? OR A ; CALL Z,PRNID ; Type any embedded date stamp info also POP AF ; Get back carry stat JP C,SKIP2A ; If user wants to skip it CALL CRLF ; More aesthetics EXX ; Go back to start of file (already read some) LD HL,IBUF ; EXX ; FIX21: LD HL,SECNT ; Bugger up the sector count since we just INC (HL) ; - reset the input pointer LD HL,(INCTR) ; [rev 2.1 fix] DEC HL ; Decr "inctr" for same reason LD (INCTR),HL ; LD A,'0' ; [rev 2.1 fix] LD (PROGBF+5),A ; Reset ascii display to zero LD HL,TABLE ; Point to large data area for uncr1 LD A,(SQZFLG) ; OR A ; JR NZ,USESQZ ; If squeezed, call usqrel rather than uncr1 CALL UNCR1 ; Uncrunch the whole thing ABVQ: JP NC,DUNDUN ; A "normal" return JP FATBAD ; Any other error falls under "invalid.." USESQZ: CALL USQREL ; LD DE,(SQCKSM) ; Get checksum read at beginning of file JP NC,DUNDUQ ; Terminate similarly (w/o reading cksm bytes) JP FATBAD ; ;______________________________________________________________________________ ; PRCSTM: LD DE,PRSER1 ; "invalid argument" (no stamps allowed) JP FATALU ; ;______________________________________________________________________________ ; UCASE: CP 'a' ; Upcase char in a RET C ; SUB 20H ; (note "{","|","}",and "~" cannot occur) RET ; ;______________________________________________________________________________ VUNITS EQU (VREV/16)+'0' ; Version, units dig, in ascii VTNTHS EQU (VREV AND 0FH)+'0' ; Version, tenths dig, in ascii INTRO: DB 'LZH Uncruncher v',VUNITS,'.',VTNTHS,CR,LF,'$' BADCHK: DB 'Checksum error detected.',CR,LF,'$' MSG43: DB ' [ Not compressed ]',CR,LF,'$' ERR4: DB 'Invalid Crunched File.',CR,LF,'$' ERR5: DB 'File requires newer program rev.',CR,LF,'$' ERR6: DB 'Stack Overflow.',CR,LF,'$' SPACE3: DB ' $' UNXEOF: DB 'Unexpected EOF.',CR,LF,'$' USAGE: DB CR,LF,'Usage:',CR,LF,LF DB ' Filename (space)',CR,LF DB ' / |',CR,LF DB ' UNCRLZH {du:} {du:} { / }',CR,LF DB ' \ \ \',CR,LF DB ' Source Destination Option letters' DB CR,LF,LF DB ' is up to 3 letters immediately following a " /".',CR,LF DB ' "Q" = Quiet mode "C" = Confirm (tag) mode "O" = Overwrite mode',CR,LF DB ' Option letters toggle (reverse) the corresponding default setup.',CR,LF DB CR,LF DB ' Both "du:" are of form DU:, UD:, D:, or U:',CR,LF DB CR,LF DB ' Everything is optional except filename.',CR,LF,LF,'$' ;______________________________________________________________________________ INCLUDE COMMON.LIB ;______________________________________________________________________________ ; ;Additional misc ram locs which need not be initialized, or are init- ;ialized by the routines which use them. ; LZHFLG: DS 1 ; LZHUF flag CKSMFL: DS 1 ; Skip checksum if flag non-zero CHAR: DS 1 ; Last char of the previously decoded string FFFLAG: DS 1 ; CSAVE: DS 1 ; SQCKSM: DS 2 ; ;................................ STKSZ EQU 8 ; Minimum stack size (pages) IBUFSZ EQU 8 ; Input buffer size (pages) ;============================================================================== ; ; ===> All tables will begin at "MEMPAG", defined at the top of the pro- ; gram. This should be set to a page aligned value (ie address that ends in ; "00") which is ABOVE the end all program and data segments. You may have ; to do one test link to determine the proper value (changing "MEMPAG" will ; not change the length of the segments on the subsequent link). ; ; "MEMPAG" is defined at the beginning of this program to remind you to set ; it properly. If you set it higher than necessary, there will be no negative ; effect other than an increase in the TPA req'd to run the program. If you ; set it too low, you will be in big trouble. The value must be set manually ; because most linkers cannot resolve an "and", "shift", or "hi" byte ; extraction at link time to determine the page boundary. ; ;============================================================================== ; "MAXFLS" is buffer size (in files) for wildcard expansions. Room for ; this many files will be allocated. MAXFLS EQU 256 FNBUFF EQU MEMPAG ; (= beg of wildcard expansion buffer) ENDFNB EQU FNBUFF+(12*MAXFLS) ; End of expansion buffer IBUF EQU ENDFNB ; (= beg of input buffer) EIBUF EQU IBUF+(IBUFSZ*256) ; End of input buffer TABLE EQU EIBUF ; (= beg of table) EOTBL EQU TABLE+(3*1000H) ; End of table XLATBL EQU EOTBL ; EXLATB EQU XLATBL+(2*1400H) ; STAMP EQU EXLATB ; 80h bytes for "stamp" buffer ESTAMP EQU STAMP+80H ; SAFETY EQU ESTAMP ; Safety region- beyond legal bottom of stack BOTSTK EQU SAFETY+80H ; "legal" stack limit TOPSTK EQU EXLATB+(STKSZ*256) ; Top of stack ENDALL EQU TOPSTK ; End of everything, except output buffer OBUF EQU ENDALL ; Beg of dynamically sized output buffer ;.............................................................................. STKLIM EQU 0-BOTSTK ; Negation of "botstk", used as safety check IBUFHI EQU HIGH IBUF ; Input bfr addr, hi byte (lo byte = 0) EIBFHI EQU HIGH EIBUF ; End of input bfr addr, hi byte, likewise TABLHI EQU HIGH TABLE ; Beg of table, hi byte, likewise ETBLHI EQU HIGH EOTBL ; End of table, hi byte, likewise XLATBH EQU HIGH XLATBL ; * EFNBHI EQU HIGH ENDFNB ; End of expansion buffer, likewise ENDHI EQU HIGH ENDALL ; End of everything, likewise OBUFHI EQU HIGH OBUF ; Output bfr addr, hi byte likewise END