home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CP/M
/
CPM_CDROM.iso
/
cpm
/
utils
/
squsq
/
fcrnch11.lbr
/
CRN.MZC
/
CRN.MAC
Wrap
Text File
|
1986-12-24
|
35KB
|
1,111 lines
title 'CRN v2.5 compressor, 8080 code.'
;
; Copyright (c) 1986 Nov. 30 by:
; C.B. Falconer, 680 Hartford Tpk, Hamden, Conn. (203) 281-1438
; all rights reserved.
;
; The original Z80 version from which this was developed is
; Copyright (c) 1986, Steven Greenberg (201) 670-8724
;
; v25 Added trap for output sequence '0D,40,0D' (with possible hi
; bits set) for comm. program compatibility. Injects nop.
; cbf (86/12/19)
;
; This program may be copied and used freely for non-profit purposes.
; It may not be sold nor included in packages for sale without the
; express written consent of C.B. Falconer.
;
; NOTE: 8086 versions of CRN and UNC are under development. Contact
; C.B. Falconer. These will be available in .OBJ (linkable) form,
; and will be data compatible with 8080 CRN/UNC versions.
;
; Adaptation of Steve Greenberg's Crunch algorithm/code to a separate
; module. This also enables the use of the algorithm on 8080s. The
; adaptive reset criterion has to be different, since this module
; knows nothing about records, just byte streams. A further differ-
; ence is that a 9 bit reset code is always the first thing emitted.
; I have tried to define a flexible set of interface conventions,
; with attention to efficiency and clarity.
;
; With the clutter of the file system and user interface removed, the
; elegant simplicity of Mr. Greenbergs algorithm becomes visible.
;
; All registers available to these externals. They may implement
; any multi-processing desired, abort, monitor, etc.
extrn getchr; next input char to (a). Cy for EOF
extrn outbyt; output char (a). Every 256th output
; call has Z flag set, for monitoring.
;
; Library linkages. Available in BUFFLIB, (see BUFFERS.LBR), or can
; be coded separately. Unsigned arithmetic.
extrn .idiv; de := dehl/bc; hl := dehl MOD bc
extrn .imul; dehl := bc * de
;
; This entry is organized as an analogy to UNC. See below for parm.
entry crn; a is parm, hl points to storage.
;
; Allow main program to monitor the status.
entry incnt, outcnt; Can monitor counts.
entry nxtcod, ttotal; Can monitor codes/reassignments
;
rev equ 25h; Program revision level
sigrev equ 20h; "significant" rev. lvl (compatibility)
;
; Bits in input argument "parm", strategy etc.
allfile equ 080h; Do not check for pre-squeezed/crunched. This
; allows any bit pattern to be processed.
stkset equ 040h; Using incoming SP as memtop, no stack switch
csfield equ 030h; 0..3, value of output checksum flag
; 0 = normal usage, as crunch/uncr. MOD 65k.
; 1 = CRC16 checksum, using BUFFLIB routine
; 2, 3. Unassigned values.
; NOTE: Existing systems will ignore chksums
; for all non-zero arguments.
rafield equ 0ch; }
lghfld equ 03h; } Criteria for adaptive reset triggers
;
; The useful discrete values in the low 4 bits, and their effects
; value lgh fld ra fld reset allowed when
; ----- ------- ------ ------------------
; 0 0 0 codlen reaches 10
; 1 1=11 0 codlen reaches 11
; 2 2=12 0 codlen reaches 12
; 3 3=13 0 No adaptive resets allowed
; 4 0 1 table full and 1024 reassignments
; 8 0 2 " " 2048 "
; 12 0 3 " " 3072 "
; 14 Any time
; 15 Whenever table full
;
; Embedded in other programs. Do not change. Note that both
; "impred" and "nopred" include the "used" bit in their values.
nopred equ 0ffffh; "no predecessor"
impred equ 07fffh; Pred that can't be matched or bumped
tblsize equ 5003
mincod equ 9; minimum bits per code
maxcod equ 12; maximum bits per code
crsqhd equ 076h; header byte, crunched/squeezed files
crhdr equ 0feh; 2nd byte, for crunched files
sqhdr equ 0ffh; 2nd byte, for squeezed files
vacant equ 080h; marker for vacant table entries
used equ 020h; "used" marker bit, in high order code.
escape equ 090h; Repeat encoding marker.
;
; Installation configurable values
slop equ 11; pages, 8 for CCP allowance
stksize equ 0; pages of 256 bytes, when assigned locally
; (spare above last table area suffices)
@memtop equ 6; Where CPM keeps max memory pointer
;
; If both are set to 0 no overhead code is generated. 7 sig. bits.
trp1st equ 0dh; (0dh) Sequence on which to inject nulcod
trp2nd equ 040h; (040h) 2nd char of sequence.
;
; Calculated values
tblroom equ (tblsize + 255) AND 0ff00h; Round up to pages
trapit equ (trp1st OR trp2nd) ne 0
;
; allowance for 5 column table and stack
pages equ (tblroom shr 8) * 5 + stksize
; reserved codes - DO NOT CHANGE
eofcod equ 100h; EOF code
rstcod equ 101h; Adaptive reset code
nulcod equ 102h; Null code
sprcod equ 103h; Spare code
;
; Error codes. Nothing sacred here
err1 equ 1; input file empty
err2 equ 2; input already squeezed/crunched
err3 equ 3; memory/stack overflow
;
spare equ 5; filler for "spare" header byte
;
; Macro for "horizontal" movement through the table.
; See "Table structure" comment near "initbl" for more information.
;
; move "right" one column (same row)
right1 macro
mov a,h
adi tblroom shr 8
mov h,a
endm
;
; ----------
;
; Relocatable code module begins here.
cseg
;
db rev; At crn-1, for reference
;
; The caller has already emitted the header word, file name, stamp, 0
; (needed for crunched format files, optional for other applications).
; At entry a contains "stategy" byte, hl points to memory area (25k+).
; At exit the caller must output the checksum field (needed for files,
; optional for other applications, e.g. communication systems).
; a,f,b,c,d,e,h,l
crn: sta arg; input arg, for strategy etc.
xchg; (crunched checks, adaptive reset)
lxi h,0
dad sp
shld spsave; for aborts, exit etc.
call malloc; allocate memory
mvi a,err3
rc; memory overflow, stack not switched
sphl; nullop if stkset true
lxi h,zerobgn
lxi b,zeroend-zerobgn
call fillz; Initialize this data area to 0
mvi a,rev; Output rev level of this program
call outb
mvi a,sigrev; Output "significant revision" level
call outb
lda arg
ani csfield; Mask out checksum control field
rar; and reposition as 0..3
rar
rar
rar
call outb; to output stream
mvi a,spare
call outb; Output a spare byte of "5"
call getc
jc xempty; Input file is empty
push psw
call getc; initializes "lastch"
jc xempty; 1 byte only, treat as empty
pop h; 1st byte to h
mov l,a; 2nd byte to l
lda arg
ani allfile
jnz crn1; omit pre-squeezed/crunched check
mov a,h
cpi crsqhd
jnz crn1; not squeezed/crunched
mov a,l
cpi crhdr
jz xsqzcr; already crunched
cpi sqhdr
jz xsqzcr; already squeezed
crn1: mvi a,01h
sta csave; init "putcd" machine
mvi a,mincod
sta codlgh; (crnch inits codlen)
mov a,h; first byte (2nd in lastch)
lxi h,normal; initial state for "nxtch"
shld istate
call crnch; Initial reset, with 1st char in a
; " "
; If no error, checksum still to be output and files closed etc.
; Enter here with carry for error, a holding error code
exit: lhld spsave
sphl
ret
;
; Error connectors
xsqzcr: mvi a,err2; already squeezed/crunched
jmp xexit
xempty: mvi a,err1; "Input file empty"
xexit: stc
jmp exit
;
; perform an adaptive reset and crunch the remaining input.
; Initial byte in (a).
; Unlike the original, this version always emits an initial "reset".
; I was going to suppress this, but on reconsideration this is
; probably useful to synchronize the uncruncher state.
crnch: push psw; Save suffix which has yet to be output
mvi a,mincod; Reset the code length
sta codlen; (codlgh updated by putcd)
lxi h,rstcod; Send (otherwise disallowed) reset code
call putcd
xra a
sta fulflg; Clear the adaptive reset flag.
mov h,a
mov l,a; hl := 0
shld nxtcod; Reset entry # prior to table re-init.
shld ttotal; Reset "codes reassigned"
mvi a,1 shl (mincod-8); Reset target mask value.
sta trgmsk
call initbl; Re-initialize the entire LZW table
mvi a,0ffh; Init target compression ratio to max
sta lowper; Goes there
pop psw; Restore suffix char, patiently waiting
; " "
; *** Main encoding loop ***
; " "
crnch1: lxi h,nopred; Beginning of string
; " "
; "Match" determines if the combination { <pred>, <suffix> }, as
; supplied in { HL, A }, is already in the table. If it is the
; matching index value is returned in DE. If it isn't, it will be
; added to the table in an appropriate place (assuming the table is
; not yet filled). If the table is filled, it may or may not still
; be added. Carry flag set indicates NOT found.
crnch2: push h
call match; Is { pred, suffix } in the table?
pop h
jnc crnch4; found, try to extend string
crnch3: call putcd; not found, send pred (a whole string)
jnc crnch1; start a new string unless
jmp crnch; adaptive reset requested, start over
; (assumed to break any bad sequence)
crnch4: xchg; Match, discard old pred, replace w/new
call nxtch; A := next byte from "logical" input
jnc crnch2; not EOF
; " "
; *** End of main encoding loop ***
; " "
; end of input, flush everything
call putcd; Output the "leftover" code
lxi h,eofcod; Send (otherwise disallowed) "EOF" code
call putcd
lda csave; Flush any remaining output
cpi 01h; The 1 in 8 chance we're on byte bndry
mvi a,0; last 8 bits of EOF code are 0
cnz outb; If output was not on byte boundary
xra a; no error
ret
; ________________________
;
; Initialize the table to contain the 256 "atomic" entries-
; { "NOPRED", <char> }, for all values of <char> from 0 thru 255
initbl: call preset; "pre-init" the table (mostly zeroes)
xra a; Start with 0
initlp: push psw
lxi h,nopred; Use this value for all 256 loops
call match; Make the entry { hl, a }
pop psw; (incrementing nxtcod for each)
inr a
jnz initlp; Next suffix
; " "
; Reserve entries 100h thru 103h (EOF, RESET, NULL, & SPARE)
call resrv2
resrv2: call resrv; (not bumpable or matchable)
; " " (incrementing nxtcod for each)
; Reserve the next code (in nxtcod) by assigning with an impossible
; predecessor. This makes it unmatchable & unbumpable (eof, etc)
; f,b,c,d,e,h,l
resrv: lxi h,impred
; " "
; Find a match for { <pred> <suffix> }, as supplied in { HL, A }.
; Does one of the following two things:
; " "
; (1) Returns the index # of a match in DE, with carry clear
; (2) Sets carry & adds new combo to approp. place in "table".
; f,b,c,d,e,h,l (preserve a)
match: mov b,a; b := suffix supplied
; " "
; When the table is full the first entry encountered which has been
; made, yet is still "available" (i.e. it has not been used since the
; entry was made, guaranteeing it is not referenced by another entry)
; is saved in "AVAIL". So we initialize that [special value] zero,
; meaning "none".
xchg
lxi h,0
shld avail; Mark no re-assignment candidate yet
push d; Save pred
xchg; hl := pred for hash
; " "
call hash; hl := initial hash value
pop d; de := pred
match1: mov c,h; C := extra copy of h
mov a,m; Check if any entry exists at that locn
cpi vacant
jz insrt; Empty, use spot to create new entry
; " "
cpi 0ffh; Check for a special "atomic" entry
jz match2; If so leave "FF" for matching process
ani not used; Else mask out used flag before match
match2: cmp d; Does entry match pred (hi)
jnz match4; No match here
right1; pred (lo)
mov a,e
cmp m
jnz match4; no match
right1; move to suffix
mov a,b
cmp m
jnz match4; no match
; " "
; We have a match! But there is one very important "but". If the table
; is full, and we are in "code reassignment" mode, we must pre-empt
; the possibility of generating the WsWsW *** string here in the
; cruncher. This is because it is impossible to detect these in the
; uncruncher once all codes are defined.
lda fulflg
ora a
jz match3; Table not full, not "reassign" phase
; " "
lda lpr; If so, see if this pred/suffix combo
cmp e; - is identical to last one generated
jnz match3; Pred (lo) doesn't match, so all ok
lda lsufx; Check suffix. Order of these 3 checks
cmp b; - is intended to optimized speed (most
jnz match3; - likely "non-matches" first)
lda lpr+1; check pred (hi)
cmp d
jz match4; Ugly situation - pretend no match
; " "
; <pred> <suffix> matched in table
match3: right1; 3rd right so far
mov d,m; Get entry #, hi byte, for return.
right1; and lo byte
mov e,m
mov h,c; Normalize. Cancel all those "right"'s
mov a,m
ori used; flag entry as "referenced"
mov m,a
mov a,b; Restore "a" to its value on entry
ana a; Clear cy flag (return status) & return
ret
;
; No match yet. Norm. to beg of entry.
match4: mov h,c
lda fulflg
ora a
jz match5; Not in code reassignment mode
mov a,m
ani used
jnz match5; Entry not available for reassignment
lda avail+1
ora a;
jnz match5; Already have re-assignment candidate
shld avail; Else this physical loc is candidate
; " "
; Standard hash collision processing. Add "DISP", a variable displace-
; ment value, for the "secondary probe". DISP was precalculated at the
; time the original hash value was computed.
; " "
; Note that I (S.G) have implemented this secondary probe "backwards".
; Though identically effective (by symmetry), it has a number of speed
; advantages. When DISP is added, we are really subtracting (DISP was
; intentionally created to be "negative"). Not only is adding faster
; than subtracting, but the check for loop around (which is of course
; passing the beginning of the table) is a one-byte compare (table
; starts on a page boundary). Furthermore, when loop around occurs, we
; get to add once again instead of subtracting. (In fact, no subtract-
; ion is necessary for computing DISP either. See the "HASH" routine).
; " "
match5: push d; Process standard hash collision.
xchg
lhld disp; Get pre-computed displacement value
dad d; Add displacement to current phys loc
mov a,h
push h
lxi h,@table+1; table page
cmp m; And check for rollover to table beg
pop h
jnc match6; no rollover
lxi d,tblsize
dad d; Else tblsize for rollover
match6: pop d
jmp match1; Repeat to see if this "link" matches
;
; Returns incremented "nxtcod" in de.
; Arms codlen/trgmsk as needed for any changes in output width.
; a,f,d,e
nextcd: xchg
lhld nxtcod; Pre-incr for next code.
inx h
shld nxtcod; Save the new value
xchg
lda trgmsk; See if new code length is necessitated
cmp d; Check hi-byte against target value
rnz; Simply return if not
add a; Yes, code length will change
sta trgmsk; Next target mask
lda codlen; Previous code length value (#of bits)
inr a; Increment code length
cpi maxcod+1
jz fullup; Too long, table just filled.
sta codlen; Else record new length
ret
fullup: mvi a,0ffh; Flag table full
sta fulflg
ret; don't update "CODLEN" past 12
;
; All "links" to the hashed entry have been checked and none have
; matched. We therefore make a new entry if possible
; of pred de, suffix b. Exit with a := b(entry)
; a,f,h,l
insrt: lda fulflg; Is the table full?
ora a
jz insrt1; table not full
lhld avail; no empty space. Try for reassignment
mov a,h
ora l
jz insrt2; No reassignment candidate available
; " "
push h
lhld ttotal; Advance "codes reassigned"
inx h
shld ttotal
xchg
shld lpr; Save last entry made for "ugly" detect
xchg
mov a,b; "LPR" <-- last pred,
sta lsufx; "LSUFX" <-- last suffix
pop h
mov m,d; Re-assign entry. Leave it's # alone.
right1
mov m,e; Pred (lo)
right1
mov m,b; Suffix
stc
mov a,b
ret
; Make entry into table.
insrt1: mov m,d; Put in pred (hi)
right1
mov m,e; Pred (lo)
right1
mov m,b; Suffix
; " "
call nextcd; advance, returns NEXT code
dcx d; back to current entry
right1; Move to entry# (lo) column
mov m,d; Put that in
right1
mov m,e; Likewise entry# (hi)
; " "
insrt2: stc; cy indicates new entry (no match)
mov a,b; Return with cy set, "A" intact
ret
;
; Steve Greenbergs input state machine.
;
; This creates the "logical" input stream. It gets its data from the
; "physical" input stream, bet performs repeat byte encoding. Each
; call supplies one logical character out. In general there is a one
; character delay; this character is kept in "lastch".
;
; This subroutine is a state machine, where one call defines the state
; for the following call. It does this by leaving the address of the
; proper section (which implements the next state) in "istate".
;
; This looks a little complicated, but any given call immediately
; jumps to the appropriate small block of code and does what it
; should. This routine acts like a filter, taking in bytes one at a
; time through calls to "getc", and outputting them one at a time via
; calls to it.
;
; TYPE
; inputstate = (eofile, normal,
; duplicate, repeating, dupsdone,
; realescape, emitzero);
; VAR
; istate : inputstate;
; lastch : char;
;
; FUNCTION getc : char;
;
; BEGIN (* getc *)
; read(lastch); getc := lastch;
; END; (* getc *)
;
; (* 1---------------1 *)
;
; FUNCTION nxtch : char; (* using Pascal flavor EOF signal *)
;
; VAR
; ch1 : char;
; count : integer;
;
; BEGIN (* nxtch *)
; ch1 := lastch; nxtch := ch1; (* defaults *)
; CASE istate OF
; normal:
; BEGIN (* all cases emit lastch *)
; IF eof THEN istate := eofile
; ELSE IF getc = escape THEN istate := realescape
; ELSE IF lastch = ch1 THEN istate := duplicate;
; END;
; duplicate:
; BEGIN (* first emitted already, most cases emit 2nd *)
; IF eof THEN istate := eofile
; ELSE IF getc = escape THEN istate := realescape
; ELSE IF ch1 = lastch THEN BEGIN
; (* emit *) nxtch := escape; istate := repeating; END
; ELSE (* exactly 2 *) istate := normal;
; END;
; repeating:
; BEGIN (* 3 up encountered. char, escape emitted. count next *)
; count := 3;
; REPEAT
; IF eof THEN istate := eofile
; ELSE IF getc = escape THEN istate := realescape
; ELSE IF lastch <> ch1 THEN istate := dupsdone
; ELSE IF count = 255 THEN istate := dupsdone
; ELSE count := succ(count);
; UNTIL istate <> repeating;
; nxtch := count; (* emit the count *)
; END;
; dupsdone: (* after count, cannot start a repeat *)
; BEGIN (* this emits the lastch that terminated "repeating" *)
; IF eof THEN istate := eofile
; ELSE IF getc = escape THEN istate := realescape
; ELSE istate := normal;
; END;
; realescape: (* applying principle of not making funny connections *)
; BEGIN (* thus don't jam lastch to 0 & do dupsdone *)
; nxtch := escape; istate := emitzero;
; END;
; emitzero:
; BEGIN
; nxtch := 0;
; IF eof THEN istate := eofile
; ELSE IF getc = escape THEN istate := realescape
; ELSE istate := normal;
; END;
; eofile:
; nxtch := endfilemark;
; END; (* case *)
; END; (* nxtch *)
;
; Get next (repeat encoded) byte from input stream.
; Unlike the coding in SQZ/UNSQ the "number" of repeats is the
; total number, not just the number added to the initial one.
; The input char <escape> is represented as <escape> <0> and
; <ch> <escape> <n> represents n occurences of <ch> (3 <= n <= 255).
; The expander treats <escape> <1> and <escape> <2> correctly.
; a,f,d,e
nxtch: push h
lda lastch
mov d,a; save in d for all states
lhld istate
call xpchl; Cases return next state in hl
shld istate
pop h
ret
xpchl: pchl; implements "call (hl)"
;
; Normal state. hl contains "normal"
normal: call getc; Get next byte from phys input stream
jc eof; Br if no more data
cpi escape
jz escin
cmp d; Compare to last char
jnz chgst; chrs different, emit prev & continue
lxi h,duplic; Set next state to duplic.
; " "
; Change state to hl (may not be a change)
chgst: mov a,d; output previous lastch
ora a; Clear any carry, not eof
ret
;
; Special state change to delay EOF signal
eof: lxi h,eofile; next state is eofile
mov a,d; emit last char first
ora a
ret
;
; A second occurrence of the same character has been detected.
; So far only one occurrence has been output.
duplic: call getc; Get new byte from input stream
jc eof
cpi escape; (Repeats of 90H cannonot be packed)
jz escin
cmp d; Another repeat (3rd contiguous)?
lxi h,normal
jnz chgst; Only 2, back to normal
mvi a,escape; Jam output to escape
lxi h,repeat; Next state counts
ret; cy is clear
;
; Three contiguous occurrences of a byte been detected. The byte
; itself and the escape have already been output. Now it is time to
; suck up characters (up to 255 of them).
repeat: mov e,d; Byte to be matched will be kept in e
mvi d,3; Init d, repeat byte counter, to 3
rept1: call getc; Get next byte
jc eof
inr d; test max repeat byte counter
jz rept2; 255 contiguous occurrences
dcr d; form the real count so far
cpi escape; *** watch order of events here! ***
jz escin
inr d; finally count it, if still same
cmp e
jz rept1; still same, test next input
rept2: dcr d; re-adjust count
; " "
; Transfer to non-repeatable emission state
godun: lxi h,dupdun; Change to dupdun (cleanup)
mov a,d
ora a
ret
;
; Like normal state, but don't look for a match. Terminates repeat.
; (because the last byte output was a count).
dupdun: call getc; Get next character
jc eof
cpi escape
jz escin; escape encountered
lxi h,normal; Next state
mov a,d
ora a
ret
;
; "escape" has been encountered, byte before it has been output.
; Now output escape, followed by output 00h.
escout: mvi a,escape; State doesn't get another phys char
lxi h,emit00; Next state will emit the 0
ora a
ret
;
; escape has been encountered and output. Now output "00h"
emit00: call getc; Get next physical char
mvi d,0
jc eof
cpi escape
jnz godun; go emit the 0
; " "
; Escape char. appeared in input
escin: lxi h,escout; Set next state to escout
mov a,d
ora a
ret
;
; EOF has been encountered, and all bytes have been output.
; Set carry flag and return.
eofile: stc
ret
;
; ------ END of state machine ------
;
if trapit
; Emit a nul code. prechk has stacked the actual output code.
; This assumes nulcode really does break up the evil sequence,
; which may not be warranted. nulcode should have been 0, with
; a 2nd available nulcode of 0ffh to cater to all cases.
sndnul: lxi h,trpflg
mvi m,0; reset the flag. Only 1 recursion
lxi h,nulcod
endif
; " "
; Insert the pred now in HL into the output stream, length codlgh.
; This returns carry to indicate adaptive reset needed. If trpflg
; is set to 01h on exit, the output sequence trp1st,trp2nd has been
; detected, and it is up to the cruncher to take steps. Note that
; trpflg can take on other intermediate values (w/o ls bit set).
; Emits at least 1 (9 bit min codelgh), at most 2 (12 + 7 leftover)
; bytes of output code. The 2 byte case creates problems, because
; an 'inject nulcode' signal reaches the main system too late. In
; this case the prewarning flag is already set
; f,b,c,h,l
putcd: ora a; clear any carry
push psw
if trapit
lda trpflg
ora a
cnz prechk; If 01 must inject null, else watch out
jnc putcd1; no carry from prechk
pop psw
stc; preserve reset flag
push psw
putcd1:
endif
call setup
mov b,c; b := codlgh
putcd2: dad h; shift out bits
ral; from hl into a
jnc putcd4; not yet time to dump the contents
if trapit; check for bad output sequence
mov c,a
call trpchk
mov a,c
endif
call outb; Dump assembled byte
jnc putcd3; no reset signal found
pop psw; Set the reset flag
stc
push psw
putcd3: mvi a,01h; re-init to flag bit only
putcd4: dcr b
jnz putcd2; For as many bits as need to be output
sta csave; save any bits left over
lda codlen; "codlgh" always = "CODLEN" delayed
sta codlgh; -by one code output call. Update here.
pop psw
ret
;
; Setup a & hl to form next output byte(s). Set c := codlgh, b := 0
; a,f,b,c,h,l
setup: lda codlgh; Compute number of pre-shifts
mov c,a; c := codlgh
cma
adi 4+(maxcod+1)
mov b,a; b := 16 - codlgh (4..7)
setup1: dad h; position code at left of word
dcr b
jnz setup1;
lda csave; Get "leftover" bits from last time
ret
;
if trapit
; Check for anomolous sequence, next output in c (and a on entry)
; a,f (trpflg)
trpchk: ani 07fh
cpi trp2nd
jnz trpchk3; not a bad sequence
lda trpflg
ora a
jp trpchk3; not bad sequence, reset flag
mvi a,1; trp1st,trp2nd detected
jmp trpchk4; set injection flag
trpchk3: xra a
sta trpflg; clear any previous flag
mov a,c
ani 07fh
cpi trp1st
rnz; not a trap startup
mvi a,080h
trpchk4: sta trpflg; mark start of sequence
ret
;
; precheck. trpflg in a, is non-zero. New output code is in hl
prechk: push h; If minus then real precheck needed
jm prechk1; else trpflg=01, inject right now
call sndnul; which resets the flag
pop h; now this has to go
ret; If cy, then need reset
prechk1: call setup; take advance look at the next code
prechk2: dad h; form the next code to ship
ral; by shifting out from hl into a
jnc prechk2; For as many bits as need to be output
; " "
; Now, if the look ahead byte a is 'trp2nd' must inject nulcode,
; else go back and let the main system proceed
ani 07fh
sui trp2nd
ora a; make sure cy reset here
cz sndnul; which resets the flag, may return cy.
pop h; else leave it alone
ret; and now do the real output operation
endif
;
; Output byte (a) to output stream. Every 256th call to
; "outbyt" is made with the Z flag set, to signal any monitors.
; a,f
outb: push h
push d
push b
lxi h,outcnt; Minimize calls here
inr m
cz dincma; count output bytes
call outbyt
ora a; clear any carry (errors up to outbyt)
lxi h,outct2
inr m
cz chkadp; check adaptive reset
pop b
pop d
pop h
ret
;
; Get byte (a) from the input stream. Carry for eof
; a,f
getc: push h
push d
push b
lxi h,incnt
inr m
cz dincm; Count input bytes
lxi h,incnt2; This one may start over.
inr m
cz dincm; for adaptive operations
call getchr; Get a char into a
sta lastch; For encoder system
pop b
pop d
pop h
ret; With any carry from "getchr"
;
; Dincm with z flag preserved. Allows monitor signal to main
dincma: push psw
call dincm
pop psw
ret
;
; Increment 24 bit word hl+1^.
; f,h,l
dincm: inx h
inr m; carry, 2nd byte
rnz
inx h
inr m; carry, 3rd byte
rnz
inx h
inr m; MS byte. No more propagation
ret
;
; ------ The following code may be reused in UNC ------
;
; Clear the table
; a,f,b,c,e,h,l
preset: lhld @table; Beg of table (1st entry, first column)
mvi e,vacant; Init whole 1st column to empty flags
lxi b,tblroom
call fill
lxi b,3*tblroom + tblsize; Next 4 x 1400h locs all get 0s
; " "
; Fill hl^, length b, with 0
; a,f,b,c,e,h,l
fillz: mvi e,0
; " "
; Fill hl^, length b, with e
; a,f,b,c,h,l
fill: mov m,e
inx h
dcx b
mov a,b
ora c
jnz fill
ret
;
; Notes about the hashing. The "open-addressing, double hashing"
; scheme used, where the actual codes output are the logical entry#,
; contained in the table along with the entry itself, would normally
; make the codes output independent of the exact hashing scheme used
; (codes are simply assigned in order - their physical location is
; irrelevant). However, with code reassignment implemented, the
; re-assignments are obviously not made in any particular order, and
; are hash function dependent. Thus hash function must not be changed.
;
; Called with pred in HL (3 nybble quantity) and suffix in A (2
; nybbles). Exclusive or's the upper 2 nybbles of the pred with the
; suffix for the two ls nybbles of the result. The lower nybble of the
; pred becomes the highest of 3 nybble result. Adds one to that, as
; well as the table offset, resulting in a usable address, returned in
; HL. Also compute "DIFF", the secondary hash displacement value, as
; a negative number.
;
hash: mov e,l; Save low nybble of pred, used below
dad h
dad h
dad h
dad h; Shift whole pred value left 4 bits
xra h; Xor hi-byte of that with suffix
mov l,a; Goes there as lo-byte of result
mov a,e; Get pred(lo) saved above
ani 0fh; Want only low nybble of that
push h
lxi h,@table+1
add m; Convenient time to add in table offset
pop h
mov h,a; Goes here as hi-byte of result
inx h; Except add 1. Eliminates poss. of 0.
push h; Save hash val for return
xchg
lhld delta; holds -(5003 + (@table)).
dad d; de := tblsize - hash (no table offset)
shld disp; Secondary hash value, negative number.
pop h; Return orig hash address
ret
;
; Allocate memory, from de^ up. Minimum stk use (2 wds from call crn)
; to allow for main programs with insufficient stack allocation.
; Carry for any memory overflow. Returns hl = new stack ptr
; a,f,b,c,d,e,h,l
malloc: lxi h,255
dad d
mvi l,0; Round up to page boundary
shld @table
xchg
lxi b,-tblsize
mov a,c
sub e
mov l,a
mov a,b
sbb d
mov h,a
shld delta; -(tblsize+(@table))
xchg; hl := @table
lda arg
ani stkset
jz mallo1; Not using SP as memtop marker
; " "
; Ensure sufficient memory available, SP marks top available
mvi a,5 * (tblroom shr 8)
add h
mov d,a; top of table storage area + a bit
lxi h,2
dad sp; to return stack ptr on "call malloc"
lda spsave+1; proposed should be below existing
sub d; carry if insufficient memory
ret; (run time does dynamic checking)
;
; General purpose allocation, assign our own stack space
mallo1: mvi a,pages; for table and stack
add h
mov h,a; proposed stack top
lda @memtop+1; top page of memory +1
sui slop; allow for CCP retention etc.
sub h
rc; Too big
lda spsave+1
sub h
rnc; original stack above our area, ok
xchg
lhld spsave
xchg; (@table was rounded up to fresh page)
lda @table+1; Ensure orig stack below table area
inr d; equal is not good enough
sub d; carry if insufficient memory
ret
;
; --- END of reusable code area ---
;
; This implements the adaptive reset criteria.
;
; Advance OUTCT2 = hl^ (adaptive counter for output). Can check
; INCNT2 if desired, may zero both counters, and returns carry
; to request an adaptive reset. Called ONLY from outbyt when
; the ls byte of outct2 has just rolled over (to 0). The carry
; has NOT been propagated yet. Carry is clear on entry.
;
; Since called only once per 256 output bytes, this can afford
; to use the full multiply divide cycle (about 1.5 Millisec at
; 2 Mhz clocks). The delays will be trivial, especially since
; this usually corresponds to about 512 input bytes.
;
; This is designed to allow "fooling around" with the stategy
; at a higher coding level, to optimize the squeezing ratios.
;
; The useful discrete values and their effects
; value lgh fld ra fld reset allowed when
; ----- ------ ------- ------------------
; 0 0 0 codlen reaches 10
; 1 1=11 0 codlen reaches 11
; 2 2=12 0 codlen reaches 12
; 3 3=13 0 No adaptive resets allowed
; 4 0 1 table full and 1024 reassignments
; 8 0 2 " " 2048 "
; 12 0 3 " " 3072 "
; 14 Any time
; 15 Whenever table full
; a,f,b,c,d,e,h,l (available)
chkadp: call dincm; outct2 pointer passed in
lda arg
ani 0fh; Strategy field
cpi 0fh
jz chka1; 0fh = original strategy
cpi 0eh
jz chka2; Whenever ratio allows
mov b,a
ani lghfld
adi 10; Bits 0/1 are codelen field
mov c,a; Range 10..13
; " "
; Use values 10..13 to inhibit reset unless (codlen >= value)
; i.e. 10 allows reset when codlgh reaches 10, 13 inhibits any
; resets being generated.
; or up, etc.
lda codlen; 9..12
sub c
cmc
rnc; length not above criteria
; " "
; Field values 0..3 specify the minimum (* 1 k) number of code
; reassignments that must be performed before resetting.
; A non-zero value here effectively forces the above codlen=12
mov a,b
ani rafield
mov c,a; range 0, 4, 8, 12
lda ttotal+1; high byte
sub c
cmc
rnc; count not at criterion
jmp chka2; bypass fulflg check
chka1: lda fulflg; original algorithm
ora a
rz; Not full, no reset
; " "
; Check the squeezing efficiency, incremental since last reset.
chka2: lhld incnt2+1; In 256 byte blocks (truncated)
push h
lhld outct2+1
xchg
lxi b,100
call .imul
pop b
call .idiv; de := percentage, assumed < 255
mov a,d
ora a
jnz chka6; >255%, reset it
lda lowper
cmp e
jnc chka9; ratio got smaller, record it
inr a
sub e
rnc; change <= 1%, not enough
chka6: lxi h,incnt2
lxi b,ctrspc
call fillz; zero the incrmental counters
stc
ret; carry signals reset needed
chka9: mov a,e
sta lowper; ratio got smaller
ret
;
; -----------
;
dseg; DATA area. Preserves any word alignment.
;
zerobgn equ $; BEGIN of initially zeroed area
;
; Output machine
codlen: ds 1; mincod..maxcod only; Lgh after current output.
codlgh: ds 1; " " ". Current output length
csave: ds 1; Bits (& marker) not yet emitted
;
; Input machine
lastch: ds 1; input awaiting use
istate: ds 2; Current state, a routine pointer.
;
; Encoding variables
disp: ds 2; -ve displacement for rehashing
nxtcod: ds 2; (formerly 'entry'). Next to be assigned.
trgmsk: ds 1; target mask. When code hi byte = advance lgh.
fulflg: ds 1; set when table full. Marks reassignment phase
;
; Counters. Allow for CPM3 files and communications systems.
; Maintain the in/out order, may be used in code.
ttotal: ds 2; codes reassigned
incnt: ds 4; bytes received, total
outcnt: ds 4; bytes emitted, total
incnt2: ds 4; bytes received, incremental.
outct2: ds 4; bytes emitted, incremental.
ctrspc equ $-incnt2; storage for incremental counters only
lowper: ds 1; For adaptive reset trigger calculations
;
; "Ugly" detection in re-assignment phase
lsufx: ds 1; last suffix
lpr: ds 2; last pred
;
; Communications. sequence trapping
if trapit; also keep word aligned
trpflg: ds 1; zero if no 0dh output detected
ds 1; -ve if 0dh detected, but not trapped
endif; 01 when sequence 0dh 040h detected
;
zeroend equ $; END of initially zeroed area
;
; table storage location related variables
@table: ds 2; location of master table
avail: ds 2; for reassignment. 0 if none. An address.
delta: ds 2; Precalculated displacement for hashing
; (-tblsize-table)
spsave: ds 2; entry sp
;
; Input argument, for strategy, allocation mechanism, etc.
arg: ds 1; 0fh value is similar to CRUNCH23
ds 1; spare data byte, keep aligned.
end
6X
