%if 0

lDebug heatshrink depacker

Copyright (C) 2008-2025 E. C. Masloch

Usage of the works is permitted provided that this
instrument is retained with the works, so that any entity
that uses the works is notified of this instrument.

DISCLAIMER: THE WORKS ARE WITHOUT WARRANTY.

%endif

%include "lmacros3.mac"


	numdef Z,		0
	numdef LZEXEDAT,	0
	numdef DEPACKINLINELITERAL,	1
	numdef LONGLITERAL,	0
	numdef STANDALONE,	1

%ifn _STANDALONE
	overridedef DEBUG0,	0
	overridedef COUNTER,	0

	usesection lDEBUG_CODE

[list -]
%else
	numdef DEBUG0,		0
	numdef COUNTER,		0, 32
%if (_COUNTER - 1) & _COUNTER
 %error COUNTER must be a power of two
%endif


	cpu 8086
	org 256
	addsection CODE, start=256
testprogram:
	mov si, 81h

	cmp sp, stack.top
	jae @F
error:
	mov dx, msg.error
	mov ah, 09h
	int 21h
	mov ax, 4CFFh
	int 21h
	int 20h

@@:
	lodsb
	cmp al, 9
	je @B
	cmp al, 32
	je @B
	cmp al, 13
	je error
	mov dx, si
	dec dx

@@:
	lodsb
	cmp al, 9
	je @F
	cmp al, 32
	je @F
	cmp al, 13
	jne @B
@@:
	mov byte [si - 1], 0

	mov ax, 3D00h | 1_010_0_000b	; RO, DENY WRITE, No inherit
	int 21h
	jc error
	mov word [handle], ax
	mov word [filebuffer.next], filebuffer
	mov word [filebuffer.tail], filebuffer

	xchg bx, ax
	mov ax, 4202h
	xor cx, cx
	xor dx, dx
	int 21h
	jc error

	test dx, dx
	jnz error

	push ax
	mov ax, 4200h
	xor cx, cx
	xor dx, dx
	int 21h
	pop cx				; = file size
	jc error

	mov di, resultbuffer
	push di
	push cx
	mov ax, 0CCCCh
	mov cx, words(resultbuffer.end - resultbuffer)
	rep stosw
	pop cx
	pop di
	mov si, resultbuffer.end

	call depack
	jc error

	push ss
	pop ds
	push ss
	pop es

	mov ah, 3Eh
	mov bx, [handle]
	int 21h

	mov byte [resultbuffer.end - 1], 0
	mov di, resultbuffer
	mov al, 0
	mov cx, -1
	mov dx, di
	repne scasb
	not cx
	dec cx
	mov ah, 40h
	mov bx, 1
	int 21h

	mov ax, 4C00h
	int 21h
	int 20h


%if _COUNTER
disp_al:
	push dx
	push ax
	xchg ax, dx
	mov ah, 02h
	int 21h
	pop ax
	pop dx
	retn
%endif

get_file_byte:
	mov si, [filebuffer.next]
	cmp si, [filebuffer.tail]
	jb .buffered

	push ax
	push bx
	push cx
	push dx
	mov dx, filebuffer
	mov [filebuffer.next], dx
	mov [filebuffer.tail], dx
	mov ah, 3Fh
	mov bx, [handle]
        mov cx, filebuffer.end - filebuffer

	int 21h
	jc error
	test ax, ax
	jz error
	add ax, dx
	mov word [filebuffer.tail], ax
        mov si, dx
	pop dx
	pop cx
	pop bx
	pop ax

.buffered:
	lodsb
	mov [filebuffer.next], si
	clc
	retn


	addsection DATA, align=1 follows=CODE
msg:
.error:		ascic "Error!",13,10


	addsection BSSDATA, align=16 nobits follows=DATA
	alignb 16
resultbuffer:	resb 16384
.end:
	alignb 2

filebuffer:	resb 256
.end:
	alignb 2
.next:		resw 1
.tail:		resw 1
handle:		resw 1

stack:		resb 512
.top:


	usesection CODE
%endif	; _STANDALONE
[list +]


		; INP:	cx = length of source
		;	es:di -> destination
		;	si -> behind end of destination
		; OUT:	NC if success
		;	CY if error,
		;	 bx = ?errordata (if _DEBUG0)
		; CHG:	ax, (bx), cx, dx, es, ds, si, di
		; STT:	UP
depack:
	lframe near
	lenter
 %if _DEBUG0 || _COUNTER
	xor bx, bx
 %endif
 %if _DEBUG0
	lvar word,	errordata
	 push bx
 %endif
