{
 PACK-ICE depacking program
 Converted from MC68000 assembler source of SND Player v1.4
 Source file is 'ice_unpa.s' by Anders Eriksson / Odd Skancke
 Converted to Pascal by Sergey Bulba, vorobey@mail.khstu.ru at
 20 of November, 2001

 I wrote this conversion for unpacking ATARI ST SNDH files. Part
 of code from point "//not tested begin" to point "//not tested end"
 is not tested because of I have no any SNDH files, which require this
 strange piece of code.

 Usage from command line:

        Ice.exe [packed_file_name]

 and "packed_file_name.unpacked" will be produced.
}

program Ice;

{$APPTYPE CONSOLE}

type
 SIPtr = ^smallint;
 
const
 direct_tab:array[0..4] of record
  NumberOfBits,BitsMaxValue,AdditionToBitsValue:integer
 end =
  ((NumberOfBits:15;BitsMaxValue:$7fff;AdditionToBitsValue:270),
   (NumberOfBits: 8;BitsMaxValue:$00ff;AdditionToBitsValue: 15),
   (NumberOfBits: 3;BitsMaxValue:$0007;AdditionToBitsValue:  8),
   (NumberOfBits: 2;BitsMaxValue:$0003;AdditionToBitsValue:  5),
   (NumberOfBits: 2;BitsMaxValue:$0003;AdditionToBitsValue:  2));
 length_tab:array[0..9] of shortint =
  (10,2,1,-1,-1,8,4,2,1,0);
 more_offset:array[0..2] of shortint =
  (12,5,8);
 more_offset2:array[0..2] of smallint =
  ($11f,-1,31);

var
 f:file;
 PackedSize,UnpackedSize,PI,UI:integer;
 BitGroup:smallint;
 CB:byte;
 PackedBuffer,UnpackedBuffer:array of byte;

// Increase byte a with byte b and carry the overflow
function IncByteWithOverflow(byteA: word; byteB: word): byte;
begin
	if ((byteA + byteB) >= 256) then
		result := (byteA + byteB - 256)
	else
		result := (byteA + byteB);
end;

procedure SwapL(var a:integer);
var
 b,c,d:integer;
begin
 b := a and $ff00 shl 8;
 c := a and $ff0000 shr 8;
 d := a shr 24;
 a := a shl 24 + b + c + d
end;

function get_1_bit:integer;
var
 a:integer;
begin
if shortint(CB) < 0 then
 Result := 1
else
 Result := 0;
CB := IncByteWithOverflow(CB,CB);
if CB = 0 then
 begin
  dec(PI);
  CB := PackedBuffer[PI];
  a := Result;
  if shortint(CB) < 0 then
   Result := 1
  else
   Result := 0;
  CB := IncByteWithOverflow(CB,CB + a);
 end
end;

procedure get_N_bits(N:byte);
var
 a,b,i:integer;
begin
BitGroup := 0;
for i := 1 to N do
 begin
  if shortint(CB) < 0 then
   a := 1
  else
   a := 0;
  CB := IncByteWithOverflow(CB,CB);
  if CB = 0 then
   begin
    dec(PI);
    CB := PackedBuffer[PI];
    b := a;
    if shortint(CB) < 0 then
     a := 1
    else
	  a := 0;
	 CB := IncByteWithOverflow(CB,CB + b);
   end;
  inc(BitGroup,BitGroup + a)
 end
end;

procedure normal_bytes;
var
 i,j,k:integer;
