Subversion Repositories NedoOS

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