;кодирование 9bit (8+1):
;plain chr 0..255=-0..FF
; rept 256 =+0
;olddisp 257..260=+1..4,len8
; len=2 261..268=+5..C,-disp8
; tree 269 =+D
;len3-10 270..277=+E..15,-disp16
; len>10 278..297=+16..29,len8,-disp16
;при переполнении 9bit буфера нужны (todo) новые деревья
;todo смешанный поток (или он уже смешанный?)
PUT0
OR A
PUTBIT
PUSH HL
LD HL,PUTBITC
DEC (HL) ;??? TODO
JR Z,PUTBITZ
INC (HL)
RL (HL)
JR NC,POPHL
BITADR=$+1
LD HL,0
PUSH AF
PUTBITC=$+1
LD A,0
CALL CORRHL
POP AF
LD HL,PUTBITC
LD (HL),1
POP HL
RET
PUTBITZ INC (HL)
RL (HL)
LD HL,(PUTBITB)
LD (BITADR),HL
INCHL INC HL
LD (PUTBITB),HL
POPHL POP HL
RET
CORRHL
;hl=c000..>0 (переходим на pak9)??? TODO продолжать дальше в страницах
PUSH AF
LD A,H
ADD A,pak9/256
JR NC,_B0
EXX
;OUT (C),H
ld a,pgLZ
call OUTME
EXX
LD A,H
_B0 LD H,A
POP AF
LD (HL),A
EXX
;OUT (C),L
push af
call OUTpgTEXT
pop af ;TODO надо ли?
EXX
RET
;todo LDAMINCHL (+18t/b)
INCH
INC H
RET NZ
LD H,pak9/256
PUSH AF
CALL OUTpgTEXT ;TODO продолжать по страницам
POP AF
RET
NACH3
LD A,#7F
IN A,(-2)
RRA
jr C,$+7
LD A,#FE
IN A,(-2)
RRA ;TODO fix
JP NC,quitoperation;RELOAD
ld A,(KOLODIN)
OR A
JR NZ,LZPUT
LD HL,(TEKADR)
NEPAK ;NC
IF sureLE
EXX
;OUT (C),L
call OUTpgTEXT
EXX
ENDIF
LD A,(HL)
INC HL
PUTBYTi
PUSH AF,DE,HL
LD L,A
LD H,0
RL H
ADD HL,HL
LD DE,frqs
ADD HL,DE
INC (HL)
JR NZ,$+4
INC HL
INC (HL)
POP HL,DE,AF
CALL PUTBIT
PUTBYTE
PUSH HL
PUTBITB=$+1
LD HL,0
PUSH HL
CALL CORRHL
POP HL ;TODO надо ли сохранять A?
JR INCHL
LZPUT2
IF dolds
;эту и 3 пред.ссылки потом не повторять, иначе нельзя opt2s
LD A,#F0
LD (LZnorep+1),A ;HSB
ENDIF
LD A,E
CALL LZLITPP
LD A,C
SCF
CALL PUTBYTi
LD A,E
CALL PUTBYTE
JP LZPUTQ
LZPUT
SMESH=$+1
LD DE,0
;;
IF dolds
LD HL,doldson
BIT 0,(HL) ;" "/"+"
JR Z,LZn256
LZnorep=$+1
LD HL,0
ADD HL,HL
LD (LZnorep),HL
OLDSMES=$+1
LD HL,0
JR C,LZn256
CP 5 ;10
JR C,LZn256
;OR A
SBC HL,DE
LD C,1
JR Z,LZ256
INC C
OL2SMES=$+1
LD HL,0
OR A
SBC HL,DE
JR Z,LZ257
INC C
OL3SMES=$+1
LD HL,0
OR A
SBC HL,DE
JR Z,LZ257
INC C
OL4SMES=$+1
LD HL,0
OR A
SBC HL,DE
JR NZ,LZn256
LZ257
LD H,D ;SMESH/256
INC H
JR Z,LZ257nd ;disp=1..256
DEC A ;disp>=257
LD HL,#1FFF
ADD HL,DE
JR C,$+3
DEC A ;disp>=#2000
LZ257nd
PUSH AF
LD A,C
SCF
CALL PUTBYTi
ld A,(KOLODIN)
CALL PUTBYTE
POP AF
CALL PUTBYTE
CALL LZMID
LD A,C
;A=rd code
ADD A,A
ADD A,rdfrq&0xff
LD L,A
LD H,rdfrq/256
INC (HL)
JR NZ,$+4
INC HL
INC (HL)
JR LZPUTQ
LZ256
OLDKOL=$+1
CP 0
JR NZ,LZ257
;;;CP 20
;;;JR C,LZn256
XOR A
SCF
CALL PUTBYTi
JR LZPUTQ
LZn256
ENDIF
CP 2
JP Z,LZPUT2
;;
LD HL,#1FFF
ADD HL,DE
JR C,$+3
DEC A ;>=#2000
CP 11
JR NC,LZPUT11
SUB 0xff&(3-270)
CALL PUTBYTi
LZDISP
LD A,E
CALL PUTBYTE
LD A,D
CALL PUTBYTE
;DE=-disp16
CALL LZDISPP
;A=dd code
ADD A,A
LD L,A
LD H,ddfrq/256
INC (HL)
JR NZ,$+4
INC HL
INC (HL)
LZPUTQ
ld A,(KOLODIN)
IF dolds
LD (OLDKOL),A
ENDIF
DEC A
LD LX,A
TEKADR=$+1
LD BC,0
;INC BC
;DEC A
;JR Z,oboitifilpo
;DEC BC
;LD (FILLSP),SP ;todo fix
;bc=текущий адрес
fILPO1 INC BC
LD H,B
ld L,C
IF sureLE
EXX
;OUT (C),L
call OUTpgTEXT
EXX
ENDIF
LD D,(HL)
RLC D
INC HL
LD A,(HL)
RRCA
XOR D
IF k3b
INC HL
XOR (HL)
DEC HL
ENDIF
LD E,A
XOR D
IF k256
OR #E0
ELSE
AND keymask
OR keys/512
ENDIF
LD D,A
EX DE,HL
ADD HL,HL
;LD SP,HL
IF k256
EXX
LD A,k256
;OUT (C),A
call OUTME
EXX
ENDIF
;hl=ключ*2
;de=адрес 3-го символа
;POP HL
;PUSH DE
;EX DE,HL
push de
ld a,(hl)
ld (hl),e
ld e,a
inc l
ld a,(hl)
ld (hl),d ;обновили голову цепочки
ld d,a
pop hl
;hl=адрес 3-го символа
;de=старое начало цепочки, прочитанное из хэш-таблицы
ADD HL,HL ;по 2 байта на символ
LD A,H
RLCA
RLCA
SET 7,H
set 6,H
EXX
AND 3;D
;IF k256
;ADD A,E
;ELSE
; CP 2
; SBC A,E
;ENDIF
;OUT (C),A
call OUTME
EXX
;дополняем цепочку новым адресом:
;LD SP,HL
;POP HL ;не важно
;PUSH DE
ld (hl),e
inc l
ld (hl),d ;ссылка на старое начало цепочки
IF sureLE==0
EXX
;OUT (C),L
call OUTpgTEXT
EXX
ENDIF
DEC LX
JR NZ,fILPO1
;FILLSP=$+1
; LD SP,0
;oboitifilpo
INC BC
IF dolds
;1:pkiNPOP
LZPUTQQ
LD HL,(OL3SMES)
LD (OL4SMES),HL
LD HL,(OL2SMES)
LD (OL3SMES),HL
LD HL,(OLDSMES)
LD (OL2SMES),HL
LD HL,(SMESH)
LD (OLDSMES),HL
ENDIF
LD H,B
ld L,C
;LZafter=$+1
;LD HL,0
RET
LZPUT11
;A=len (если disp>=#2000, то len-1)
;;;DEC A ;депакер увеличит
PUSH AF
DEC A
CALL LZMIDPP
LD A,C
SUB 0xff&(-270)
CALL PUTBYTi
POP AF
CALL PUTBYTE
JP LZDISP
CRUN0 LD A,R
ADD A,A ;иначе +10s
CALL Z,PR1234
POP DE
LD L,-1
CRUN1
;L=макс.длина ссылки
;DE=TEKADR
;lazy evaluation
CALL POISKm0
;;если там найдена ссылка, то она занесена в хэш-таблицу
;jr $
ld A,(KOLODIN)
OR A
CALL Z,FiND2
;;
CRUN2
LD HL,(TEKADR)
INC HL
EX DE,HL
LD HL,(INEND)
XOR A
SBC HL,DE
JP Z,NACH3 ;??? почему TODO
LD (TEKADR),DE ;!
OR H
JR NZ,CRUNLN1
LD A,L
ld (MAXPOSL),A
CRUNLN1
ld A,(KOLODIN)
IF fast0s
CP fast0s
CCF
JR C,NLQ ;пропускаем LE, если ссылка >=fast0s
;(ускоряет до 3 раз!)
OR A
CCF
ELSE
SCF
INC A
JR Z,NLQ
DEC A
ENDIF
;CY=1
LEflag JR Z,NLQ ;JR/JZ
LD HL,(SMESH)
PUSH HL
PUSH AF
CALL POISK
IF sureLE
LD (NLhl),HL
LD (NLbc),BC
ENDIF
POP BC
POP HL
ld A,(KOLODIN)
SCF
SBC A,B
JR Z,LONGn2
NLCP JR NC,LONGER
LD A,B
ld (KOLODIN),A
LD (SMESH),HL
IF sureLE
;POISK положил старый ключ в окно
;восстанавливаем
NLbc=$+1
LD BC,0
NLhl=$+1
LD HL,0
SPoldky=$+1
LD DE,0
LD A,(HL)
LD (DE),A
LD (HL),C
INC L
inc E
LD A,(HL)
LD (DE),A
LD (HL),B
ELSE
IF k256
EXX
LD A,k256
;OUT (C),A
call OUTME
EXX
ENDIF
ld HL,(LZoldky)
SPoldky=$+1
LD (0),HL
IF k256
EXX
;OUT (C),L
call OUTpgTEXT
EXX
ENDIF
ENDIF
JR NLQ ;CY
;1
LONGER ;NC
;новая ссылка лучше
;не кодировать byte и ссылку, а закодировать byte и подождать
LD HL,(TEKADR)
DEC HL
CALL NEPAK ;hl++
LD (TEKADR),HL ;не EOF, т.к. до 2-го поиска была проверка
JP CRUN2 ;пропуск поиска, т.к. он уже проведен
;
NLQ ;CY
LD HL,(TEKADR)
DEC HL
CALL NC,NEPAK ;hl++
LD (TEKADR),HL
;запись в output
;на основе TEKADR,KOLODIN и SMESH
CRUNNACH3
CALL NACH3
CRUNgo
;hl=TEKADR
LD (TEKADR),HL
EX DE,HL
INEND=$+1
LD HL,0
XOR A
SBC HL,DE
RET Z ;конец упаковываемого блока?
OR H
JR Z,CRUN1 ;осталось <256 байт ;L=макс.длина ссылки
INC A
PUSH DE
JP NZ,CRUN0 ;L будет=255
;осталось отрицательное число байт
jr $ ;TODO error
LONGn2
BIT 7,L
SETA=$+1
LD C,#FD
JR NZ,$+4 ;very short
SETB=$+1
LD C,#F4
LD A,H
INC A
JR Z,NO
BIT 7,L
SETC=$+1
LD C,#F0
IF nastr
JR NZ,$+4
SETD=$+1
LD C,#F0
ENDIF
INC A
JR Z,NO
SETE=$+1
LD C,#FA
IF nastr
INC A
JR Z,NO
INC A
SETF=$+1
LD C,#FA
JR Z,NO
ELSE
ADD A,2
JR C,NO
ENDIF
SETG=$+1
LD C,#F8
ADD A,2
JR C,NO
SETH=$+1
LD C,#F4
ADD A,2
JR C,NO
SETI=$+1
LD C,#F0
ADD A,4
JR C,NO
SETJ=$+1
LD C,#E8
ADD A,4
JR C,NO
SETK=$+1
LD C,#E0
ADD A,8
JR C,NO
SETL=$+1
LD C,#D0
ADD A,8
JR C,NO
SETM=$+1
LD C,#C0
ADD A,16
JR C,NO
SETN=$+1
LD C,#A0
ADD A,16
JR C,NO
SETO=$+1
LD C,#80
NO LD A,(SMESH+1)
CP C
JP NLCP
;;
;A=-dispL
LZLITPP
LD BC,#205
ADD A,4
RET C ;1..4
INC C
ADD A,4
RET C ;5..8
INC C
INC B ;3
ADD A,8
RET C ;9..#10
INC C
INC B ;4
ADD A,16
RET C ;11..20
INC C
INC B ;5
ADD A,32
RET C ;21..40
INC C
INC B ;6
ADD A,64
RET C ;41..80
INC C
ADD A,64
RET C ;81..C0
INC C
ADD A,64
RET ;C1..100
LZMID
LD B,0
CP 10
JR NC,LZMIDPP
SUB 2
LD C,A
XOR A
RET ;2..9
;;
LZMIDPP
NEG
LD BC,#108
ADD A,11
RET C ;A..B
INC C
ADD A,2
RET C ;C..D
INC C
ADD A,2
RET C ;E..F
INC C
ADD A,2
RET C ;10..11
INC C
INC B ;2
ADD A,4
RET C ;12..15
INC C
ADD A,4
RET C ;16..19
INC C
ADD A,4
RET C ;1A..1D
INC C
ADD A,4
RET C ;1E..21
INC C
INC B ;3
ADD A,8
RET C ;22..29
INC C
ADD A,8
RET C ;2A..31
INC C
ADD A,8
RET C ;32..39
INC C
ADD A,8
RET C ;3A..41
INC C
INC B ;4
ADD A,16
RET C ;42..51
INC C
ADD A,16
RET C ;52..61
INC C
ADD A,16
RET C ;62..71
INC C
ADD A,16
RET C ;72..81
INC C
INC B ;5
ADD A,32
RET C ;82..A1
INC C
ADD A,32
RET C ;A2..C1
INC C
ADD A,32
RET C ;C2..E1
INC C
ADD A,32
RET ;E2..101
LZDISPP
EX DE,HL
XOR A
LD DE,1
LD B,E;0+
ADD HL,DE
RET C ;1
INC A
ADD HL,DE
RET C ;2
INC A
ADD HL,DE
RET C ;3
INC A
ADD HL,DE
RET C ;4
INC A
INC B ;1+
INC E
ADD HL,DE
RET C ;5..6
INC A
ADD HL,DE
RET C ;7..8
INC A
INC B ;2+
LD E,4
ADD HL,DE
RET C ;9..C
INC A
ADD HL,DE
RET C ;D..10
INC A
INC B ;3+
LD E,8
ADD HL,DE
RET C ;11..18
INC A
ADD HL,DE
RET C ;19..20
INC A
INC B ;4+
LD E,#10
ADD HL,DE
RET C ;21..30
INC A
ADD HL,DE
RET C ;31..40
INC A
INC B ;5+
LD E,#20
ADD HL,DE
RET C ;41..60
INC A
ADD HL,DE
RET C ;61..80
INC A
INC B ;6+
LD E,#40
ADD HL,DE
RET C ;81..C0
INC A
ADD HL,DE
RET C ;C1..101
INC A
INC B ;7+
LD E,#80
ADD HL,DE
RET C ;101..180
INC A
ADD HL,DE
RET C ;181..200
INC A
INC B ;8+
INC H
RET Z ;201..300
INC A
INC H
RET Z ;301..400
INC A
INC B ;9+
LD DE,#200
ADD HL,DE
RET C ;401..600
INC A
ADD HL,DE
RET C ;601..800
INC A
INC B ;10+
SLA D
ADD HL,DE
RET C ;801..C00
INC A
ADD HL,DE
RET C ;C01..1000
INC A
INC B ;11+
SLA D
ADD HL,DE
RET C ;1001..1800
INC A
ADD HL,DE
RET C ;1801..2000
INC A
INC B ;12+
SLA D
ADD HL,DE
RET C ;2001..3000
INC A
ADD HL,DE
RET C ;3001..4000
INC A
INC B ;13+
SLA D
ADD HL,DE
RET C ;4001..6000
INC A
ADD HL,DE
RET ;6001..8000
POISKm0
;jr $
LD A,L
ld (MAXPOSL),A
XOR A
ld (KOLODIN),A
;DE=TEKADR
POISK ;ld (POISKSP),SP ;not fix
IF sureLE
EXX
;OUT (C),L
call OUTpgTEXT
EXX
ENDIF
LD A,(dicszM)
OR A
JR Z,$+6
LD A,(POISKIP)
OR A
jp Z,LZnfnd ;вместо dicsz=0k POISKIP=0
ld A,(MAXPOSL)
IF fastCPIQ
DEC A
ld (MAXPOSLm1),A
INC A
ENDIF
ADD A,-3
jp NC,LZnfnd
ld (MAXPOSLm3),A
ld HL,KOLODIN
SBC A,(HL)
jp C,LZnfnd
LD BC,(PUTBITB) ;#C000..>0
LD A,B
ADD A,pak9/256 ;#7C00
LD B,A
dicszM=$+2
LD HL,1-#8000 ;вместо 0 POISKIP=0
ADD HL,DE ;арифметич.нач.окна
;может получиться <0
JR NC,pushbc
PUSH HL
SBC HL,BC
JR NC,$+4 ;HL>BC,берем HL
POP HL ;HL<=BC,берем BC
pushbc PUSH BC
POP IX ;реальное нач.окна
LD A,(DE)
RLCA
LD C,A
INC DE
LD A,(DE)
ld (LZbyte2),A
RRCA
XOR C
IF k3b
EX DE,HL
INC HL
XOR (HL)
DEC HL
EX DE,HL
ENDIF
LD L,A
XOR C
IF k256
OR #E0
ELSE
AND keymask
OR keys/512
ENDIF
LD H,A
ADD HL,HL
LD (SPoldky),HL
;LD SP,HL
IF k256
EXX
LD A,k256
;OUT (C),A
call OUTME
EXX
ENDIF
;POP HL
;PUSH DE
push de
ld a,(hl)
ld (hl),e
ld e,a
inc l
ld a,(hl)
ld (hl),d ;обновили голову цепочки
ld d,a
ex de,hl
pop de
;hl=старое начало цепочки, прочитанное из хэш-таблицы
;de=адрес 3-го символа
ld (LZoldky),HL
EX DE,HL
ld (LZnxadr),HL
INC HL
ld (LZadol3),HL
EX DE,HL
jp LZGO
;cache начался
IF fastCPIQ
LZCPImx
MAXPOSL=$+1
LD A,0
ld (KOLODIN),A
OR A
SBC HL,DE
LD (SMESH),HL ;отрицательное смещение
jp LZnfnd;SM
ENDIF
LZCPIQ
DEC HL
IF fastCPIQ==0
INC C
LZCPImx
MAXPOSL=$+1
LD A,0
ELSE
MAXPOSLm1=$+1
LD A,0
ENDIF
SUB C ;NC
SBC HL,DE
LZn3
ld (KOLODIN),A
LD (SMESH),HL ;отрицательное смещение
IF fast0s
;todo:
;если oldSMESH было SMESH+1, то мы имеем дело с повт.байтами
;считаем их число от курсора =L
;двигаем SMESH назад, инкрементируя KOLODIN, until:
;байт изменился | KOLODIN>L
CP 64;fast0s
JR NC,LZnfnd
; JC LZnf0s ;глюк на tapecool.W после 8 нулей
; INC A
; j Z,LZnfnd
; LD A,H
; AND L
; INC A
;j Z,LZnfnd ;хотя может быть ссылка лучше, включающая
;следующие неповт.байты
;JNZ LZnf0s
;LD HL,(LZadr3)
;LD A,(HL)
;DEC HL,HL,HL ;-1-й байт
;CP (HL)
;JNZ LZnf0s
;DEC HL
;CP (HL)
;JZ $-2
;INC HL
;INC HL ;2-й байт
;LD DE,(LZadol3)
;JR LZokn77
LZnf0s
ELSE
INC A
JR Z,LZnfnd
ENDIF
LZadol3=$+1
LZcont LD DE,0 ;адрес курсорного 3 байта
LZadr3=$+1
LD HL,0 ;адрес 3-го байта
LZbad3 DEC HL
LZbad2 ADD HL,HL ;по 2 байта на символ
LD A,H
RLCA
RLCA
SET 7,H
set 6,H
EXX
AND 3;D
;IF k256
;ADD A,E
;ELSE
; CP 2
; SBC A,E
;ENDIF
;OUT (C),A
call OUTME
EXX
;LD SP,HL
;POP HL
ld a,(hl)
inc l
ld h,(hl)
ld l,a
LZGO
;hl=старое начало цепочки, прочитанное из хэш-таблицы
;de=адрес 3-го символа
EXX
;OUT (C),L
call OUTpgTEXT
EXX
LZokn77 LD A,HX
CP H
JR NC,LZokno7 ;м.б.кончилось окно?
LZbyte2=$+1
LZwokne LD A,0 ;проверка 2-го байта, т.к.
CP (HL) ;он был маскирован в ключе
jp NZ,LZbad2
INC HL
;сравниваем 3-й байт
LD A,(DE)
CP (HL)
jp NZ,LZbad3
ld (LZadr3),HL
INC HL
inc DE
MAXPOSLm3=$+1
LD BC,0
KOLODIN=$+1
LD A,0
SUB 3
JR NC,LZPREC
LZCPI_ LD A,(DE)
CPI
JR NZ,LZCPIQ
LZCPIi INC DE
jp PE,LZCPI_
jp LZCPImx
;KOLODIN>=4
LZPREC
;bc=MAXPOSLm3
CP C
JR NC,LZnfnd ;снарк2
;KOLODIN+1<=MAXPOSL
INC A ;>=1
LD B,A ;KOLODIN-2 (3 уже сравнили)
LZPRE0 LD A,(DE)
CPI
JR NZ,LZcont
INC DE
DJNZ LZPRE0
;сравнили KOLODIN+1 байт ок
INC C
DEC C
jp Z,LZCPImx ;снарк2
LD A,(DE)
CPI
JR Z,LZCPIi
;+2-й не совпал - len=KOLODIN+1
SCF
SBC HL,DE
LD A,(SMESH+1)
INC A
JR Z,LZmF
INC A
;IFN cache
; LD A,(SET2)
;ENDIF
JR Z,LZmE
LZmEQ
ld A,(KOLODIN)
INC A
jp LZn3
LZokno7 JR NZ,LZnfnd
LD A,L
CP LX
JR NC,LZwokne
LZnfnd
ld A,(KOLODIN)
CP 3
JR NZ,LZnfnn3
LD HL,(SMESH)
DEC HL
LD A,H
CP #E0 ;#E000 уже нельзя
JR NC,LZnfnn3
XOR A
ld (KOLODIN),A
LZnfnn3
LZnxadr=$+1
LD HL,0
LZoldky=$+1
LD DE,0
ADD HL,HL ;по 2 байта на символ
LD A,H
RLCA
RLCA
SET 7,H
set 6,H
EXX
AND 3;D
;IF k256
;ADD A,E
;ELSE
; CP 2
; SBC A,E
;ENDIF
;OUT (C),A
call OUTME
EXX
;LD SP,HL
;POP BC
;PUSH DE
ld c,(hl)
ld (hl),e
inc l
ld b,(hl)
ld (hl),d ;обновили голову цепочки
dec l
;hl=не нужно? TODO
;bc=старое начало цепочки, прочитанное из хэш-таблицы
IF sureLE==0
EXX
;OUT (C),L
call OUTpgTEXT
EXX
ENDIF
;POISKSP=$+1
; LD SP,#F0F4
RET
LZmF LD A,H
SET1=$+1
CP #F4
LZmC JR NC,LZmEQ
jp LZcont
LZmE LD A,H
SET2=$+1
CP #F0
JR LZmC
FiND2
;ret ;TODO сделать потом эти 2-символьные ссылки
LD A,(POISKIP)
OR A
RET Z
;LD A,(extext)
;CP "a" ;"rar" extension
;RET NZ
ld A,(MAXPOSL)
CP 2
RET C
LD HL,(TEKADR)
LD DE,(ADRfrom)
SBC HL,DE
RET Z
LD B,L
XOR A
CP H
ADD HL,DE
JR Z,$+3
LD B,A;-1
LD E,(HL)
INC HL
LD D,(HL)
DEC HL
LD A,D
FiND20 CP (HL)
DEC HL
JR NZ,FiND20N ;RET NZ
LD A,(HL)
CP E
JR Z,FiND20Y
LD A,D
FiND20N DJNZ FiND20
RET
FiND20Y
LD A,2
ld (KOLODIN),A
LD DE,(TEKADR)
SBC HL,DE
LD (SMESH),HL
RET