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
/
UNZIP12.ARK
/
UNZIP12.Z
< prev
Wrap
Text File
|
1989-09-27
|
17KB
|
1,417 lines
.var STRSIZ 256
.var EXTRACT 'E'
.var bdos 5
.var open 0x0f
.var close 0x10
.var read 0x14
.var write 0x15
.var create 0x16
.var setdma 0x1a
.var infcb 0x5c
.var DLE 144
.var max_bits 13
.var init_bits 9
.var hsize 8192
.var first_ent 257
.var clear 256
.var maxcmax 1 << max_bits
jr start
db '\r'
usage: db 'Usage: UNZIP ZIPFILE [E]\r\n'
db 'E - extract files\r\n'
db ' default is to just list files\r\n\0',0x1a
start: ld sp,(6) ; set the stack pointer
call ilprt
db 'UNZIP V1.2 - DPG 1990\r\n\n\0'
ld a,(0x5d) ; filename?
cp ' '
jr nz,wasfil
ld hl,usage
call pstr
rst 0
wasfil: ld a,(0x6d) ; option letter?
.useg
mode: ds 1
.dseg
zipeof: db 2
counting:
db 0
.cseg
xor EXTRACT ; 'E' for extract
ld (mode),a ; set the mode
ld a,(0x65)
cp 0x20
jr nz,wasext
ld hl,['I' << 8] + 'Z'
ld (0x65),hl
ld a,'P'
ld (0x67),a ; install .ZIP extent
wasext: ld de,0x5c
ld c,open
call bdos ; try and open it
inc a
jr nz,openok ; ok
call ilprt
db 'Couldn\'t find ZIP file\r\n\0'
rst 0 ; complain and exit
sigerr: call ilprt
db 'Bad signature in ZIP file\r\n\0'
rst 0
openok: call getword
ld de,-[['K' << 8] + 'P']
add hl,de
ld a,h
or l
jr nz,sigerr
call getword
dec l
jr nz,nocfhs
dec h
dec h
jr nz,sigerr
call pcfh
jr openok
nocfhs: dec l
dec l
jr nz,nolfhs
ld a,h
sub 4
jr nz,sigerr
call plfh
jr openok
nolfhs: dec l
dec l
jr nz,sigerr
ld a,h
sub 6
jr nz,sigerr
call pecd
rst 0
pcfh: ld b,12
pcfhl1: push bc
call getword
pop bc
djnz pcfhl1
call getword
push hl
call getword
push hl
call getword
pop de
pop bc
push hl
push de
push bc
ld b,6
pcfhl2: push bc
call getword
pop bc
djnz pcfhl2
pop hl
ld de,junk
.useg
junk: ds STRSIZ
.cseg
call getstring
pop hl
ld de,junk
call getstring
pop hl
ld de,junk
call getstring
ret
pecd: ld b,8
pecdl: push bc
call getword
pop bc
djnz pecdl
call getword
ld de,junk
call getstring
ret
.useg
lfh:
vnte: ds 2
gpbf: ds 2
cm: ds 2
lmft: ds 2
lmfd: ds 2
crc: ds 4
cs: ds 4
ucs: ds 4
fnl: ds 2
efl: ds 2
endlfh:
ds 1
.cseg
plfh: ld de,lfh
ld hl,{endlfh - lfh}
call getstring
ld hl,opfcb
ld de,opfcb + 1
ld bc,32
ld (hl),b
ldir
.useg
opfcb: ds 1
opfn: ds 8
opext: ds 3
ds 4 + 16 + 1
.cseg
ld de,junk
ld hl,(fnl)
call getstring
ld de,junk + 20
ld hl,(efl)
call getstring
ld de,junk
ld hl,opfn
ld b,8
call scanfn
ld a,(de)
cp '.'
jr nz,nodot
inc de
nodot: ld b,3
call scanfn
ld hl,init
ld de,vars
ld bc,{endinit - init}
ldir
.useg
bitbuf: ds 1
.useg
vars:
.dseg
init:
.useg
bleft: ds 1
.dseg
db 0
.useg
wrtpt: ds 1
.dseg
db 0
.useg
outpos: ds 4
.dseg
dw 0,0
.useg
crc32:
ds 4
.dseg
dw -1,-1
endinit:
.useg
curmode:
ds 1
.cseg
ld a,(mode)
resmod: ld (curmode),a
or a
jr nz,extrct
ld de,opfcb
ld c,0x0f
call bdos
inc a
jr z,creok
ld hl,junk
call pstr
call ilprt
db ' already exists\0'
noex: call ilprt
db ' -- not extracting\0'
ld a,0xff
jr resmod
extrct: xor a
ld (zipeof),a
ld a,(curmode)
dec a
jp m,doext
call ilprt
db 'Checking \0'
jr pjunk
creok: ld de,opfcb
ld c,create
call bdos
inc a
jr nz,opnok1
call ilprt
db 'Error creating \0'
ld hl,junk
call pstr
jr noex
opnok1: call ilprt
db 'Extracting \0'
pjunk: ld hl,junk
call pstr
doext: call ilprt
db ' -- \0'
ld hl,counting
inc (hl)
ld a,(cm)
or a
jr nz,case1
case0w: ld a,(zipeof)
and 1
jr nz,closeo
savcs0: call getbyte
call outbyte
jr case0w
case1: dec a
jr nz,case2p
call unshrink
jr closeo
case2p: dec a
cp 4
jr nc,tryimp
call unreduce
jr closeo
tryimp: jr nz,badzip
call unimplode
jr closeo
badzip: call ilprt
db 'Unknown compression method\r\n\0'
ret
closeo: ld hl,zipeof
dec (hl)
inc hl
dec (hl)
ld a,(mode)
or a
jr nz,nocls
ld hl,wrtpt
ld a,(hl)
or a
jr z,noflsh
ld de,opbuf
.useg
opbuf: ds 128
.cseg
ld c,setdma
call bdos
ld de,opfcb
ld c,write
call bdos
noflsh: ld de,opfcb
ld c,close
call bdos
nocls: ld hl,crc32
ld de,crc
scf
ld bc,4 << 8
crcclp: ld a,(de)
adc a,(hl)
push af
or c
ld c,a
pop af
inc hl
inc de
djnz crcclp
ld a,c
or a
jr z,crcok
call ilprt
db 'CRC error\r\n\0'
ret
crcok: call ilprt
db 'CRC OK\r\n\0'
ret
getchla:
call getcode
ld (code),hl
ld a,(zipeof)
and 1
ret
savstk:
ld hl,(stackp)
dec hl
ld (stackp),hl
ld (hl),a
ret
getcode:
ld a,(codesize)
readbits:
ld hl,0x8000
bitlp: push af
push hl
getbit: ld hl,bleft
dec (hl)
jp m,readbt
dec hl
rr (hl)
pop hl
rr h
rr l
pop af
dec a
jr nz,bitlp
finbit: srl h
rr l
jr nc,finbit
ld a,l
ret
readbt: push hl
call getbyte
pop hl
ld (hl),8
dec hl
ld (hl),a
jr getbit
scanfn: ld a,(de)
cp '.'
jr z,nocopy
or a
jr z,nocopy
inc de
dec b
jp m,scanfn
ld (hl),a
inc hl
jr scanfn
nocopy: dec b
ret m
ld (hl),' '
inc hl
jr nocopy
ilprt: pop hl
call pstr
jp (hl)
pstr: ld a,(hl)
or a
ret z
push hl
ld e,a
ld c,2
call bdos
pop hl
inc hl
jr pstr
getstring:
ld a,h
or l
ld (de),a
ret z
push de
push hl
call getbyte
pop hl
pop de
ld (de),a
inc de
dec hl
jr getstring
getword:
call getbyte
push af
call getbyte
pop hl
ld l,h
ld h,a
ret
getbyte:
ld a,(zipeof)
and 1
ld a,0x1a
ret nz
ld a,(counting)
or a
jr z,skpdci
ld hl,(cs)
ld de,(cs + 2)
ld a,d
or e
or h
or l
jr nz,noteof
ld hl,zipeof
inc (hl)
ld a,0x1a
ret
noteof: ld a,h
or l
dec hl
ld (cs),hl
jr nz,skpdci
dec de
ld (cs + 2),de
skpdci: ld hl,readpt
.dseg
readpt: db 0
.cseg
ld a,(hl)
or a
jr nz,ptok
ld de,0x80
ld (hl),e
push hl
ld c,setdma
call bdos
ld de,infcb
ld c,read
call bdos
or a
pop hl
jr nz,ateof
ptok: ld a,(hl)
inc (hl)
ld l,a
ld h,0
ld a,(hl)
ret
ateof: ld a,0x1a
ret
outb:
ld hl,(outpos)
push hl
push af
ld a,h
and 0x1f
ld h,a
pop af
ld de,outbuf
add hl,de
ld (hl),a
pop hl
inc hl
ld (outpos),hl
push af
ld a,h
or l
jr nz,nopos
ld hl,(outpos + 2)
inc hl
ld (outpos + 2),hl
nopos: pop af
outbyte:
push af
call updcrc
ld hl,(ucs)
ld de,(ucs + 2)
ld a,h
or l
dec hl
ld (ucs),hl
jr nz,tsthl0
dec de
ld (ucs + 2),de
tsthl0: ld a,h
or l
or d
or e
jr nz,noeof
ld hl,zipeof
inc (hl)
noeof: ld a,(mode)
or a
jr nz,popret
ld hl,wrtpt
ld a,(hl)
add a,a
jr nc,wptok
ld de,opbuf
ld c,setdma
call bdos
ld de,opfcb
ld c,write
call bdos
or a
jr z,wptok
ld (mode),a
call ilprt
db 'Write Error\r\n\0'
popret: pop af
ret
wptok: jr nz,nofilb
ld hl,opbuf
ld de,opbuf + 1
ld bc,127
ld (hl),0x1a
ldir
xor a
ld (wrtpt),a
nofilb: pop af
ld hl,wrtpt
inc (hl)
ld l,(hl)
ld h,0
ld de,opbuf - 1
add hl,de
ld (hl),a
ret
updcrc: ld hl,(crc32)
ld de,(crc32 + 2)
ld c,a
ld b,8
crclp: ld a,l
xor c
srl c
srl d
rr e
rr h
rr l
rra
jr nc,noxor
ld a,d
xor 0xed
ld d,a
ld a,e
xor 0xb8
ld e,a
ld a,h
xor 0x83
ld h,a
ld a,l
xor 0x20
ld l,a
noxor: djnz crclp
ld (crc32),hl
ld (crc32 + 2),de
ret
unshrink:
ld a,init_bits
ld (codesize),a
ld hl,[1 << init_bits] - 1;
ld (maxcode),hl
ld hl,first_ent
ld (free_ent),hl
ld hl,prefix_of
ld de,prefix_of + 1
ld bc,512
ld (hl),c
ldir
ld bc,16386 - 512
ld (hl),-1
ldir
ld hl,suffix_of
sol: ld (hl),c
inc hl
inc c
jr nz,sol
call getchla
ld (oldcode),hl
ret nz
ld a,l
ld (finchar),a
call outbyte
unshlp: ld hl,stack + 8192
ld (stackp),hl
ld a,(zipeof)
and 1
ret nz
clrlp: call z,getchla
ret nz
ld a,h
dec a
or l
jr nz,noclr
call getchla
ld a,h
or a
jr nz,clrlp
dec l
jr z,bumpcs
dec l
call z,partial_clear
jr clrlp
bumpcs: ld hl,codesize
inc (hl)
ld a,(hl)
cp max_bits
ld hl,maxcmax
jr z,atmax
ld hl,1
maxclp: add hl,hl
dec a
jr nz,maxclp
dec hl
atmax: ld (maxcode),hl
jr clrlp
noclr: ld (incode),hl
add hl,hl
ld de,prefix_of
add hl,de
ld a,(hl)
inc hl
and (hl)
inc a
ld hl,(code)
jr nz,noKwKw
ld a,(finchar)
call savstk
ld hl,(oldcode)
noKwKw: ex de,hl
staklp: ld hl,suffix_of
add hl,de
ld a,(hl)
call savstk
ld hl,0x0100
or a
sbc hl,de
jr nc,unstak
ld hl,prefix_of
add hl,de
add hl,de
ld e,(hl)
inc hl
ld d,(hl)
jr staklp
unstak: ld (finchar),a
ld de,(stackp)
unslp: ld hl,stack + 8192
or a
sbc hl,de
jr z,newent
ld a,(de)
inc de
push de
call outbyte
pop de
jr unslp
newent: ld hl,(free_ent)
ld (code),hl
ex de,hl
ld hl,0x1fff
or a
sbc hl,de
jr c,full
ld hl,prefix_of
add hl,de
add hl,de
ld bc,(oldcode)
ld (hl),c
inc hl
ld (hl),b
ld hl,suffix_of
add hl,de
ld a,(finchar)
ld (hl),a
getfre: inc de
ld hl,0x1fff
or a
sbc hl,de
jr c,full1
ld hl,prefix_of
add hl,de
add hl,de
ld a,(hl)
inc hl
and (hl)
inc a
jr nz,getfre
full1: ld (free_ent),de
full: ld hl,(incode)
ld (oldcode),hl
jp unshlp
partial_clear:
ld de,first_ent
l8: ld hl,(free_ent)
or a
sbc hl,de
jr z,br8
ld hl,prefix_of + 1
add hl,de
add hl,de
set 7,(hl)
inc de
jr l8
br8: ld de,first_ent
l9: ld hl,(free_ent)
or a
sbc hl,de
jr z,br9
ld hl,prefix_of
add hl,de
add hl,de
push de
ld e,(hl)
inc hl
ld d,(hl)
res 7,d
ld hl,first_ent - 1
or a
sbc hl,de
jr nc,ei10
ld hl,prefix_of + 1
add hl,de
add hl,de
res 7,(hl)
ei10: pop de
inc de
jr l9
br9: ld de,first_ent
l10: ld hl,(free_ent)
or a
sbc hl,de
jr z,br10
ld hl,prefix_of + 1
add hl,de
add hl,de
bit 7,(hl)
jr z,ei11
ld (hl),-1
dec hl
ld (hl),-1
ei11: inc de
jr l10
br10: ld de,first_ent
l11: ld hl,maxcmax
or a
sbc hl,de
jr z,br11
ld hl,prefix_of
add hl,de
add hl,de
ld a,(hl)
inc hl
and (hl)
inc a
jr z,br11
inc de
jr l11
br11: ld (free_ent),de
ret
loadfollowers:
ld hl,Slen + 255
ld b,0
lflp: push bc
push hl
ld a,6
call readbits
pop hl
pop de
ld (hl),a
push de
push hl
dec d
ld hl,followers
call shftadd
ld b,a
or a
jr z,nofoll
ldfllp: push hl
push bc
ld a,8
call readbits
pop bc
pop hl
ld (hl),a
inc hl
djnz ldfllp
nofoll: pop hl
pop bc
dec hl
djnz lflp
ret
.dseg
_L_table:
db 0x7f, 0x3f, 0x1f, 0x0f
_D_shift:
db 0x07, 0x06, 0x05, 0x04
.useg
L_table:
ds 1
D_shift:
ds 1
.cseg
unreduce:
.useg
V: ds 1
nchar: ds 1
lchar: ds 1
ExState:
ds 1
Len: ds 2
.cseg
ld e,a
ld d,0
ld hl,_L_table
add hl,de
ld a,(hl)
ld (L_table),a
ld hl,_D_shift
add hl,de
ld a,(hl)
ld (D_shift),a
xor a
ld (ExState),a
ld (lchar),a
call loadfollowers
ur1: ld a,(zipeof)
and 1
ret nz
call slenlch
or a
jr nz,ur2
ur4: ld a,8
call readbits
jr ur3
ur2: ld a,1
call readbits
dec l
jr z,ur4
call slenlch
dec a
or 1
ld l,a
xor a
btlp: inc a
srl l
jr nz,btlp
call readbits
ld de,followers
add hl,de
ld de,(lchar - 1)
call shftadd
ld a,(hl)
ur3: ld (nchar),a
ld l,a
ld a,(ExState)
or a
jr nz,ur5
ld a,l
cp DLE
jr nz,ur9
ld a,1
ld (ExState),a
jr ur6
ur5: dec a
jr nz,ur7
ld a,l
or a
jr z,ur10
ld (V),a
ld a,(L_table)
ld h,a
and l
cp h
ld l,a
ld h,0
ld (Len),hl
jr nz,ur12
ld a,2
jr ur11
ur10: ld (ExState),a
ld a,DLE
ur9: call outb
jr ur6
ur7: dec a
jr nz,ur8
ld a,l
ld hl,Len
add a,(hl)
ld (hl),a
jr nc,ur12
inc hl
inc (hl)
ur12: ld a,3
jr ur11
ur8: dec a
jr nz,ur13
ld a,(D_shift)
ld b,a
ld a,(V)
ur14: srl a
djnz ur14
ld h,a
inc hl
ld bc,(Len)
inc bc
inc bc
inc bc
call callback
ur13: xor a
ur11: ld (ExState),a
ur6: ld a,(nchar)
ld (lchar),a
jp ur1
slenlch:
ld hl,(lchar)
ld h,0
ld de,Slen
add hl,de
ld a,(hl)
ret
shftadd:
ld e,0
srl d
rr e
srl d
rr e
add hl,de
ret
callback:
push bc
push hl
ld hl,(outpos)
ld de,(outpos + 2)
pop bc
or a
sbc hl,bc
jr nc,cb2
dec de
cb2: pop bc
cb3: bit 7,d
jr z,cb4
ld a,b
or c
jr z,cb4
xor a
call outbp
inc hl
ld a,h
or l
jr nz,cb5
inc de
cb5: dec bc
jr cb3
cb4: ex de,hl
cb6: ld a,b
or c
ret z
ld a,d
and 0x1f
ld d,a
ld hl,outbuf
add hl,de
ld a,(hl)
call outbp
inc de
dec bc
jr cb6
outbp: push hl
push de
push bc
call outb
pop bc
pop de
pop hl
ret
.var maxSF 256
.var _code 0
.var _value 2
.var _bitlength 3
.var _entries 0
.var _maxlength 2
.var _entry 4
.var _sf_tree_ 4 + 4 * maxSF
.useg
ltp: ds 1
mml: ds 1
dictb: ds 1
noswps: ds 1
.cseg
readlengths:
ld a,8
call readbits
ld d,h
ld e,d
inc hl
ld b,h
ld c,l
ld (ix + _maxlength),e
ld (ix + _maxlength + 1),d
push ix
pop hl
inc hl
inc hl
inc hl
rl1: ld a,b
or c
ret z
push bc
push de
push hl
ld a,4
call readbits
inc a
push af
ld a,4
call readbits
inc a
ld b,a
pop af
ld c,a
pop hl
pop de
ld a,(ix + _maxlength)
cp c
jr nc,rl2
ld (ix + _maxlength),c
rl2: inc hl
inc hl
inc hl
ld (hl),e
inc hl
ld (hl),c
inc e
djnz rl2
pop bc
dec bc
jr rl1
sortlengths:
ld h,(ix + _entries + 1)
ld l,(ix + _entries)
ld b,h
ld c,l
ld (entrs),hl
.useg
entrs: ds 2
.cseg
sl7: srl b
rr c
sl1: ld a,b
or c
ret z
ld (noswps),a
push ix
ld de,4
add ix,de
push ix
pop iy
add iy,bc
add iy,bc
add iy,bc
add iy,bc
ld hl,(entrs)
or a
sbc hl,bc
sl2: ld a,(ix + _bitlength)
cp (iy + _bitlength)
jr c,sl4
jr nz,sl3
ld a,(iy + _value)
cp (ix + _value)
jr nc,sl4
sl3: ld d,e
sl5: ld a,(ix)
push af
ld a,(iy)
ld (ix),a
pop af
ld (iy),a
inc ix
inc iy
dec d
jr nz,sl5
ld a,d
ld (noswps),a
jr sl6
sl4: add ix,de
add iy,de
sl6: dec hl
ld a,h
or l
jr nz,sl2
pop ix
ld a,(noswps)
or a
jr nz,sl7
jr sl1
.useg
lbl: ds 1
.cseg
generatetrees:
ld l,(ix + _entries)
ld h,(ix + _entries + 1)
ld c,l
ld b,h
push ix
pop de
add hl,hl
add hl,hl
add hl,de
push hl
pop iy
xor a
ld d,a
ld e,a
ld h,a
ld l,a
ld (lbl),a
gt1: ld a,b
or c
ret z
dec bc
add hl,de
ld a,(lbl)
cp (iy + _bitlength)
jr z,gt2
ld a,(iy + _bitlength)
ld (lbl),a
sub 16
ex de,hl
ld hl,1
jr z,gt3
gt4: add hl,hl
inc a
jr nz,gt4
gt3: ex de,hl
gt2: ld (iy + _code),l
ld (iy + _code + 1),h
push de
ld de,-4
add iy,de
pop de
jr gt1
ldtrees:
ld a,(gpbf)
rra
ld l,a
and 1
add a,6
ld (dictb),a
ld a,l
rra
and 1
ld (ltp),a
set 1,a
ld (mml),a
ld ix,lit_tree
ld hl,256
call nz,ld_tree
ld hl,64
ld ix,len_tree
call ld_tree
ld hl,64
ld ix,dist_tre
ld_tree:
ld (ix + _entries),l
ld (ix + _entries + 1),h
call readlengths
call sortlengths
call generatetrees
reversebits:
push ix
pop hl
ld e,(hl)
inc hl
ld d,(hl)
rb1: inc hl
inc hl
inc hl
ld c,(hl)
ld b,8
rb2: srl c
adc a,a
djnz rb2
push af
inc hl
ld c,(hl)
ld b,8
rb3: srl c
adc a,a
djnz rb3
dec hl
ld (hl),a
pop af
inc hl
ld (hl),a
dec de
ld a,d
or e
jr nz,rb1
ret
readtree:
push ix
pop iy
ld de,4
add iy,de
ld b,d
ld e,d
ld h,d
ld l,d
rt1: push hl
push de
push bc
ld a,1
call readbits
pop af
push af
or a
jr z,rt2
rt3: add hl,hl
dec a
jr nz,rt3
rt2: pop bc
pop de
add hl,de
ex de,hl
inc b
pop hl
rt4: ld a,(iy + _bitlength)
cp b
jr nc,rt5
push de
ld de,4
add iy,de
pop de
inc hl
ld a,(ix + _entries)
sub l
jr nz,rt4
ld a,(ix + _entries + 1)
sub h
jr nz,rt4
rt6: dec a
ret
rt5: ld a,(iy + _bitlength)
cp b
jr nz,rt1
ld a,(iy + _code)
cp e
jr nz,rt7
ld a,(iy + _code + 1)
cp d
jr nz,rt7
ld a,(iy + _value)
ret
rt7: push de
ld de,4
add iy,de
pop de
inc hl
ld a,(ix + _entries)
sub l
jr nz,rt5
ld a,(ix + _entries + 1)
sub h
jr nz,rt5
jr rt6
unimplode:
call ldtrees
ui1: ld a,(zipeof)
and 1
ret nz
inc a
call readbits
or a
jr z,ui2
ld a,(ltp)
or a
jr z,ui3
ld ix,lit_tree
call readtree
jr ui4
ui3: ld a,8
call readbits
ui4: call outb
jr ui1
ui2: ld a,(dictb)
call readbits
push hl
ld ix,dist_tre
call readtree
ld bc,(dictb - 1)
ui5: add hl,hl
djnz ui5
pop bc
add hl,bc
push hl
ld ix,len_tree
call readtree
ld l,a
ld h,0
cp 63
jr nz,ui6
push hl
ld a,8
call readbits
pop de
add hl,de
ui6: ld de,(mml)
ld d,0
add hl,de
ld b,h
ld c,l
pop hl
inc hl
call callback
jr ui1
.useg
oldcode:
ds 2
offset:
ds 2
codesize:
ds 1
maxcode:
ds 2
free_ent:
ds 2
finchar:
ds 1
stackp:
ds 2
incode:
ds 2
code:
ds 2
outbuf:
suffix_of:
ds 8192
prefix_of:
Slen:
lit_tree:
ds _sf_tree_
len_tree:
ds _sf_tree_
dist_tre:
ds _sf_tree_
ds 16384 + 2 - [3 * _sf_tree_]
followers:
stack:
ds 16384