%if _COUNTER
	lvar word,	unused_and_counter
	lequ ?unused_and_counter + 1, counter
	 push bx		; initialise counter (high byte) to zero
%endif

	lvar dword,	original_dst
	 push es
	 push di
	lvar dword,	dst
	 push es
	 push di
	lvar word,	src_remaining
	 push cx

	mov cx, si
	sub cx, di

	lvar word,	dst_remaining
	 push cx		; push into [bp + ?dst_remaining]

%if _LZEXEDAT
.lze_init:
	lvar word,	tagword
	 push ax
	mov ax, 1
	lvar word,	tagbitscycle
	 push ax		; = 1

	call get_bit

	jmp .lze_loop

.lze_literal:
%if _LONGLITERAL
	inc cx
.loop_literal:
%endif

	call load_byte
%if _DEPACKINLINELITERAL
	sub word [bp + ?dst_remaining], 1
					; enough space left ?
	jb .error			; no --> (CY)
	les di, [bp + ?dst]		; -> destination
	stosb				; store it
	mov word [bp + ?dst], di	; update ?dst
%else
%if _LONGLITERAL
	push cx
%endif
	push ax				; on stack: the literal
	 push ss
	 pop ds
	mov si, sp			; ds:si -> data on stack
%if _LONGLITERAL
	xor ax, ax
%else
	xchg ax, cx			; ax = 0
%endif
	inc ax				; length = 1
	mov bx, ax			; bx NZ
	call copy_data.bx
	pop ax				; (discard)
d0	mov byte [bp + ?errordata], 75h
	jc .error
%if _LONGLITERAL
	pop cx
%endif
%endif

%if _LONGLITERAL
	loop .loop_literal
%endif

%assign LENGTHOFLITERAL $ - .lze_literal
%warning length of lze literal = LENGTHOFLITERAL

.lze_loop:
	xor cx, cx			; ! ch = 0, cx = 0
	call get_bit
	jc .lze_literal

.lze_notliteral:
%if _COUNTER
	inc byte [bp + ?counter]
	test byte [bp + ?counter], _COUNTER - 1
	jnz @F
	mov al, '.'
	call disp_al_counter
@@:
%endif

	call get_bit
	jc .lze_combined

.lze_shortmatch:
		; cx = 0
	call get_bit
	rcl cx, 1
	call get_bit
	rcl cx, 1			; cx = 0..3

	call load_byte			; load displacement

	mov ah, -1			; sign extend for negative number
	xchg bx, ax			; bx = displacement (-1 to -256)

.lze_match_cx_plus_2:
	inc cx
.lze_match_cx_plus_1:
	inc cx

		; INP:	bx = match displacement (-1 to -4096)
		;	cx = match count (2 to 256)
	xchg ax, bx			; ax = displacement, cx = count
	xchg ax, cx			; cx = displacement, ax = length of match
	lds si, [bp + ?dst]
	add si, cx
	call copy_data			; give ?dst -> dest, ds:si -> source
		; returns: ?dst incremented, ds:si -> after match source
d0	mov byte [bp + ?errordata], 7Bh
	jc .error

.lze_loop_j1:
	jmp .lze_loop

.lze_combined:
	call load_word			; load combined word

	mov bx, ax
	stc				; CY
	rcr bh, 1			; rotate in a 1
	sar bh, 1
	sar bh, 1			; fill top three bits with 1s
%if 1	; _4
	sar bh, 1			; fill top *four* bits with 1s
	and ah, 15
%else
	and ah, 7
%endif
	mov cl, ah			; ch already = 0
	jnz .lze_match_cx_plus_2	; length = cx + 2, bx = displacement

.lze_escape:
	call load_byte			; ah = 0
	cmp al, 1
	jb .end_check
	xchg cx, ax			; cx = length
	ja .lze_match_cx_plus_1		; length = cx + 1, bx = displacement

.lze_normalise:
%if _LONGLITERAL
	xchg cx, bx			; cx = displacement, top 4 or 3 bits sets
 %if 1 ; _4
	and ch, ~ 1111_0000b		; isolate 12-bit displacement
 %else
	and ch, ~ 1110_0000b		; isolate 13-bit displacement
 %endif
 	jcxz .normalise			; displacement 0 means segment change -->
 	cmp cx, 26			; long literals command needs >= 26 bytes
 	jb .error			; (reserved for future expansion)
 	jmp .loop_literal		; process the literals -->
%endif
.normalise:
	jmp .lze_loop_j1

