PACKfil
;hl=addr
;[b=size in sectors]
;[de=first sector]
;hl'=fout+
;de'=0?
packfilsz=0x8000
;TODO предварительно проверить, что файл существует
ld a,(filehandle)
ld b,a
OS_GETFILESIZE ;dehl=filesize
ld (filesize),hl
ld (filesizeHSW),de
ld hl,0
;ld (paksz),hl
;ld (paksz+2),hl
ld (unpsz),hl
ld (unpsz+2),hl
;ld a,pgTEXT
;call OUTME
;включена pgTEXT?
EXX
LD de,0;D,0 ;saved ;TODO de?
;LD (oldsaved),DE ;для перепаковки в режиме store
;LD (oldhl_),HL ;для перепаковки в режиме store
EXX
LD A,(tmethod)
SUB "p"
JR Z,$+4 ;store
LD A,4 ;pack
dic0
;PUSH HL
;LD HL,(SAVE1st)
;LD (oldSAVE1st),HL ;для перепаковки в режиме store?
;LD HL,(lded)
;LD (oldlded),HL ;для перепаковки в режиме store
pACKREP
;xor a ;"store"
LD (POISKIP),A
;LD HL,(unpsz)
;LD (remainsz),HL
call BYTEsPP_startfile ;сохранить или пропустить первые 2 сектора файла
LD A,62
LD (p2NOjr),A ;первый раз пропускаем jr
LD HL,0
LD (CURCRC),HL
LD (CURCRC2),HL
;POP HL
LZ
;PUSH BC
call OUTpgTEXT
exx
push bc
push de
push hl
exx
ld de,-packfilsz
ld (ADRfrom),de
ld hl,packfilsz
;de=buf
;hl=size
call readstream_file
push hl
ld de,(unpsz)
add hl,de
ld (unpsz),hl
ld hl,(unpsz+2)
jr nc,$+3
inc hl
ld (unpsz+2),hl
pop hl
;ld (remainsz),hl
exx
pop hl
pop de
pop bc
exx
;hl=block length
p2NOjr=$
JR p2NO1stKUS ;первый раз ld a,N
;первый блок файла:
EXX
PUSH HL ;fheadCRC arc pos
EXX
LD A,(THEADON)
CP "n" ;заголовки разрешены?
push hl
LD IX,fihd-2
LD A,(fihdsz)
LD B,A
CALL Z,BLOCK ;записываем заголовок файла
pop hl
EXX
LD C,1 ;bit collector
PUSH DE
PUSH HL ;file start pos
EXX
p2NO1stKUS
ld a,h
or l
jp z,packnoremain ;пустой файл/пустой 32к блок файла ;правильный выход при длине 0 (на стеке 3 числа)
exx
PUSH BC,DE,HL
exx
push hl ;block length
call mktcrc ;TODO один раз при старте
call clearhashes
exx
; LD HL,pgLZ*256+pgTEXT ;TODO убрать эти константы в регистрах
; IF k256
; LD DE,#352
; ELSE
; LD DE,#3EC
; ENDIF
;LD BC,32765
;OUT (C),L
call OUTpgTEXT
exx
pop bc ;block length
ADRfrom=$+1
LD HL,0
push bc
push hl
;hl=addr, bc=length
call gencrc
ld hl,frqs
ld bc,frqend-frqs-1
ld (hl),-1
call fillmem ;чистим frqs
ld hl,ddfrq
ld bc,ddfrqend-ddfrq-1
ld (hl),-1
call fillmem ;чистим ddfrq+rdfrq
pop hl
pop bc
LD DE,pakto
;hl=TEKADR
;de=PUTBITB=pakto (TODO 0)
;bc=length
LD A,1
LD (PUTBITC),A
LD (PUTBITB),DE
PUSH HL
ADD HL,BC
LD (INEND),HL
POP HL ;TEKADR
;jr $
CALL CRUNgo;LZPP
if 1==1
LD A,(POISKIP) ;method (0=store)
OR A
JR Z,NO269 ;store
;добавим 269
filesize=$+1
ld hl,0
ld de,(unpsz)
;or a
sbc hl,de
ld a,h
or l
filesizeHSW=$+1
ld hl,0
ld de,(unpsz+2)
;or a
sbc hl,de
or h
or l
ADD A,-1 ;если это был последний блок файла (FILEremain=0), то будет NC - не запишем литерал
LD A,269&0xff
CALL C,PUTBYTi ;записали литерал обновления деревьев? после блока! т.е между блоками
NO269
endif
SCF
SBC A,A
CALL PUTBIT
CALL PUTBYTE ;записали литерал конца блока (невозможный)
LD B,7
CALL PUT0
DJNZ $-3 ;flush битового буфера
;;Huffman:
EXX
;OUT (C),H
ld a,pgLZ
call OUTME
IF ramdisk
LD A,pgLZ;H
LD (BYTEPG),A
ENDIF
POP HL,DE,BC
EXX
call packmktrees
LD HL,LBYTE
LD A,(POISKIP)
OR A
JR Z,infa ;"store"
call packwrtrees ;в первом блоке файла принудительно пишем деревья без команды, в последующих это будет после команды (которая в конце всех блоков, кроме последнего)
LD HL,PKLHPP
infa
LD (pkiCALL+1),HL ;PKLHPP (кодируем через дерево)/LBYTE (просто копируем байты)
LD A,24
LD (p2NOjr),A
IF fastWRI
LD A,(PUTBITB+1) ;где остановился LZ кодер (HSB)
CP #C0
JR NC,$+4 ;LZ кодер всё уместил в страницу - можно иметь большой буфер записи и сохранять большим блоком
;если lz data вышло за пределы страницы и уже в pak9+ - нельзя иметь большой буфер записи
LD A,fout/256+2+(svbfsz/256);fout/256+4 ;сюда не попадаем при блоках 4K
LD (BYTEend),A ;адрес (HSB), при достижении которого процедура BYTE пишет на диск
ENDIF
call packencodehuff
CALL OUTpgTEXT ;!!! разве до этого было не включено? для pkiL2 могло испортиться???
IF fastWRI ;??? TODO
;save buf
EXX
LD A,H
CP fout/256+2
JR C,FremNS ;в буфере записи сгенерировано не более 512 байт
PUSH BC
PUSH HL
CALL BYTEsPP ;сохранили целое число секторов
;HL=fout+512
;TODO двигать de, если сохраняли от fout? сейчас костыль в конце файла
EX DE,HL ;saved
EX (SP),HL
LD C,L
LD B,E
LD L,E
INC BC
LDIR ;остаток переносим в fout+512
DEC DE
EX DE,HL
POP DE ;saved TODO
POP BC
FremNS
EXX
ENDIF
;догрузить
JP LZ
PKST
EXX
LD HL,fout
LD E,L;0
LD D,L ;for CREATE empty (de=SAVEsz in sectors)
EXX
RET
packnoremain
;в стеке 3 числа
LD B,7
CALL PKBDpp ;довыгрузить байт
;---continue filehead
EXX
PUSH DE ;saved сейчас
EXX
POP HL
POP DE ;file start pos
POP BC ;saved было
inc bc
inc bc ;костыль TODO
XOR A
SBC HL,BC ;add H
LD B,L
ld C,A ;c=0
LD A,H
EXX
PUSH HL
EXX
POP HL ;current outfile pos
SBC HL,DE
ADD HL,BC ;add H
ADC A,C ;c=0
POP DE ;filehead CRC outfile pos
LD IX,2
ADD IX,DE
;HL=filehead paksz
;c=0
LD (paksz),HL ;TODO убрать (сейчас для показа цифр?)
;ld bc,0
LD B,A
;EI
;ld hl,(paksz)
;ld bc,(paksz+2)
;bchl=paksz
LD A,(CPn)
CP "n"
RET NZ ;no CRC??? TODO
LD A,(THEADON)
CP "n"
ret nz;jr NZ,SAVE_ ;no rar header
PUSH DE ;filehead CRC outfile pos
LD (IX+5),L
LD (IX+6),H
LD (IX+7),c
LD (IX+8),b
ld hl,(unpsz)
ld (ix+9),l
ld (ix+10),h
ld hl,(unpsz+2)
ld (ix+11),l
ld (ix+12),h
POISKIP=$+1
JR $+6
LD (IX+23),"0"
LD HL,(CURCRC)
LD (IX+14),L
LD (IX+15),H
LD HL,(CURCRC2)
LD (IX+16),L
LD (IX+17),H
LD A,(fihdsz)
SUB 2 ;размер заголовка - 2
LD B,A
CALL UPCRC1
POP HL ;filehead CRC outfile pos
LD (HL),E
INC HL
LD (HL),D
if 1==1
;xor a
;jp pACKREP
ret
else
LD HL,(unpsz)
LD BC,(paksz)
OR A
SBC HL,BC
ret nc;jr NC,SAVE_ ;unpsz >= paksz
;пересохраняем в режиме stored
;TODO
;oldSAVE1st=$+1
; LD HL,0
; LD (SAVE1st),HL
oldlded=$+1
LD HL,0
LD (lded),HL
oldsaved=$+1
LD DE,0
oldhl_=$+1
LD HL,0
EXX
CALL CON1NAM
XOR A ;"store"
PUSH HL
JP pACKREP
endif
;flush and close outfile
SAVE_
EXX
;LD A,L
;LD (SAVElenLS1),A
push hl
call BYTEsPP_endfile ;сохраняем, что не успели сохранить
;SAVE1st=$+1
;LD HL,0 ;1stfree
;LD (BYTEsvTS),HL
pop hl
ret;jp SAVECLOSE
IF dolds
copdd
LD C,48
LD A,3
copdd0 PUSH BC,DE,HL
LDIR
POP HL,DE,BC
INC H,D
DEC A
jr NZ,copdd0
RET
ENDIF
clearhashes
;чистим хэш-таблицу
IF k256
LD A,k256
CALL CLPG
else
ld hl,keys
ld bc,+((keymask+1)*512)-1
ld (hl),0
call fillmem
ENDIF
;TODO потом вернуть это ускорение очистки
;LD A,(ADRfrom+1)
;CP #E0
LD A,3;#17
CALL CLPG
;ret nc ;JR NC,LZncl
DEC A
CALL CLPG
;LD A,(ADRfrom+1)
;CP #C0
;ret nc ;JR NC,LZncl
dec a;LD A,#14
CALL CLPG
DEC A
jp CLPG
packmktrees
;сейчас в frqs частоты всех литералов
LD HL,ldbit
LD BC,298
call HUFFMAN
;теперь в ldbit - длины кодов и сами коды
LD DE,lens
LDIR
PUSH DE
;строим дерево dd
;jr $
LD HL,ddfrq
LD DE,frqs
LD BC,298*2
LDIR
LD HL,ddbit
LD C,48
call HUFFMAN
POP DE
LDIR
IF dolds
PUSH DE
;дерево rd
LD HL,ddfrq;rdfrq ;(rd лежит как литералы 48..75 в dd)
LD DE,frqs
LD BC,298*2
LDIR
LD HL,frqs
LD B,2*48 ;листья dd
LD (HL),-1 ;не встречались
INC L
DJNZ $-3
LD HL,ddbit
LD DE,ddbit+48+28 ;тихое место
PUSH DE
push HL
CALL copdd
LD HL,ddbit;rdbit
LD C,48+28;28
call HUFFMAN
POP DE
pop HL
CALL copdd
LD HL,rdbit
POP DE
LD C,28
LDIR
ELSE
LD H,D
ld L,E
INC DE
LD C,27
LD (HL),B
LDIR
ENDIF
LD A,-1
LD (DE),A
;строим дерево bd
;для начала преобразуем lens
;коды 16,17,18 - в 2-байтном формате
LD HL,lens-1
LD D,H
ld E,L
prlensN
LD A,(HL)
prlensD LD (DE),A
INC HL
inc DE
LD BC,255 ;вместо -1;INC B:DJNZ
LD A,(HL)
CP C
JR Z,prlensQ
PUSH HL
prlensR INC BC
inc HL
CP (HL)
JR Z,prlensR
POP HL
OR A
LD A,C
JR Z,prlensZ
DJNZ prlR256
CP 4-1
JR C,prlensN
CP 4+4-1
JR C,prlen16
prlR256 LD BC,4+3-1 ;max repeat
prlen16 LD A,(HL)
ADD HL,BC
LD (DE),A
INC DE
LD A,16
LD (DE),A
INC DE
LD A,C
SUB 4-1
JR prlensD
prlensZ
DJNZ prlZ256
CP 3-1
JR C,prlensN
CP 11-1
JR C,prlen17
CP 11+128-1
JR C,prlen18
prlZ256 LD BC,11+127-1 ;max repeat zero
prlen18 ADD HL,BC
LD A,18
LD (DE),A
INC DE
LD A,C
SUB 11-1
JR prlensD
prlen17 ADD HL,BC
LD A,17
LD (DE),A
INC DE
LD A,C
SUB 3-1
JR prlensD
prlensQ
LD (DE),A ;-1
LD HL,frqs
;PUSH HL
LD BC,298*2
LD (HL),A;-1
CALL fillmem;CLSA
DEC B
LD HL,lens
;POP DE
LD DE,frqs
FRQL0 PUSH HL
LD L,(HL)
LD H,B;0
ADD HL,HL
ADD HL,DE
INC (HL)
JR NZ,$+4
INC HL
INC (HL)
POP HL
BIT 4,(HL)
JR Z,$+3
INC HL
INC HL
LD A,(HL)
INC A
JR NZ,FRQL0
LD HL,bdbit
LD C,19
jp HUFFMAN
packwrtrees
;no MMC
CALL bit0
;clear old
CALL bit0
;---tree
LD HL,bdbit
LD C,19
pkbdli
LD A,(HL)
RLA
RLA
RLA
RLA
INC L
LD B,4
CALL PKBDpp
DEC C
JR NZ,pkbdli
LD HL,lens
pkiL PUSH HL
LD L,(HL)
LD H,bdbit/256
CALL PKNNpp ;пишем код Хаффмана (в hl через 256: длина, HSB, LSB) - пишем старшие биты
POP HL
LD A,(HL)
CP 16
JR C,pkLN16
CP 17
INC HL
LD A,(HL)
LD B,3
JR Z,pkL17
DEC B
JR C,pkL16
LD B,7
RLA
JR pkLadd
pkL17 RRCA
pkL16 RRCA
RRCA
pkLadd CALL PKBDpp
pkLN16 INC HL
LD A,(HL)
INC A
JR NZ,pkiL
ret
packencodehuff
LD HL,pakto
LD DE,(ADRfrom) ;для opt2s
LD A,128
pki0
ADD A,A
JR NZ,GET9Q
LD A,(HL)
INC L
CALL Z,INCH
RLA
GET9Q
PUSH HL
LD L,(HL)
LD H,ldbit/512
RL H
LD B,(HL)
INC H
inc H
LD C,(HL)
INC H
inc H
EXA
LD A,H
RRA
JR NC,pkiNC
LD A,L
OR A
JP M,pki0Q ;литерал конца текста (невозможный)
SUB 261&0xff
CP 8
JP C,pkiL2
LD A,1
pkiNC
LD A,H
pkiCALL CALL PKLHPP ;/LBYTE для "store"
POP HL
CP ldbit/256+5
JP NZ,pkiN ;byte
LD A,(HL)
IF dolds
OR A
JP Z,pkiYOLD
ENDIF
CP 269&0xff
JP Z,pkinewtrees;pkiNDE ;обновление деревьев?
INC L
CALL Z,INCH
IF dolds
CP 261&0xff
JR NC,pkiN4
;olddisp 257..260=+1..4,len8
LD B,A
PUSH HL
LD A,(HL) ;len
DJNZ $+5
LD HL,(OLDSMES)
DJNZ $+5
LD HL,(OL2SMES)
DJNZ $+5
LD HL,(OL3SMES)
DJNZ $+5
LD HL,(OL4SMES)
LD (SMESH),HL
LD (pkiOLD),A
POP HL
INC L
CALL Z,INCH
LD A,(HL) ;скорректированный len
CALL LZMID
;C=токен
PUSH BC,HL
;A=остаток,B=число бит
PUSH AF
LD A,C
ADD A,rdbit&0xff
LD L,A ;литералы 48..75 вместо 0..27
POP AF
LD H,rdbit/256
LD B,(HL)
INC H
LD C,(HL)
INC H
LD L,(HL)
LD H,C
ADD HL,HL
CALL bit
DJNZ $-4
POP HL,BC
INC B
DEC B
JR Z,pkioQ
CPL ;!
LD C,B
RRCA
DJNZ $-1
LD B,C
RLA
CALL bit
DJNZ $-4
pkioQ JP pkiYOLD
pkiN4
ENDIF
CP 278&0xff
JP NC,pkiLL
;len<=10 270..277=+E..15,-disp16
SUB 0xff&(270-3)
LD (pkiOLD),A
JP pkiLQ
;len=2 261..268=+5..C,-disp8
pkiL2
;dolds после len=2 не будет 4 раза
LD L,(HL)
LD H,C
LD (codeL2),HL
POP HL
INC L
CALL Z,INCH
IF dolds
LD A,-1
LD (SMESH+1),A
ENDIF
LD A,(HL)
IF dolds
LD (SMESH),A
ENDIF
PUSH HL
PUSH BC
CALL LZLITPP
;A=остаток,B=число бит
CPL ;!
LD C,B
RRCA
DJNZ $-1
LD B,C
ld C,A
POP AF
IF opt2s
ADD A,B
LD LX,A
;считаем 2 байта в DE, если их не затерли
;и если они есть в tree (а они есть, т.к. tree одно)
LD HL,(PUTBITB) ;HL' не важен
LD A,H
ADD A,pak9/256
LD H,A
JR C,pkiL2CP
SBC HL,DE
INC DE
JR NC,pkiL2Z ;затерли
DEC DE
pkiL2CP PUSH BC
LD A,pgTEXT;16
CALL OUTNO ;временно включаем 0-ю страницу
LD A,(DE)
INC DE
LD L,A
LD H,ldbit/256+4
LD C,(HL)
DEC H
dec H
LD B,(HL)
DEC H
dec H
LD (code1),BC
LD B,(HL)
EX DE,HL
LD E,(HL)
EX DE,HL
CALL OUTBYTEPG ;включаем старую страницу TODO
LD A,B
ADD A,(HL)
PUSH HL
INC H
inc H
LD C,(HL)
INC H
inc H
CP LX
LD A,(HL)
JR NC,pkiL2Y ;выгоднее ссылка
;выгоднее символы
code1=$+1
LD HL,0
CALL PKHLPP
POP HL
LD B,(HL)
LD H,C
ld L,A
CALL PKHLPP
POP AF
JR pkiNPOPnSSYL
pkiL2Y POP AF
POP BC
pkiL2Z LD A,LX
SUB B
ENDIF
codeL2=$+1
LD HL,0
PUSH BC
LD B,A
CALL PKHLPP
POP BC
LD A,C
CALL PKBDpp
;IFN dolds ;в v0.33 уже закомментировано
;LD A,2
;LD (pkiOLD),A
;ENDIF
JR pkiNPOP
;len>10 278..297=+16..29,len8,-disp16
pkiLL
LD A,(HL)
LD (pkiOLD),A
DEC A ;len декрементирован
CALL LZMIDPP
;A=остаток,B=число бит
CPL ;!
LD C,B
RRCA
DJNZ $-1
LD B,C
CALL PKBDpp
INC L
CALL Z,INCH
pkiLQ
;для обычных ссылок типа >=3 и типа >=11
PUSH DE
LD E,(HL)
INC L
CALL Z,INCH
LD D,(HL)
IF dolds
LD (SMESH),DE
ENDIF
PUSH HL
LD HL,#1FFF
ADD HL,DE
JR C,$+6
LD HL,pkiOLD
INC (HL) ;>=#2000
;DE=-disp16
CALL LZDISPP
;A=dd code
;HL=остаток,B=число бит+1
PUSH BC
DEC B
JR Z,pkiLRQ
RR H
rr L
rr D
rr E
DJNZ $-8
pkiLRQ ;PUSH DE
LD L,A
LD H,ddbit/256
CALL PKNNpp
;POP HL
EX DE,HL
CALL INVHL
POP BC
;HL=остаток<<,B=число бит+1
DEC B
CALL NZ,PKHLPP
;;
POP HL
POP DE
pkiYOLD
;код 256, конец обработки 257..260 и простых ссылок
PUSH HL
pkiOLD=$+1 ;для 256 и для opt2s
LD HL,0
DEC HL
ADD HL,DE
EX DE,HL
pkiNPOP
;конец обработки len=2:ссылка (INC DE там внутри)
IF dolds
CALL LZPUTQQ ;сдвиг буфера SMESH'ей
ENDIF
pkiNPOPnSSYL
;конец обработки len=2:символы
POP HL
pkiN
;or a
;jr z,$
;cp 3
;jr z,$
INC DE ;непак. адрес для opt2s
pkinewtrees
pkiNDE INC L
CALL Z,INCH
EXA
JP pki0
pki0Q
POP HL
ret