HUFFMAN
;hl=ldbit/ddbit
;bc=nodes
;jr $
ld (nodes),BC
PUSH BC,HL
LD HL,frqs-1
ADD HL,BC
add HL,BC
ld (nodend),HL
LD HL,bitlens
LD BC,255
LD D,H
ld E,L
INC DE
ld (hl),l ;0
LDIR
LD HL,huff
LD IX,0
mkhuf0 PUSH HL
nodend=$+1
LD HL,huff;frqend-1 ;нечетный адрес
nodes=$+1
LD BC,255;298
XOR A
PUSH AF
LD D,#FE ;last maximum <#FFXX (#FFFF - нет литерала)
mkhuf1
LD A,D
mkhuf1A CP (HL)
JR NC,mkhufNC
DEC L
CPD
jp PE,mkhuf1A
JR frskipQ
mkhufNC
DEC HL
JR NZ,frless
LD A,(HL)
CP E
JR NC,frskip
frless
POP DE
LD E,(HL)
INC L
PUSH HL
LD D,(HL)
frskipDL
DEC L
frskip CPD
jp PE,mkhuf1
frskipQ DEC B ;-1
POP HL
XOR A
OR H
JR Z,mkhufQ ;кончились частоты>0
;DE=MINfrq-1
INC DE
;HL=adrMINfrq+1(H)
LD (HL),B;-1 ;шоп боле не попадалась
LD BC,-frqs-1
ADD HL,BC
SRL H
RR L ;HL=литерал
LD B,D
ld C,E
POP DE
EX DE,HL
LD (HL),B ;frq
INC HL
LD (HL),C
INC HL
LD (HL),D ;вместо adrA (литерал)
INC HL
LD (HL),E
INC HL
INC IX
JR mkhuf0
mkhufQ
POP HL
OR HX
JR NZ,HUFN1L
OR LX
IF skipnotree
jp Z,MHUFCOD ;нет дерева
ELSE
jr NZ,HUFN0L
INC LX ;будет лист
LD (HL),C;0
INC HL
LD (HL),1
INC HL
LD (HL),C;0
INC HL
LD (HL),C;0
INC HL
INC A
HUFN0L
ENDIF
CP 1
JR NZ,HUFN1L
INC LX ;будет 2 листа
DEC HL
XOR (HL) ;второй лист фиктивный
INC HL
LD (HL),C ;чтобы не #FF dem029
INC HL
LD (HL),1 ;dem08
INC HL
LD (HL),C;0
INC HL
LD (HL),A
INC HL
HUFN1L LD (HL),B;-1;end
;на всякий случай запомним отсорт.частоты
;ГДЕ ИСПОЛЬЗУЕТСЯ?
;LD BC,1-huff
;ADD HL,BC
;LD B,H,C,L
LD HL,huff
LD DE,frqs
LD BC,298*4+1 ;end
LDIR
;jr $ ;ix=#127
;IX=кол-во НЕЗАНЯТЫХ листьев
;теперь объединяем узлы
LD DE,huffend-1 ;ЗАНЯТЫЕ-1
obhuf0
LD A,LX
DEC A
OR HX
JR Z,obhufQ ;остался один узел, нечего объединять
;первые 2 НЕЗАНЯТЫХ узла
;перемещаем в ЗАНЯТЫЕ
LD HL,huff+7
LD BC,8
LDDR
PUSH DE
INC HL
LD B,(HL) ;frq1
INC HL
LD C,(HL)
INC HL,HL,HL
LD D,(HL) ;frq2
INC HL
LD E,(HL)
EX DE,HL
ADD HL,BC
LD B,H
ld C,L
;ищем первую бОльшую частоту
;и перекидываем в начало меньшие/равные
LD HL,huff+8
LD DE,huff
IF fastTREE
LD A,B
PUSH BC
obhuf1 CP (HL)
LDI
JR Z,obhCP
obhCPQ LDI
LDI
LDI
jp NC,obhuf1
DEC HL,DE
DEC HL,DE
DEC HL,DE
obhufG DEC HL,DE
POP BC
ELSE
obhuf1
LD A,(HL)
CP B
JR C,obhufi
JR NZ,obhufG
INC HL
LD A,C
CP (HL)
DEC HL
JR C,obhufG ;(HL)>C
obhufi LDI
INC BC
LDI
INC BC
LDI
INC BC
LDI
INC BC
JR obhuf1
obhufG
ENDIF
;HL=адрес первой бОльшей частоты (или end)
;DE=куда вставлять
EX (SP),HL ;HL=adrA-1=ЗАНЯТЫЕ-1
;(SP)=адр.п.бОл.ч
EX DE,HL
LD (HL),B ;frq
INC HL
LD (HL),C
INC HL
INC DE
LD (HL),D ;adrA
INC HL
LD (HL),E
DEC DE
INC HL
EX DE,HL
EX (SP),HL ;HL=адр.п.бОл.ч
;(SP)=ЗАНЯТЫЕ-1
LD A,-1
JR obhufcE
IF fastTREE
obhCP POP BC
LD A,C
CP (HL)
LD A,B
PUSH BC
jp NC,obhCPQ
JR obhufG ;(HL)>C
ENDIF
obhufco LDI
LDI
LDI
LDI
obhufcE CP (HL)
JR NZ,obhufco
LD (DE),A
DEC IX;свободных стало на 1 меньше
POP DE
JR obhuf0 ;объединяем следующие...
obhufQ
;считаем bitlens
LD BC,0
PUSH BC ;=0
PUSH BC
LD HL,huff
;смотрим правую,левую(PUSH)
CNTbl
INC HL,HL
LD A,(HL) ;adrA
CP 2
JR C,CNTli
LD D,A
INC HL
LD E,(HL)
PUSH DE ;LEFT
INC C
PUSH BC
INC DE,DE,DE,DE ;RIGHT
EX DE,HL
JR CNTbl
CNTli LD L,C
ADD HL,HL
LD H,bitlens/256 ;0,1,...
INC (HL)
JR NZ,$+4
INC L
INC (HL)
XOR A
POP BC
POP HL
OR H
JR NZ,CNTbl
;исправляем длины>15
;bad:
;2*(N+1),(N-1) -> 3*(N)
;4*(N+1),(N-2) -> 4*(N),(N-1)
;и т.д.
;fixed:
;X=первый ненулевой от N-1 и менее
;(X)--
;(X+1)+=2
;(N)++
;(N+1)-=2
;jr $
ispr15
LD HL,bitlens ;таблица сколько листьев в ярусе
ispr150 DEC L
LD A,(HL)
DEC L
OR (HL)
JR Z,ispr150
LD A,L
CP 32
JR C,MHUFCOD ;все глубины <15
;LD BC,1 ;сколько листьев на обмен
DEC L,L
LD E,L ;запомним ADR (N)
ispr151;SLA C
;RL B
DEC L
LD A,(HL)
DEC L
OR (HL)
JR Z,ispr151;глубин (N-1) нету
;нашли X
LD A,(HL)
DEC (HL)
INC L
OR A
jr NZ,$+3
DEC (HL)
;INC L,(HL)
;JR Z,$-2
INC L ;ADR (X+1)
LD A,(HL)
ADD A,2
LD (HL),A
INC L
jr NC,$+3
INC (HL)
LD L,E ;вспомним ADR (N)
;LD A,(HL)
;ADD A,C
;LD (HL),A
;INC L
;LD A,(HL)
;ADC A,B
;LD (HL),A
INC (HL)
INC HL
jr NZ,$+3
INC (HL)
INC L ;ADR (N+1)
LD A,(HL)
SUB 2;C
LD (HL),A
INC L
;LD A,(HL)
;SBC A,B
;LD (HL),A
jr NC,$+3
DEC (HL)
JR ispr15
;составляем новое дерево по длинам и frqs
;сейчас в frqs: (Hfrq,Lfrq,Hlit,Llit)
;end=-1
;сначала присваиваем литералам bitlen
MHUFCOD
POP HL,BC
;bc=nodes?
;hl=?
PUSH BC,HL
DEC BC
LD D,H
ld E,L
LD A,E
ld (licoLOW),A
LD HX,D
INC DE
XOR A
LD (HL),A
CP B
LDIR
JR Z,$+4
LD A,20 ;+D
ld (licoI1),A
ld (licoI2),A
ld (lico0+1),HL
LD DE,frqs
LD HL,bitlens+31
LD B,15 ;текущая глубина
LD LX,B
libi0 LD A,(HL)
DEC L
OR (HL)
JR Z,libiZ
libiNZ LD A,(HL)
DEC (HL)
INC L
OR A
JR NZ,$+3
DEC (HL)
;берем номер литерала
INC DE,DE
PUSH HL
LD A,(DE)
INC DE
ADD A,HX
LD H,A
LD A,(DE)
INC DE
LD L,A
LD (HL),B
POP HL
JR libi0
;кончились листья этой глубины
libiZ DEC L
DJNZ libi0
libiQ
;внутри каждого яруса - не по частоте,
;а по алфавиту!
LD H,B
ld L,B;HUFF CODE<<
LD C,2 ;HUFF SUBer
lico0
LD DE,0 ;ldbit+297 CHANGEABLE
lico1 LD A,(DE)
CP LX
JR NZ,lico1N
;теперь код Хаффмана<<
PUSH DE
licoI1 INC D
inc D
SBC HL,BC
LD A,H
LD (DE),A
licoI2 INC D
inc D
LD A,L
LD (DE),A
POP DE
lico1N
LD A,E
licoLOW=$+1
CP 0
LD A,D
DEC DE
JR NZ,lico1
CP HX
JR NZ,lico1
SLA C
RL B
DEC LX
JR NZ,lico0
POP HL,BC
RET