.end_check:
d0	mov byte [bp + ?errordata], 7Dh
	xor cx, cx
	cmp word [bp + ?src_remaining], cx
	jne .error
	cmp word [bp + ?dst_remaining], cx
	je .error

	les di, [bp + ?dst]
	stosb				; NUL terminate data

.end:
	db __TEST_IMM8			; (NC)
.error:
	stc

%if _COUNTER
	lahf
	mov al, 13
	call disp_al_for_progress
	mov al, 10
	call disp_al_for_progress
	sahf
%endif
d0	mov bx, word [bp + ?errordata]
	lleave code
	lret
%else

@@:
	call read_byte
d0	mov byte [bp + ?errordata], 70h
	jc .error

	mov ah, 0
	test ax, ax
d0	mov byte [bp + ?errordata], 71h
	jz .error
	cmp al, 15
	ja .error

	lvar word,	window_size_bits
	 push ax

	call read_byte
d0	mov byte [bp + ?errordata], 72h
	jc .error

	mov ah, 0
	test ax, ax
d0	mov byte [bp + ?errordata], 73h
	jz .error
	cmp ax, word [bp + ?window_size_bits]
	jae .error

	lvar word,	lookahead_size_bits
	 push ax

	xor cx, cx
	lvar word,	low_bit_index_and_high_current_byte
	 push cx

.loop:
%if _COUNTER
	inc byte [bp + ?counter]
	test byte [bp + ?counter], _COUNTER - 1
	jnz @F
	mov al, '.'
	call disp_al
@@:
%endif
	mov cx, 1
	call get_bits
	jnc .notend			; (cx = 0 if jumping)

d0	mov byte [bp + ?errordata], 7Dh
.end_check:
	xor ax, ax
	cmp word [bp + ?src_remaining], ax
	jne .error

	cmp word [bp + ?dst_remaining], ax
	je .error

	les di, [bp + ?dst]
	stosb				; NUL terminate data

	db __TEST_IMM8			; (NC)
.error:
	stc

%if _COUNTER
	lahf
	mov al, 13
	call disp_al
	mov al, 10
	call disp_al
	sahf
%endif
d0	mov bx, word [bp + ?errordata]
	lleave code
	lret

.notend:				; (cx = 0)
	test al, al
	jz .notliteral

.hs_literal:
	mov cl, 8
	call get_bits			; cx = 0
d0	mov byte [bp + ?errordata], 74h
	jc .end_check
%if _DEPACKINLINELITERAL
	sub word [bp + ?dst_remaining], 1
					; enough space left ?
	jb .error			; no --> (CY)
	les di, [bp + ?dst]		; -> destination
	stosb				; store it
	mov word [bp + ?dst], di	; update ?dst
%else
	push ax				; on stack: the literal
	 push ss
	 pop ds
	mov si, sp			; ds:si -> data on stack
	xchg ax, cx			; ax = 0
	inc ax				; length = 1
	call copy_data
	pop ax				; (discard)
d0	mov byte [bp + ?errordata], 75h
	jc .error
%endif
%assign LENGTHOFLITERAL $ - .hs_literal
%warning length of hs literal = LENGTHOFLITERAL

	jmp .loop

.notliteral:				; (cx = 0)
	mov cl, byte [bp + ?window_size_bits]
					; cx = -w parameter
	call get_bits
d0	mov byte [bp + ?errordata], 76h
	jc .end_check
		; ax = output index
		; cx = 0
	xchg bx, ax
	mov cl, byte [bp + ?lookahead_size_bits]
					; cx = -l parameter
	call get_bits
d0	mov byte [bp + ?errordata], 77h
	jc .end_check
		; bx = output index less 1
		; ax = output count less 1
	inc bx				; = output index
d0	mov byte [bp + ?errordata], 78h
	jz .error

					; ax = length of match less one
	inc ax				; = length of match
	jz .error

	mov cx, bx
	neg cx				; -1 .. -65535

	lds si, [bp + ?dst]
	add si, cx
%ifn _Z
	jnc .copy_zeros

	cmp word [bp + ?original_dst], si
					; is source of matching within ?dst ?
	ja .copy_zeros			; no, ?original_dst is above it -->
%endif

.copy_data:
	call copy_data			; give ?dst -> dest, ds:si -> source
		; returns: ?dst incremented, ds:si -> after match source
d0	mov byte [bp + ?errordata], 7Bh
	jc .error

	jmp .loop


%ifn _Z
		; INP:	cx = negative displacement from ?dst
		;	ax = length of match
		;	?dst
		;	?original_dst
