(*
        Copyright (C) 1989,1990 Jensen & Partners International
*)
module apack2
  stats? = 0      (* count hash collisions and table resets *)
  reset? = 1      (* possible values are 0,1 *)
  ebit = 3        (* possible values are 0,1,3 *)
  buf_size = 3800H

  shift2 = ebit & 1
  shift4 = ( ebit & 2 ) / 2
  period = 8 / (ebit+1)

  max_hash = power2 (ebit+10 ) - 1
  max_code = power2 (ebit+9 ) - 1
  re_hash  = 113

segment APACK2_DATA(FAR_DATA,28H)

public apack2@prfx: org 2*(max_hash+1)   + 4   (* must be at 0 in actual segment !! *)
prfx = 0


public apack2@reset_count: org 2
public apack2@collision_count : org 2

public lim: org 2 (* limit for si *)
public apack2@p: org (buf_size/8) * ( 9 + ebit )
public char: org max_hash+1       + 2
public code: org 2*(max_hash+1)   + 4

segment APACK2_TEXT( CODE, 28H )

ClearTable:
  push ax; push cx; push di; push es
  push ds; pop es
  mov di, prfx
  mov cx, max_hash+1
  mov ax, -1
  rep; stosw
  pop es; pop di; pop cx; pop ax
  ret 0

public apack2$Pack: in = 6 ; n = 10
(* Current register usage:
   al : input char
   ah : zero
   bx : hash table index
   cl : free bit count for ch
   ch : holds extra bits
   dx : current code or 256+number of codes output since reset
   es:si : input pointer
   ds:di : output pointer
*)

  push bp
  mov bp, sp
  push si; push di; push ds; push es
  mov ax, APACK2_DATA
  mov ds, ax
(*%T stats?*)
  mov word [apack2@reset_count], 0
  mov word [apack2@collision_count],0
(*%E*)

  call ClearTable
  les si, [bp][in]
  mov dx, si
  add dx,[bp][n]
  mov [lim],dx

  db 26H; lodsb
  sub ah,ah
  mov dx,ax
  mov word bp, 256
  mov di, apack2@p+1
  mov ch,0
  mov cl,period
  jmp loop1

shift_zero:
  mov [di][-(period+1)], ch
  inc di
  mov cx,period
(*%F reset?*)
  cmp bp, max_code
  jne shift_zero_done
  mov bp,[lim]
  jmp near _output_done
(*%E*)
(*%T reset?*)
  jmp shift_zero_done
(*%E*)

(*%T reset?*)
clear:
(*%T stats?*) inc word [apack2@reset_count] (*%E*)
  call ClearTable
  mov bp, 256
  jmp output_done
(*%E*)

else1:
(*%T stats?*) inc word [apack2@collision_count] (*%E*)
  shl bx, 1
  add bx, re_hash*2
  jmp loop2


exit1x:
  jmp near exit1

match:
  shr bx,1
  cmp[char][bx], al
  jne else1
  shl bx,1
  mov dx, [code][bx]
(*jmp loop1*) (*unrolled once*)
  cmp si,[lim]
  je exit1x
  db 26H; lodsb
  mov bx,dx
  add bl,al
  add bh,al
(*loop2:*)
  and bx, max_hash*2
  cmp [prfx][bx], dx
  je match
  cmp word [prfx][bx],-1
  jne collide
output:
  shl ch,1
(*%T shift2*) shl ch,1 (*%E*)
(*%T shift4*) shl ch,1 (*%E*)
(*%T shift4*) shl ch,1 (*%E*)
  add ch, dh
  mov [di], dl
  inc di
  dec cl
  jz  shift_zero
shift_zero_done:
  mov [prfx][bx],dx
  mov [code][bx],bp
  shr bx,1
  mov [char][bx],al
  inc bp
(*%T reset?*)
  cmp bp, max_code+1
  je clear
(*%E*)
output_done:
  mov dx,ax

loop1:
  cmp si,[lim]
  je exit1
  db 26H; lodsb
  mov bx,dx
  add bl,al
  add bh,al
loop2:
  and bx, max_hash*2
  cmp word [prfx][bx],-1
  je output
  cmp [prfx][bx], dx
  je match
collide:
(*%T stats?*) inc word [apack2@collision_count] (*%E*)
  add bx, re_hash*2