begin
repeat
if get_1_bit <> 0 then
 begin
  BitGroup := 1;
  if get_1_bit <> 0 then
   begin
    j := 5;
    for i := 0 to 4 do
     begin
      dec(j);
      get_N_bits(direct_tab[j].NumberOfBits);
      if direct_tab[j].BitsMaxValue <> BitGroup then break
     end;
    inc(BitGroup,direct_tab[j].AdditionToBitsValue)
   end;
  {copy_direct}
  dec(PI,BitGroup);
  dec(UI,BitGroup);
  Move(PackedBuffer[PI],UnpackedBuffer[UI],BitGroup);
 end;
{test_if_end}
if UI > 0 then
 begin {strings}
  i := 4;
  repeat
   if get_1_bit = 0 then break;
   dec(i)
  until i = 0;
  BitGroup := 0;
  j := smallint(length_tab[i]);
  if j >= 0 then
   get_N_bits(j);
  k := length_tab[i + 5] + BitGroup;
  if k <> 0 then
   begin
    i := 2;
    repeat
     if get_1_bit = 0 then break;
     dec(i)
    until i = 0;
    get_N_bits(more_offset[i]);
    inc(BitGroup,more_offset2[i]);
    if BitGroup < 0 then
     dec(BitGroup,k);
   end
  else
   begin
   {get_offset_2}
    i := 6;
    j := -1;
    if get_1_bit <> 0 then
     begin
      i := 9;
      j := $3f
     end;
    get_N_bits(i);
    inc(BitGroup,j);
   end;
  {depack_bytes}
  j := UI + k + BitGroup + 1;
  dec(UI);
  UnpackedBuffer[UI] := UnpackedBuffer[j];
  for i := 0 to k do
   begin
    dec(j);
    dec(UI);
    UnpackedBuffer[UI] := UnpackedBuffer[j]
   end
 end
until UI <= 0
end;

var
 i,j,a:integer;
 k:word;
 l:smallint;
 m:packed record
  case Boolean of
  True:(m1,m2,m3,m4:word);
  False:(l1,h1,l2,h2,l3,h3,l4,h4:byte);
 end;

begin
if Paramcount <> 1 then
 begin
  Writeln('Usage:');
  Writeln('Ice.exe [packed_file_name]');
  exit
 end;
AssignFile(f,ParamStr(1));
FileMode := 0;
Reset(f,1);
BlockRead(f,i,4);
if i <> $21454349 then
 begin
  Writeln('Error: already unpacked');
  CloseFile(f);
  exit
 end;
BlockRead(f,PackedSize,4);
SwapL(PackedSize);
if PackedSize > FileSize(f) then
 begin
  Writeln('Error: damaged file');
  CloseFile(f);
  exit
 end;
dec(PackedSize,12);
PI := PackedSize;
BlockRead(f,UnpackedSize,4);
SwapL(UnpackedSize);
UI := UnpackedSize;
SetLength(PackedBuffer,PackedSize);
BlockRead(f,PackedBuffer[0],PackedSize);
CloseFile(f);
SetLength(UnpackedBuffer,UnpackedSize);
dec(PI);
CB := PackedBuffer[PI];
normal_bytes;
UI := UnpackedSize;
if get_1_bit <> 0 then
 begin
  //not tested begin
  k := $f9f;
  if get_1_bit <> 0 then
   begin
    get_N_bits(16);
    k := BitGroup
   end;
  {ice_00}
  for k := 0 to k do
   begin
    for i := 0 to 3 do
     begin
      dec(UI,2);
      l := SIPtr(@UnpackedBuffer[UI])^;
      for j := 0 to 3 do
       begin
        if l < 0 then
         a := 1
        else
         a := 0;
        inc(l,l);
        inc(m.m1,m.m1 + a);
        if l < 0 then
         a := 1
        else
         a := 0;
        inc(l,l);
        inc(m.m2,m.m2 + a);
        if l < 0 then
         a := 1
        else
         a := 0;
        inc(l,l);
        inc(m.m3,m.m3 + a);
        if l < 0 then
         a := 1
        else
         a := 0;
        inc(l,l);
        inc(m.m4,m.m4 + a);
       end
     end;
    UnpackedBuffer[UI] := m.h1;
    UnpackedBuffer[UI + 1] := m.l1;
    UnpackedBuffer[UI + 2] := m.h2;
    UnpackedBuffer[UI + 3] := m.l2;
    UnpackedBuffer[UI + 4] := m.h3;
    UnpackedBuffer[UI + 5] := m.l3;
    UnpackedBuffer[UI + 6] := m.h4;
    UnpackedBuffer[UI + 7] := m.l4
   end;
  //not tested end
 end;
AssignFile(f,ParamStr(1) + '.unpacked');
Rewrite(f,1);
BlockWrite(f,UnpackedBuffer[0],UnpackedSize);
CloseFile(f)
end.