.copy_zeros:
	push ax				; stacked = length of match

	neg cx

	mov di, word [bp + ?dst]

	mov ax, word [bp + ?original_dst]
	sub di, ax			; di = ?dst - ?original_dst
					;  = maximum displacement

	sub cx, di			; = over-long displacement - max
					;  = how many zeros to insert
	mov ax, cx			; ax = how many zeros
	pop di				; di = length of match
d0	mov byte [bp + ?errordata], 81h
	jb .error

	sub di, ax			; = how many - how many zeros
					;  = how much to copy from ?original_dst
	jnc @F				; = jnb = jae = jump if di is >= 0
	add di, ax			; restore di
	mov ax, di			; ax = full match length
					;  (below "how many zeros")
	xor di, di			; reset to zero, no copy from ?original_dst
@@:
	push di				; stack it again
	call store_zeros		; store zeros
	pop ax				; ax = how much to copy
d0	mov byte [bp + ?errordata], 83h
	jc .error

	lds si, [bp + ?original_dst]	; -> ?original_dst
	jmp .copy_data			; back to common handling -->
%endif
%endif


		; INP:	?dst -> destination
		;	ds:si -> source
		;	ax = how long the data is (0 is valid)
		; OUT:	?dst incremented
		;	?dst_remaining shortened
		;	CY if error (buffer too small)
		;	NC if success
		; CHG:	cx, bx, dx, ax, es, di, ds, si
%if !_Z && !_LZEXEDAT
store_zeros:
	mov bx, copy_data.stosb_zeros
	jmp @F
%endif

copy_data:
%if !_Z && !_LZEXEDAT
	mov bx, .movsb
@@:
%endif
d0	inc byte [bp + ?errordata + 1]
	sub word [bp + ?dst_remaining], ax
					; enough space left ?
	jb .ret				; no --> (CY)
					; now NC
	les di, [bp + ?dst]

	xchg cx, ax			; cx = remaining length
%if !_Z && !_LZEXEDAT
	call bx				; move
%else
	rep movsb			; NC preserved
%endif
	mov word [bp + ?dst], di
.ret:
	retn

%if _Z && !_LZEXEDAT
		; INP:	NC
		;	cx = count, may be zero
		; OUT:	NC
.movsb:
	rep movsb
	retn

		; INP:	cx = count, may be zero
		; OUT:	NC
.stosb_zeros:
	push ax
	xor ax, ax
	rep stosb
	pop ax
	retn
%endif


%if _LZEXEDAT
		; INP:	?src_remaining
		;	word [?tagword] = tag word
		;	word [?tagbitscycle] = circular tag bits indicator
		;	 (there's always a single bit set in this word.
		;	 if this word is equal to 1 on INP then the tag
		;	 word must be reloaded, and the last bit shifted
		;	 out of the INP prior tag word.)
		; OUT:	NC if read a zero,
		;	CY if read a one,
		;	 ?src_remaining decremented
		;	 word [?tagword] updated
		;	 word [?tagbitscycle] updated
		;	branches to depack.error on error
		; CHG:	ds, si, ax
get_bit:
	ror word [bp + ?tagbitscycle], 1
	jnc .left
		; after this branch not taken, the cycle word
		;  wraps around to be equal to 8000h. this
		;  will wrap around again after 15 more ror.
	call load_word
	shr word [bp + ?tagword], 1
	mov word [bp + ?tagword], ax
	retn

.left:
	shr word [bp + ?tagword], 1
	retn

		; lodsw with ?src_remaining check
load_word:
	call load_byte
	xchg al, ah
	call load_byte
	xchg al, ah
	retn

		; lodsb with ?src_remaining check
load_byte:
	call read_byte
d0	mov byte [bp + ?errordata], 84h
	jc depack.error
	retn
%else
		; INP:	cx = 0..15
		; OUT:	NC if successful,
		;	 ax = value read
		;	 cx = 0
		;	CY if error
		; CHG:	ds, si
get_bits:
	push bx
	mov bx, word [bp + ?low_bit_index_and_high_current_byte]
	cmp cx, 15
	ja .error
	jcxz .error
	xor ax, ax
.loop:
	test bl, bl
	jnz .havebit
	push ax
	call read_byte
	mov bh, al
	mov bl, 80h
	pop ax
	jc .error
.havebit:
	shl ax, 1
	test bh, bl
	jz @F
	inc ax
@@:
	shr bl, 1
	loop .loop
.end:
	db __TEST_IMM8			; skip stc, NC
.error:
	stc
	mov word [bp + ?low_bit_index_and_high_current_byte], bx
	pop bx
	retn