(*jmp loop2*) (*unroll 1*)
  and bh, max_hash / 128
  cmp word [prfx][bx],-1
  je output
  cmp [prfx][bx], dx
  je match
(*%T stats?*) inc word [apack2@collision_count] (*%E*)
  add bx, re_hash*2
(*jmp loop2*) (*unroll 2*)
  and bh, max_hash / 128
  cmp word [prfx][bx],-1
  je output
  cmp [prfx][bx], dx
  je match
(*%T stats?*) inc word [apack2@collision_count] (*%E*)
  add bx, re_hash*2
  jmp loop2 (*end unroll*)

exit1:
  shl ch,1
(*%T shift2*) shl ch,1 (*%E*)
(*%T shift4*) shl ch,1 (*%E*)
(*%T shift4*) shl ch,1 (*%E*)
  add ch, dh
  mov [di], dl
  inc di
  dec cl
  mov ax, di
  sub ax, apack2@p
  mov dl, ch
  sub ch,ch
  add di,cx
(*%T shift2*) shl cl,1 (*%E*)
(*%T shift4*) shl cl,1 (*%E*)
  shl dl,cl
  mov [di][-(period+1)], dl

  pop es; pop ds; pop di; pop si
  pop bp;
  ret far 6

(*%F reset?*)

_shift_zero:
  mov [di][-(period+1)], ch
  inc di
  mov cx,period
  jmp _shift_zero_done

_else1:
(*%T stats?*) inc word [apack2@collision_count] (*%E*)
  shl bx, 1
  add bx, re_hash*2
  jmp _loop2

_exit1:
  jmp exit1

_match:
  shr bx,1
  cmp[char][bx], al
  jne _else1
  shl bx,1
  mov dx, [code][bx]
(*jmp _loop1*) (* unrolled copy of loop1*)
  cmp si,bp
  je exit1
  db 26H; lodsb
  mov bx,dx
  add bl,al
  add bh,al
(*_loop2:*)
  and bx, max_hash*2
  cmp [prfx][bx], dx
  je _match
  cmp word [prfx][bx],-1
  jne _collide
_output:
  shl ch,1
(*%T shift2*) shl ch,1 (*%E*)
(*%T shift4*) shl ch,1 (*%E*)
(*%T shift4*) shl ch,1 (*%E*)
  add ch, dh
  mov [di], dl
  inc di
  dec cl
  jz  _shift_zero
_shift_zero_done:
_output_done:
  mov dx,ax

_loop1:
  cmp si,bp
  je _exit1
  db 26H; lodsb
  mov bx,dx
  add bl,al
  add bh,al
_loop2:
  and bx, max_hash*2
  cmp word [prfx][bx],-1
  je _output
  cmp [prfx][bx], dx
  je _match
_collide:
(*%T stats?*) inc word [apack2@collision_count] (*%E*)
  add bx, re_hash*2
(*jmp loop2*) (*unroll 1*)
  and bh, max_hash / 128
  cmp word [prfx][bx],-1
  je _output
  cmp [prfx][bx], dx
  je _match
(*%T stats?*) inc word [apack2@collision_count] (*%E*)
  add bx, re_hash*2
(*jmp loop2*) (*unroll 2*)
  and bh, max_hash / 128
  cmp word [prfx][bx],-1
  je _output
  cmp [prfx][bx], dx
  je _match
(*%T stats?*) inc word [apack2@collision_count] (*%E*)
  add bx, re_hash*2
  jmp _loop2 (*end unroll*)

(*%E*) (*reset?*)

errmsg: db 'Unpack error'

public apack2$Unpack: out = 16; n = 20
  k = 10
  sub sp, 2
  push si; push di; push ds; push es
  push bp
  mov bp,sp
  mov ax, APACK2_DATA ; mov ds, ax
  les di, [bp][out]
  add [bp][n], di
  mov si, apack2@p

  (* new shift *)
  mov cl,period
  mov ch,[si]
  inc si

  (* get first code *)
  lodsb
  sub ah,ah
  shl ch,1 ; rcl ah,1
(*%T shift2*)  shl ch,1; rcl ah,1 (*%E*)
(*%T shift4*)  shl ch,1; rcl ah,1 (*%E*)
(*%T shift4*)  shl ch,1; rcl ah,1 (*%E*)

  (* reset *)
  mov bx, 256
  mov [code][512],ax
  mov [bp][k],al
  stosb

  jmp uloop1
