home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.barnyard.co.uk
/
2015.02.ftp.barnyard.co.uk.tar
/
ftp.barnyard.co.uk
/
cpm
/
walnut-creek-CDROM
/
ENTERPRS
/
CPM
/
UTILS
/
S
/
SQ-USQ.ARC
/
FU18.DOC
< prev
next >
Wrap
Text File
|
1989-10-07
|
29KB
|
890 lines
;***********************************************************************
;* *
;* Fast Z-80 Unsqueezer *
;* (w/ wildcards) *
;* *
;* Original version and algorithm by Steven Greenberg, 1/10/86 *
;***********************************************************************
ASEG ; (See note concerning ASEG / CSEG
; controversy at end of program where
ORG 100H ; "CODTBL" is defined.
;-----------------------------------------------------------------------
; v1.8 - 03/04/86
; The search-and-optional-erase of the destination file was re-
; moved in favor of a "blind" delete file call. The open-file call
; immediately after the make-file has been eliminated. The TPA
; size check has been changed to take into account that versions
; 1.1+ require the CCP to remain resident. Slightly increased the
; input buffer size for this assembly; prog now req's memory up to
; to an even 9000H. If anyone has memory problems, change the buf-
; fer size equ's at the end ("IBUFSZ","OBUFSZ",or "MAXFLS"). I made
; Sigi's wildcard expansion buffer size settable at assembly time &
; is checked for overflow at run time. - SGG
;
; v1.7 - 03/01/86
; Found a pre-stack-save Z80 test that I THINK everyone can agree
; on (it also works for HD64180s & NSC800s), went back to Z80 code
; for all stack pointer moves, converted Sigi's wildcard sorter to
; Zilog mnemonics so non-M80 folks can assemble it and threw in
; some JRs here and there. Restored the disk write error message
; routine from another(!) version 1.3 (not documented here) done
; by Bill Duerr. - Bruce Morgen
;
; v1.6 - 02/18/86
; Added wildcard support and suppress non-*?Q?-files completely.
; Moved code where it belongs (CSEG)! - Sigi Kluger
;
; v1.5 - 02/18/86
; One of the changes made in v1.1 has been reversed- Apparently
; the BIOS for some machines (Kaypro & Osborne?) clobber the alter-
; nate registers. Thanks to Keith Peterson for info on this.
; No more tricks at "FATAL" or OS stack size assumptions; Built
; CR/LF into the message routine; removed extraneous OR A's after
; INC A's from the modified file open success tests.
; Most of the changes are in the form of improved documentation,
; and some code segments have been shifted in position.
; Another v1.2 (similar M80 compatible) version, courtesy Harry
; Kaemmerer, appeared almost simultaneously with the one mentioned
; below. Harry suggested a shorter (tested?) Z-80 test, but it
; involves execution of opcode "18H" (undefined for the 8080 &
; 8085). The test used here should be clean for an 8085. Does
; anyone have a clean solution? (not time dependent!). Obviously
; this isn't a very important aspect of this program.
; - Steven Greenberg
;
; v1.4 - 02/17/86 [intermediate unreleased version]
;
; v1.3 - 02/17/86
; Changed stack save and load routines to the old 8080 method
; since they must run even if you try to use an 8080 processor and
; get the error message. - D. Jewett, III
;
; v1.2 - 02/15/86
; Fixed source code so it could used with the M80 assembler which
; is owned by more CP/M users than all other Z80 assemblers com-
; bined (and by a wide margin at that). It can still be assembled
; with the SLR Z80ASM for which it was originally written.
; - Irv Hoff
;
; v1.1 - 02/09/86
; Various small changes to the CP/M interface aspect of the code.
; Fixed the test for file-open success (BDOS won't always return a
; zero). Moved local stack to Copyright message and saved OS stack
; to beginning of same, eliminating warm boot-on-exit (the algor-
; ithm is so fast that the CCP reload often took as much time as
; the unsqueezing itself). Took out now unnecessary stack trick at
; FATAL: and slimmed down on PUSH/POPs at BDOSAV: (BDOS does not
; use Z80 specific registers). - Bruce Morgen
;
;-----------------------------------------------------------------------
;
; (FOR CP/M 2.2+, Z-80 only)
;
; v1.0 - 01/10/86
; This program unsqueezes standard (Greenlaw style) squeezed
; programs. This is the original (no frills) version simply spec-
; ify the filename to be unsqueezed on the command line. The res-
; ult filename will be generated automatically and written to the
; default drive. The difference between this unsqueezer and others
; lies in its unique architecture. This results in speed increases
; ranging from a factor of about 2 (compared to fastest assembly
; coded programs previously available) on up to factors greater
; than 5 (compared to standard C coded versions). Also note that
; the current .COM file is less than 1K in length.
;
; The architecture, very briefly, is as follows. First the "dic-
; tionary" info contained in the squeezed file is "compiled" into a
; decoding program, which sits in memory just above the .COM file.
; Since each squeezed file generates its own unique program, the
; program is a highly efficient subroutine for performing the ac-
; tual unsqueeze operation.
;
; Thanks to Jeff D. Wilson for many worthwhile suggestions.
;
; Note: This version requires a minimum TPA of about 28k, but
; input & output buffer sizes could be easily changed by changing
; the equ's for "ibufsz" & "obufsz" at the end of this program and
; reassembling it. Another version could perform a dynamic assign-
; ment of these buffers based on available memory. I have not done
; tests on the relative speed / memory tradeoffs. This version
; sion has a 2.25k input buffer & a 16k output buffer. It also
; automatically allocates a worst case size of 8K for "codtbl"
; another version could allocate only the exact amount needed for
; the file being un-squeezed.
;
; This program was assembled on an Z80ASM SLR SuperFast assem-
; bler. No macros are used however, or anything else too assembler
; specific.
; -Steven Greenberg
;-----------------------------------------------------------------------
; Opcode equates
JPOP EQU 0C3H ; Opcode for "JP" instruction
; ASCII equates
CR EQU 0DH
LF EQU 0AH
; CP/M address equates
DFCB EQU 5CH ; Default file control block
DDMA EQU 80H ; Default DMA address
CPM EQU 0000H ; Warm boot jump address
BDOS EQU 0005H ; BDOS entrypoint
; BDOS function equates
PRTSTR EQU 9 ; Print string to console
OPEN EQU 15 ; Open file
CLOSE EQU 16 ; Close file
ERASE EQU 19 ; Erase file
READ EQU 20 ; Read file (sequential)
WRITE EQU 21 ; Write file (sequential)
MAKE EQU 22 ; Make file
SETDMA EQU 26 ; Set DMA address
;-----------------------------------------------------------------------
ENTRY: JP START
OLDSTK: DEFB 'Copyright (c) Steven Greenberg 1/10/86 201-670-8724; '
DEFB 'may be freely reproduced for non-profit applications.'
START:
LD A,7FH ; Find out if Z80 with flag test
ADD A,A ; Add 7FH to 7FH
JP PE,Z80 ; Parity (overflow)=Z80
LD DE,WRNGUP ; "Program requires Z80 processor"
JP MESAGE ; Non-Z80s: print up and go home
;
Z80: LD (OLDSTK),SP ; Save the operating system stack
LD SP,START ; Set local stack
LD A,(BDOS+2) ; Size up the TPA
SUB EOBFHI+10 ; (Includes 2K for the CCP)
JR NC,ENOUGH ;
LD DE,LAKMEM ; "Not enough memory..."
JP FATAL ; (fatal error)
;
ENOUGH: LD DE,LOGO ; Version#, etc
CALL MESAGE
LD DE,DFCB ; Open input file spec'd on command line
LD A,'Q' ; FORCE .?Q? !!!
LD (DFCB+10),A
LD DE,DFCB ; Point to specified file
LD HL,FNBUFF ; And to filename buffer
CALL WILDEX ; Do wildcard expansion
LD (NMBFLS),HL ; Save number of matching files
JR Z,WERR ; Get out if error
LD DE,MAXFLS ; Check if too many matching files
AND A ; Clear carry
SBC HL,DE
JR NC,TOOMNY
LD HL,FNBUFF ; Get name buffer
LD (BUFPTR),HL ; Set up buffer pointer
;-----------------------------------------------------------------------
; Come here for each new file
NXTFIL: LD DE,DFCB+1 ; Clean input FCB
PUSH DE
CALL ZERFCB
LD HL,(BUFPTR)
POP DE
PUSH HL ; Save filepointer
LD BC,11 ; 11 characters
INC HL
LDIR ; Move next filename in place
LD DE,OFCB+1
CALL ZERFCB ; Clean output fcb
POP HL
LD DE,16 ; Offset to next filename
ADD HL,DE
LD (BUFPTR),HL
LD DE,DFCB
LD C,OPEN
CALL BDOSAV
INC A
JR NZ,CLONE ; Br if successful
;
WERR: LD DE,ERR1 ; Else, "Input file not found"
JP FATAL
;
TOOMNY: LD DE,ERR3 ; "Too many matching files"
JP FATAL
; Before going too much further, take this opportunity to "clone" a
; 16 byte template of code into memory 512 times. This forms the
; skeleton for the compiled block of code "CODTBL". Various specific
; instructions and data will overwrite sections of this template after
; the dictionary info is read.
CLONE: LD HL,TMPLAT ; Xfer one copy to the beg of "CODTBL"
LD DE,CODTBL
LD BC,16
LDIR
LD HL,CODTBL ; Now copy it 511 more times.
LD BC,511*16 ; DE already points to "CODTBL+16"
LDIR ; That does it
; Now load up the input buffer. The input buffer, the output buffer,
; and "CODTBL" are all page aligned and of page multiple lengths. There
; are no other criteria for the lengths of the 2 buffers, except that the
; input buffer should have a minimum length of 2K plus 1 more page. This
; guarantees that the entire dictionary (plus miscellaneous header info)
; will be read in on the 1st pass, simplifying the program.
CALL RELOAD ; "RELOAD" leaves HL pointing to
LD A,(HL) ; The beginning of "IBUF"
CP 76H ; Check for "Squeezed File Header"
; Code 76H,FFH
JR NZ,NTSQZD ; Br if not a squeezed file
INC L ; Note buffer starts on a page boundary
INC (HL) ; Chk for FF [clobber it along the way]
;
NTSQZD: LD DE,NSQMSG ; Meanwhile , prep for poss err msg
JP NZ,FATAL ; Fatal "not squeezed" condition
LD DE,ARROW ; "---->"
CALL MESAGE ; Ok, print an arrow
LD HL,(IBUF+2) ; Get the 16 bit checksum and save
LD (CHKSUM),HL ; Goes there
LD HL,IBUF+3 ; Init pointer past 76FF and 2 byte
; Checksum (-1)
LD IX,OFCB+1 ; Init pointer to filename of output FCB
;
EATLP: INC L ; Filename << 256 chars
LD A,(HL) ; Eat up the file name
OR A ; A zero byte indicates end of filename
JR Z,ATEIT ; Br when that is encountered
CP '.' ; Check for name / ext division char
JR Z,ISDOT ; Br when encountered
LD (IX+0),A ; Else copy filename char to output FCB
INC IX ; And incr that pointer
JR EATLP ; Continue
; 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 IX,OFCB+9 ; Skip...
JR EATLP ; And continue
;
ATEIT: LD (HL),'$' ; Clobber the zero with a '$' for
; Below function call
LD DE,IBUF+4 ; Beg of file name
CALL PRINT ; Print the filename to the console
LD DE,OFCB ; Output FCB
LD C,ERASE ; "Blind erase" the dest file if it exists
CALL BDOSAV ; (*** implement a prompt here? ***)
LD C,MAKE ; In any case, make the new file
CALL BDOSAV
INC A
JR NZ,MAKTBL ; Err cond check
LD DE,ERR2 ; "File open error"
JP FATAL ; Exit
; Now create "CODTBL" by overwriting certain sections of the
; template created above. The dictionary contains 4 byte nodes-
; these are con-verted into 16 byte code segments. The maximum
; length of the original dictionary is (257*4) bytes or about 2K
; corresponding to a maximum "CODTBL" length of 8K.
;
; NODE DEFINITION: As mentioned above, a "node" consists of two
; pairs of bytes. The first pair corresponds to a zero bit, the
; latter to a "1". To decode a character, we start at node #0. A
; bit is pulled off the bit stream. We then use the 1st or 2nd byte
; pair depending on the bit value. The byte pair takes on 1 of 2
; forms "nn FF" or "xx 0x". The "nn FF" type is a terminal node,
; it means we have our next output value - that value specifically
; being the 1's complement (makes it more mysterious) of "nn". If
; the node is of the second type, it is a pointer to another node
; (an absolute offset from the beg of the dictionary in terms of
; node#, must be multiplied by 4 for a byte offset. It has a max-
; imum value of 513, and is expressed as a 16-bit #, lo-byte
; first). In this case we go to that node, pull another bit off
; the input stream, and continue the process.
;
; There is actually a 3rd node type, which just comes up once.
; Its form is "FF FE". It's a special end-of-file marker called
; "SPEOF".
;
; HOW THE PROGRAM WORKS: Each node is converted into a 16-byte
; (actually 13 plus 3 nop's) series of instructions. These in-
; structions later perform the unsqueezing operation. The whole
; block of code starts at "CODTBL" (which is also the entrypoint).
; Each 13 byte "node code" consists of a 7 byte header. The header
; shifts out the next bit from reg "b", then conditionally branches
; to the first or second half of the remaining code (3 bytes per
; half; 7+3+3 = 13). The 3 bytes in each half are either the 2
; instruc-tions "LD A,<byte>" followed by "RET" (terminal node) or
; the single instruction "JP <nxtnode>". All calls to "CODTBL"
; even-tually hit a terminal node and perform a normal return. The
; only exception is the special end-of-file node which compiles to
; "JP SPEOF"; on this particular return the stack is manually ad-
; justed to compensate for the lack of a "RET" instruction.
;
; THE TEMPLATE: This is the "template" which was "cloned" earlier
;
; The following 3 instructions form the header code for every
; node. They are identical for every node (since the jump is rel-
; ative).
TMPLAT: SRL B ; Shift out next bit
CALL Z,REFILL ; Refill reg when empty
JR C,BITIS1 ; If bit is "1"
; After the header code gets executed, one of 2 halves of the
; remainder of the node gets executed. Which half depends on the
; bit shifted out above ("0" for the first half, "1" for the 2nd).
; Each half-node has two possible forms. The terminal form loads
; an appropriate value and returns. The non-terminal form jumps to
; the header of another node. This 16-byte "node-code template"
; assumes the former case by default, since 2 of 3 bytes in that
; case are fixed (only the value need be in-serted). If it turns
; out to be the latter case, all 3 bytes will be overwritten with a
; "jmp" opcode plus an appropriate address.
BITIS0: LD A,00H ; (00H gets replaced with actual value
RET ; To be returned.)
;
BITIS1: LD A,00H ; 2nd half of the node, likewise
RET ;
NOP ; }
NOP ; } So the template is exactly 16 bytes
NOP ; }
; Create the "node code" table
MAKTBL: INC L ; Now points one past the filename EOF
LD E,(HL) ; Get #of nodes (lo byte)
INC L
LD D,(HL) ; Hi byte of same
INC L
LD A,D
; An additional file validity check: though the #of nodes could in theory
; theory as high as 0201H or so, it should never approach 0300H or higher.
SUB 3 ; If this happens, assume it is not a
JP NC,NTSQZD ; Squeezed file.
; HL indexes through source dictionary (already initialized), & HL' is
; current dest pointer (indexes thru "codtbl"). DE is initialized to the
; # of nodes and is decreased to 0.
EXX ; Init some constants
LD DE,10 ; Used for incrementing HL'
LD HL,CODTBL+7 ; Init HL' itself
EXX ;
; Remember, the whole "header" code and some other instructions are
; already there (from when "template" was duplicated). Only specific
; details need now be filled in.
NODELP: CALL MAKHAF ; Make the first ("0") half-node
CALL MAKHAF ; 2nd ("1") half-node
; Source pointer has already been incremented 4 times, as desired. Dest
; pointer has only been incremented 6 times, however.
EXX ; }
ADD HL,DE ; } So take care of that
EXX ; }
DEC DE ; Loop counter
LD A,D
OR E
JR NZ,NODELP ; Continue till done
JR RUN ; Go run, HL is is ready, pointing to
; The first byte of squeezed code
; Create a "half-node"
MAKHAF: LD C,(HL)
INC HL
LD A,(HL) ; Get a byte pair from the dictionary
INC HL
OR A ; If it is negative, it is "terminal"
JP M,TERMOD ; Branch if that is the case.
; Else create code for one half-node of the non-terminal variety.
; Byte pair is in A,C. Multiply it by 16 (bytes/node in "codtbl")
SLA C
RLA
SLA C
RLA
SLA C
RLA
SLA C
RLA
ADD A,CDTBLH ; Add offset to beginning of "CODTBL",
; (page aligned)
LD B,A ; Now BC has the jump address
;
ALTENT: PUSH BC ; Save it
EXX ; Switch to dest pointers
LD (HL),JPOP ; Insert the "jp" opcode
INC L ; Remember "codtbl" is page aligned
POP BC ; Get addr back
LD (HL),C ; Jump addr, lo
INC L ;
LD (HL),B ; Jump addr, hi
INC L ;
EXX ; Back to source pointers
RET ; Thats all
; Create a half-node of the terminal variety
TERMOD: CP 0FEH ; Check for special EOF terminal node
JR Z,SPEOF ; Br for that unique case
LD A,C ; Else this byte is the complement of
; The returned value
CPL
EXX ; Switch to dest pointers
INC L ; Just 2nd of 3 bytes need be inserted
LD (HL),A ; Put it in
INC L ;
INC L ; But make sure HL gets incr'd 3 times
EXX ;
RET ; That's all
; Special EOF returns to a special address in mainline code, rather
; than using "RET". Stack is adjusted accordingly there.
SPEOF: LD BC,DONE ; The special address
JR ALTENT ; Use convenient code subsection above
; Code to refill register 'B' with the next byte
REFILL: INC L
JR Z,POSRLD ; If L is zero, may be at end of buffer
;
CONT: LD B,(HL) ; Else get next byte
; Now 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 reg is a necesssary and sufficient condition for
; determining that all the bits in the reg have been used up (see
; header code for "TMPLATE"). The only things to be careful of is that
; the the last bit is NOT used, and that the bit now in the carry flag
; IS used upon return from this subroutine.
SCF ; To shift in the flag bit
RR B ; Shift out real bit as described
RET ; That's it
;
POSRLD: INC H ; Check if time to reload the input
LD A,EIBFHI ; Buffer with additional data.
CP H ;
CALL Z,RELOAD ; Reload if necessary (resets HL)
JR CONT
; Main code to perform the unsqueeze. In general, the alternate regs
; are used as output pointers, flags, etc. while the primary registers
; are used for input pointing and general purpose use.
RUN: EXX ; First initialize the alternate regs
LD HL,OBUF ; HL', output pntr, to beg of output bfr
LD BC,0 ; C always has a copy of the previous
EXX ; Char output; B is a "repeat flag".
; Primary register initialization:
DEC HL ; Init HL, the input pntr, to point to
; The first byte of squeezed code -1.
LD DE,0 ; Initialize checksum accumulator to zero
LD B,D ; And initialize 'B' to zero so first
; Call will immediately call in the
; Actual first byte.
;
MAINLP: CALL CODTBL ; Unsqueeze a character
CALL SEND ; Output it to the output buffer
JR MAINLP ; And repeat "forever" (see "SPEOF"
; Reload the input buffer, & reset HL to point to the beginning of it.
; Assumes input bfr starts page boundry and is of page multiple length.
RELOAD: PUSH AF
PUSH BC
PUSH DE
LD B,IBUFSZ ; Loop counter, buffer length in pages
LD D,IBUFHI ; Beg of buffer (hi)
;
RLDLP: LD E,0 ; Lo byte of current dma
CALL RDSEC ; Read in 128 bytes (1/2 page)
JR NZ,RLDRTN ; (return if eof enecountered)
LD E,80H ; To read in the next half page
CALL RDSEC ; Do that
JR NZ,RLDRTN ; As above
INC D ; Next page
DJNZ RLDLP ; Loop till done
;
RLDRTN: POP DE ; Restore regs
POP BC
POP AF
LD HL,IBUF ; Reset input pointer
RET ; And return
; Subr for abover, reads 128 bytes to memory starting at HL
RDSEC: PUSH DE ; Save DMA before clobbering it with FCB
LD C,SETDMA ; Set DMA function
CALL BDOSAV ;
LD DE,DFCB ; Input FCB
LD C,READ ;
CALL BDOSAV ; Read a record
POP DE ; Restore DMA to original DMA address
OR A ; Set non-zero status
RET
; When "SPEOF" is encountered, a jump to here is made to exit "CODTBL"
; rather than the normal RET instruction.
DONE: INC SP ; So adjust the stack immediately!
INC SP ;
LD A,(CHKSUM+0) ; Make sure the checksum checks out
CP E ; Lo-byte
JR NZ,NFG ; Br if nfg
LD A,(CHKSUM+1) ; Likewise
CP D ;
JR Z,CKSMOK ; Ok
; If a checksum error is detected, report the warning. Let the guy
; have his file anyway, for whats its worth.
NFG: LD DE,CHKERR ; "Checksum error detected"
CALL MESAGE ;
; Switch to alternate regs for output. The total #of bytes generated
; should always be a multiple of 128. This assumption is not made,
; however, as it may not be true if the file was squeezed on non-CP/M
; systems. Compute # of sectors to write- specifically subtract the
; buffer start addr from the current pointer value, add 7FH and divide
; by 128. If the byte count was in fact a multiple of 128, this has
; no effect; otherwise it makes sure the final sector gets written.
CKSMOK: EXX ; Switch to alt regs
AND A ; Clear carry
LD DE,OBUF-7FH ; Take care of adding 7FH in advance
SBC HL,DE ; Subtract
SLA L ; Divide by 128
RL H ; Result now in H
LD B,H ; Use 'B' as the counter
CALL WRTOUT ; Writes 'B' sectors to the output file
EXX ; Back to primary regs
LD DE,OFCB ; Close the output file
LD C,CLOSE
CALL BDOSAV
LD DE,DFCB ; Likewise the input file
LD C,CLOSE
CALL BDOSAV
; Fall through
EXIT: LD HL,(NMBFLS)
DEC HL
LD (NMBFLS),HL
LD A,H
OR L
JP NZ,NXTFIL ; Next file
LD SP,(OLDSTK) ; Restore OS stack
RET ; To CCP
; Write 'B' 128 byte sectors to the output file
WRTOUT: LD DE,OBUF ; Init DMA addr to beg of output bfr
;
WRTLP: LD C,SETDMA ; Set DMA to there
CALL BDOSAV
PUSH DE ; Save that address
LD DE,OFCB ; Specify the output file
LD C,WRITE ; Write a record
CALL BDOSAV
OR A
JR NZ,WRTERR
POP DE ; Address as saved above
DJNZ NEXSEC ; Decrement counter & continue if not done
RET
;
NEXSEC: LD E,80H ; Else increase by 128 bytes
LD C,SETDMA
CALL BDOSAV
PUSH DE ; Save DMA pointer
LD DE,OFCB ; Output FCB
LD C,WRITE ; Write another sec
CALL BDOSAV
OR A ; Need the test here also
JR NZ,WRTERR
POP DE ; Get back orig pointer
INC D ; Inc hi-byte, 0 the lo to effect
LD E,0 ; Another 80H incr
DJNZ WRTLP ; Loop till done
RET
;
BDOSAV: EXX ; BDOS call w/ all regs and alts saved
PUSH BC ; Except for AF, AF', IX, & IY
PUSH DE
PUSH HL
EXX
PUSH BC
PUSH DE
PUSH HL
CALL BDOS
POP HL
POP DE
POP BC
EXX
POP HL
POP DE
POP BC
EXX
RET
;
WRTERR: LD DE,WRTMSG
; For fatal errors- print the message, restore the os stack & return
FATAL: CALL MESAGE ;
LD SP,(OLDSTK) ; Restore stack pointer Z80-style
RET ;
;
MESAGE: EX DE,HL ; Save pntr to message (supplied in DE)
LD DE,CRLF ; First print a CR/LF sequence
LD C,PRTSTR
CALL BDOSAV
EX DE,HL ; Then the message in question
;
PRINT: LD C,PRTSTR ; Entry here if no cr/lf desired
JP BDOSAV
; 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
CALL OUT ; Else just output the char;
EXX ; Back to normal regs
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
LD A,C ;
;
AGAIN: CALL OUT ; Repeat B occurrences of byte in 'A'
DJNZ AGAIN ; Leaves B, the rpt flag, 0 as desired
EXX ; Restore regs & rtn
RET
;
SND90H: LD A,90H ; Special case code to send the byte 90H
CALL OUT ; Itself
EXX ;
RET ; (90H "squeezes" into 2 bytes!)
; Output character in 'A' directly to the output buffer
OUT: EXX ; Back to primary regs briefly
LD C,A ; Save A in C
ADD A,E ; DE is the running checksum
LD E,A
JR NC,NOCARY
INC D
;
NOCARY: LD A,C ; Put the char back into A
EXX ; Back to output (alternate) regs
LD (HL),A ; Put byte into the next avail position
INC L ; Increment pointer
RET NZ ; Return if not passing a page boundry
INC H ; Incr pointer high byte, check limit
LD L,A ; Use L, which is 0, for temp storage
LD A,EOBFHI ; Limit
CP H ; Check
LD A,L ; But first restore regs
LD L,0 ;
RET NZ ; Ret if limit not reached
PUSH AF
PUSH BC
LD B,OBUFSZ*2 ; Number of 128 byte records to write
CALL WRTOUT
POP BC
POP AF
LD HL,OBUF
RET
; Clean up FCB
ZERFCB: LD B,11 ; Fill filename with blanks
LD A,' '
CALL ZL
LD B,24 ; Then zero remainder
XOR A
;
ZL: LD (DE),A
INC DE
DJNZ ZL
RET
;-----------------------------------------------------------------------
LOGO: DEFB 'FU Fast Unsqueezer v1.8$'
ERR1: DEFB 'Input file not found.$'
ERR2: DEFB 'File open error.$'
ERR3: DEFB 'Too many matching files.$'
ARROW: DEFB '----> $'
LAKMEM: DEFB 'Out of memory.$'
NSQMSG: DEFB 'Not a squeezed file.$'
CHKERR: DEFB 'Checksum error detected.$'
WRNGUP: DEFB 'Program requires Z80 uP.$'
WRTMSG: DEFB 'Output error, program aborted.$'
CRLF: DEFB CR,LF,'$'
OFCB: DEFB 0,' ',0,0,0,0,0,0,0,0
DEFB 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
CHKSUM: DS 2
;-----------------------------------------------------------------------
; ENTRY:
; HL = .buffer
; DE = .afn fcb
;
; EXIT:
; HL = number of files
; ACC= zero flag set if error
; The buffer contains HL file names of 16 characters each
; Character 0 contains the user number
;
SFIRST EQU 17
SNEXT EQU 18
;
WILDEX: LD (BUFPTR),HL
LD HL,0
LD (COUNT),HL
LD C,SFIRST
CALL BDOSAV
CP 0FFH
RET Z ; Nothing found -- error
CALL MOVEN ; Move name
;
WLOOP: LD C,SNEXT ; Search for next
CALL BDOSAV
CP 0FFH
JR Z,DONEW ; Finished
CALL MOVEN
JR WLOOP
;
DONEW: OR A
LD HL,(COUNT)
RET
;
MOVEN: PUSH DE
LD HL,(BUFPTR)
ADD A,A
ADD A,A
ADD A,A
ADD A,A
ADD A,A
ADD A,80H
LD C,A
LD B,0
LD D,16 ; Move 16 characters
;
MOVLP: LD A,(BC)
LD (HL),A
INC HL
INC BC
DEC D
JR NZ,MOVLP
LD (BUFPTR),HL
POP DE
LD HL,(COUNT)
INC HL
LD (COUNT),HL
RET
;
BUFPTR: DEFW 0
COUNT: DEFW 0
NMBFLS: DEFW 0
MAXFLS EQU 425 ; Buffer size (in files) for wildcard ex-
; Pansions. Room for this many files will
; Will be allocated. (425 should do it!)
FNBUFF EQU $ ; Beg of that buffer
ENDFNB EQU (FNBUFF+16*MAXFLS) ; End of buffer
; Compute next page boundary following the end of the above buffer. Do
; this by adding 0FFH and "anding" with 0FF00H. This will become the
; beginning of "CODTBL".
;
; *** NOTE ***
;
; If this code is CSEG'd, M80 will reject this. You can fake
; out the assembler using a "HIGH" , then multiplying by 256,
; but then it will link incorrectly. If you just EQU "codtbl",
; the resulting code isn't really relocatable anyway...
; I think there are ways around this, but they involve the
; assumption that this whole file is "page relocatable" only.
CODTBL EQU (ENDFNB+0FFH) AND 0FF00H ; (works with ASEG only)
; Minimum input buffer size is 9 pages to guarantee that the max possible
; dictionary size (512 bytes plus overhead) will be read in the first
; pass.
IBUFSZ EQU 16 ; Input buffer size (pages)
; (was "9" prior to v1.8)
; Output buffer can be any page multiple length (note it too is also page
; aligned). Increases beyond 64 pages (16k) may do little to improve perf.
OBUFSZ EQU 64 ; Output buffer size (pages)
;
IBUF EQU CODTBL+(16*512) ; Beginning of input buffer
OBUF EQU IBUF+(IBUFSZ*100H) ; Likewise output buffer
EOBUF EQU OBUF+(OBUFSZ*100H) ; End of output buffer
;
CDTBLH EQU HIGH CODTBL ; }
IBUFHI EQU HIGH IBUF ; } high bytes of the beginning addresses
EIBFHI EQU HIGH OBUF ; } of the buffers just defined
EOBFHI EQU HIGH EOBUF ; }
;
END