%endif


		; INP:	?src_remaining
		; OUT:	NC if success,
		;	 al = value read
		;	 ?src_remaining decremented
		;	CY if error (source buffer too small),
		;	 ?src_remaining = 0
		; CHG:	ds, si
read_byte:
	sub word [bp + ?src_remaining], 1
	jb .empty

%if _STANDALONE
	call get_file_byte
%else
	call near [ss:hshrink_get_file_byte]
%endif
	retn

.empty:		; CY
	inc word [bp + ?src_remaining]
	retn

	lleave ctx

%ifn _STANDALONE
	resetdef COUNTER
	resetdef DEBUG0

	usesection lDEBUG_DATA_ENTRY
	align 2, db 0
hshrink_memory_source:
.offset:	dw 0
%if ! _PM && _MESSAGESEGMENT
.segment:	dw 0		; LOADER-relocate
%endif
hshrink_get_file_byte:
		dw hshrink_memory_read

	usesection lDEBUG_CODE
hshrink_memory_read:
%if _MESSAGESEGMENT
 %if _PM
	call get_messagesegsel
	mov si, [ss:hshrink_memory_source.offset]
 %else
	lds si, [ss:hshrink_memory_source]
 %endif
%else
	push ss
	pop ds
	mov si, [hshrink_memory_source.offset]
%endif
	lodsb
	mov word [ss:hshrink_memory_source.offset], si
	clc
	retn

%if _TEST_HELP_FILE
	usesection lDEBUG_DATA_ENTRY
filebuffer equ line_out
filebuffer.end equ line_out + 256
	align 2, db 0
filebuffer.next:	dw 0
filebuffer.tail:	dw 0
handle:			dw -1

	usesection lDEBUG_CODE

testhelpfile:
	call InDOS
	jnz error

@@:
	lodsb
	cmp al, 9
	je @B
	cmp al, 32
	je @B
	call iseol?
	je error
	mov dx, si
	dec dx

@@:
	lodsb
	cmp al, 9
	je @F
	cmp al, 32
	je @F
	call iseol?
	jne @B
@@:
	mov byte [si - 1], 0

	mov ax, 3D00h | 1_010_0_000b	; RO, DENY WRITE, No inherit
	doscall
	jc error
	mov word [handle], ax
	mov word [filebuffer.next], filebuffer
	mov word [filebuffer.tail], filebuffer

	xchg bx, ax
	mov ax, 4202h
	xor cx, cx
	xor dx, dx
	doscall
	jc error

	test dx, dx
	jnz error

	push ax
	mov ax, 4200h
	xor cx, cx
	xor dx, dx
	doscall
	pop cx				; = file size
	jc error

	mov word [ss:hshrink_get_file_byte], hshrink_file_read
					; insure correct source

%if _MESSAGESEGMENT
 %if _PM
	call get_messagesegsel		; ds => message segment
	push es
	push ds
	pop es
	pop ds				; swap ds, es
 %else
 	mov es, word [ss:messageseg]	; ds => message segment
 %endif
%else
	push ss
	pop es
%endif
%if _BOOTLDR_DISCARD_HELP
	mov di, [ss:indirect_hshrink_message_buffer]
	lea si, [di + hshrink_message_buffer_size]
%else
	mov di, nontruncated_hshrink_message_buffer
					; es:di -> destination
	mov si, nontruncated_hshrink_message_buffer + hshrink_message_buffer_size
					; si -> behind destination end
%endif
	push es
	push di
	call depack			; try depacking
	 push ss
	 pop es
	pop dx				; display our decompressed string
	pop ds
	jnc @F				; skip next part if not error -->
	push ss
	pop ds
	mov ax, 012Ah
	call setrc
	mov dx, msg.hshrink_error	; if error
@@:
	call putsz
	push ss
	pop ds
	mov bx, -1
	xchg bx, [handle]
	mov ah, 3Eh
	doscall
	retn


hshrink_file_read:
	push ss
	pop ds
	mov si, [filebuffer.next]
	cmp si, [filebuffer.tail]
	jb .buffered

	push ax
	push bx
	push cx
	push dx
	mov dx, filebuffer
	mov [filebuffer.next], dx
	mov [filebuffer.tail], dx
	mov ah, 3Fh
	mov bx, [handle]
	mov cx, filebuffer.end - filebuffer
	doscall
	jc .error
	test ax, ax
	jz .error
	add ax, dx
	mov word [filebuffer.tail], ax
	mov si, dx
	pop dx
	pop cx
	pop bx
	pop ax

.buffered:
	lodsb
	mov [filebuffer.next], si
	clc
	retn

.error:
	mov si, line_in + 2
	jmp error
%endif

%endif