more:
  pop ax
  stosw
uloop1:
  cmp sp, bp
  jne more
  cmp di, [bp][n]
  jae uexit1
  dec cl
  jz new_shift
new_shift_done:
  lodsb
  sub ah,ah
  shl ch,1 ; rcl ah,1
(*%T shift2*)  shl ch,1; rcl ah,1 (*%E*)
(*%T shift4*)  shl ch,1; rcl ah,1 (*%E*)
(*%T shift4*)  shl ch,1; rcl ah,1 (*%E*)

(*%T reset?*)
  cmp bx, max_code
  je reset
(*%E*)

  mov dx,bx
  shl bx,1
  mov [code][bx][2],ax
  cmp ax,dx
  jae special_case
  mov bx,ax
uloop22_test:
  cmp bx, 256
  jae uloop21
  mov [bp][k], bx
  mov al, bl
  stosb
  xchg bx,dx
(*%F reset?*)
  cmp bx, max_code+1
  je _uloop1
(*%E*)
  mov [char][bx],dl
  inc bx
  jmp uloop1
uloop21:
  mov ah, [char][bx]
  shl bx,1
  mov bx, [code][bx]
uloop21_test:
  cmp bx, 256
  jae uloop2_continue
  mov [bp][k], bx
  mov al,bl
  stosw
  xchg bx,dx
(*%F reset?*)
  cmp bx, max_code+1
  je _uloop1
(*%E*)
  mov [char][bx],dl
  inc bx
  jmp uloop1
uloop2_continue:
  mov al, [char][bx]
  push ax
  shl bx,1
  mov bx, [code][bx]
  jmp uloop22_test
new_shift:
  mov cl,period
  mov ch,[si]
  inc si
  jmp new_shift_done

uexit1:
  ja unpack_error
  pop bp
  pop es; pop ds; pop di; pop si
  add sp, 2
  ret far 6

(*%T reset?*)
reset:
  mov bx, 256
  mov [code][512],ax
  mov [bp][k],al
  stosb
  jmp uloop1
(*%E*)

special_case:
  ja unpack_error
  mov ah, [bp][k]
  mov bx, [code][bx]
  jmp uloop21_test

unpack_error:
(*
  mov ax, unpack_error - errmsg
  push ax
  mov ax, errmsg
  push cs
  push ax
  extrn AsmLib$FatalError
  call far AsmLib$FatalError
*)
(**)
  xor ax,ax
  push ax
  push ax
  push ax
  extrn __FatalError
  call far __FatalError
(**)


(*%F reset?*)
_more:
  pop ax
  stosw
_uloop1:
  cmp sp, bp
  jne _more
  cmp di, [bp][n]
  jae uexit1
  dec cl
  jz _new_shift
_new_shift_done:
  lodsb
  sub ah,ah
  shl ch,1 ; rcl ah,1
(*%T shift2*)  shl ch,1; rcl ah,1 (*%E*)
(*%T shift4*)  shl ch,1; rcl ah,1 (*%E*)
(*%T shift4*)  shl ch,1; rcl ah,1 (*%E*)

  mov dx,bx
  shl bx,1
  mov [code][bx][2],ax
  cmp ax,dx
  jae _special_case
  mov bx,ax
_uloop22_test:
  cmp bx, 256
  jae _uloop21
  mov [bp][k], bx
  mov al, bl
  stosb
  xchg bx,dx
  jmp _uloop1
_uloop21:
  mov ah, [char][bx]
  shl bx,1
  mov bx, [code][bx]
_uloop21_test:
  cmp bx, 256
  jae _uloop2_continue
  mov [bp][k], bx
  mov al,bl
  stosw
  xchg bx,dx
  jmp _uloop1
_uloop2_continue:
  mov al, [char][bx]
  push ax
  shl bx,1
  mov bx, [code][bx]
  jmp _uloop22_test
_new_shift:
  mov cl,period
  mov ch,[si]
  inc si
  jmp _new_shift_done

_special_case:
  ja unpack_error
  mov ah, [bp][k]
  mov bx, [code][bx]
  jmp _uloop21_test

(*%E*) (* reset? *)

end