``````{
Robert Rothenburg

Here's some routines I wrote while playing around with some compression
algorithms.  Since they're written in Pascal, they're probably not too
fast but they work.

Of course they're need some tweaking.
}
(* NoFrills Bit-Input/Output Routines                        *)
(* Insert "n" bits of data into a Buffer or Pull "n" bits of *)
(* data from a buffer.  Useful for Compression routines      *)

unit BitIO;

interface

const
BufferSize = 32767;        (* Adjust as appropriate *)

type
Buffer  = array [0..BufferSize] of byte;
BufPtr  = ^Buffer;
BuffRec = record  (* This was used for I/O by some *)
Block : BufPtr; (* other units involved with the *)
Size,           (* compression stuff. Not so     *)
Ptr   : word;   (* Important?                    *)
Loc   : byte
end;

var
InBuffer,
OutBuffer : BuffRec;
InFile,
OutFile   : file;

procedure InitBuffer(var x : BuffRec);        (* Initialize a buffer *)
procedure GetBits(var b : word; num : byte);  (* Get num bits from   *)
(* InBuffer            *)
procedure PutBits(b : word; num : byte);      (* Put num bits into   *)
(* OutBuffer           *)
function Log2(x : word) : byte;               (* Self-explanatory... *)

implementation

const
Power : array [1..17] of longint =
(1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,65536);

procedure InitBuffer(var x : BuffRec);
begin
with x do
begin
Loc  := 8;
Ptr  := 0;
Size := 0;
New(Block);
FillChar(Block^, BufferSize, #0);
end;
end;

procedure GetBits(var b : word; num : byte);
var
Size : word;
begin
with InBuffer do
begin
b := 0;
repeat
b := (b SHL 1);
if (Block^[Ptr] AND Power[Loc]) <> 0 then
b := b OR 1;
dec(Loc);
if Loc = 0 then
begin
Loc := 8;
inc(Ptr);
end;
dec(num);
until (num = 0);
end;
end;

procedure PutBits(b : word; num : byte);
var
i : byte;
begin
with OutBuffer do
repeat
if Loc = 0 then
begin
inc(Ptr);
Loc := 8;
end;
if (b AND Power[num]) <> 0 then
begin
Block^[Ptr] := Block^[Ptr] OR Power[Loc];
dec(Loc);
end
else
dec(Loc);
dec(num)
until num = 0;
OutBuffer.Size := succ(OutBuffer.Ptr);
end;

function Log2(x : word) : byte;
var
i : byte;
begin
i := 17;
while x<Power[i] do
dec(i);
Log2 := i;
end;

end.

``````