Bitwise IO: Difference between revisions

From Rosetta Code
Content added Content deleted
(→‎{{header|Perl}}: ++ mips sit)
Line 692: Line 692:
with IO.No_more_input ->
with IO.No_more_input ->
(Buffer.contents buf)</lang>
(Buffer.contents buf)</lang>

=={{header|MIPS Assembly}}==
See [[Bitwise IO/MIPS Assembly]]


=={{header|Perl}}==
=={{header|Perl}}==

Revision as of 18:06, 8 June 2010

Task
Bitwise IO
You are encouraged to solve this task according to the task description, using any language you may know.

The aim of this task is to write functions (or create a class if your language is Object Oriented and you prefer) for reading and writing sequences of bits. While the output of a asciiprint "STRING" is the ASCII byte sequence "S", "T", "R", "I", "N", "G", the output of a "print" of the bits sequence 0101011101010 (13 bits) must be 0101011101010; real I/O is performed always quantized by byte (avoiding endianness issues and relying on underlying buffering for performance), therefore you must obtain as output the bytes 0101 0111 0101 0000 (bold bits are padding bits), i.e. in hexadecimal 57 50.

As test, you can implement a rough (e.g. don't care about error handling or other issues) compression/decompression program for ASCII sequences of bytes, i.e. bytes for which the most significant bit is always unused, so that you can write seven bits instead of eight (each 8 bytes of input, we write 7 bytes of output).

These bit oriented I/O functions can be used to implement compressors and decompressors; e.g. Dynamic and Static Huffman encodings use variable length bits sequences, while LZW (see LZW compression) use fixed words nine (or more) bits long.

  • Limits in the maximum number of bits that can be written/read in a single read/write operation are allowed.
  • Errors handling is not mandatory


Ada

<lang ada>with Ada.Streams; use Ada.Streams; with Ada.Finalization;

package Bit_Streams is

  type Bit is range 0..1;
  type Bit_Array is array (Positive range <>) of Bit;
  type Bit_Stream (Channel : not null access Root_Stream_Type'Class) is limited private;
  procedure Read (Stream : in out Bit_Stream; Data : out Bit_Array);
  procedure Write (Stream : in out Bit_Stream; Data : Bit_Array);

private

  type Bit_Stream (Channel : not null access Root_Stream_Type'Class) is
     new Ada.Finalization.Limited_Controlled with
  record
     Read_Count  : Natural := 0;
     Write_Count : Natural := 0;
     Input       : Stream_Element_Array (1..1);
     Output      : Stream_Element_Array (1..1);
  end record;
  overriding procedure Finalize (Stream : in out Bit_Stream);

end Bit_Streams;</lang> The package provides a bit stream interface to a conventional stream. The object of Bit_Stream has a discriminant of any stream type. This stream will be used for physical I/O. Bit_Stream reads and writes arrays of bits. There is no need to have flush procedure, because this is done upon object destruction. The implementation is straightforward, big endian encoding of bits into Stream_Element units is used as required by the task: <lang ada>package body Bit_Streams is

  procedure Finalize (Stream : in out Bit_Stream) is
  begin
     if Stream.Write_Count > 0 then
        Stream.Output (1) := Stream.Output (1) * 2**(Stream_Element'Size - Stream.Write_Count);
        Stream.Channel.Write (Stream.Output);
     end if;
  end Finalize;
  procedure Read (Stream : in out Bit_Stream; Data : out Bit_Array) is
     Last : Stream_Element_Offset;
  begin
     for Index in Data'Range loop
        if Stream.Read_Count = 0 then
           Stream.Channel.Read (Stream.Input, Last);
           Stream.Read_Count := Stream_Element'Size;
        end if;
        Data (Index) := Bit (Stream.Input (1) / 2**(Stream_Element'Size - 1));
        Stream.Input (1)  := Stream.Input (1) * 2;
        Stream.Read_Count := Stream.Read_Count - 1;
     end loop;
  end Read;
  procedure Write (Stream : in out Bit_Stream; Data : Bit_Array) is
  begin
     for Index in Data'Range loop
        if Stream.Write_Count = Stream_Element'Size then
           Stream.Channel.Write (Stream.Output);
           Stream.Write_Count := 0;
        end if;
        Stream.Output (1)  := Stream.Output (1) * 2 or Stream_Element (Data (Index));
        Stream.Write_Count := Stream.Write_Count + 1;
     end loop;
  end Write;

end Bit_Streams;</lang>

Example of use: <lang ada>with Ada.Streams.Stream_IO; use Ada.Streams.Stream_IO; with Bit_Streams; use Bit_Streams;

procedure Test_Bit_Streams is

  File   : File_Type;
  ABACUS : Bit_Array :=
              (  1,0,0,0,0,0,1,  -- A, big endian
                 1,0,0,0,0,1,0,  -- B
                 1,0,0,0,0,0,1,  -- A
                 1,0,0,0,0,1,1,  -- C
                 1,0,1,0,1,0,1,  -- U
                 1,0,1,0,0,1,1   -- S 	
              );
  Data : Bit_Array (ABACUS'Range);

begin

  Create (File, Out_File, "abacus.dat");
  declare
     Bits : Bit_Stream (Stream (File));
  begin
     Write (Bits, ABACUS);
  end;
  Close (File);
  Open (File, In_File, "abacus.dat");
  declare
     Bits : Bit_Stream (Stream (File));
  begin
     Read (Bits, Data);
  end;
  Close (File);
  if Data /= ABACUS then
     raise Data_Error;
  end if;

end Test_Bit_Streams;</lang>

ALGOL 68

Works with: ALGOL 68 version Revision 1 - no extensions to language used
Works with: ALGOL 68G version Any - tested with release 1.18.0-9h.tiny
Works with: ELLA ALGOL 68 version Any (with appropriate job cards) - tested with release 1.8-8d

<lang algol68># NIBBLEs are of any width, eg 1-bit OR 4-bits etc. # MODE NIBBLE = STRUCT(INT width, BITS bits);

PRIO << = 8, >> = 8; # define C style shift opertors # OP << = (BITS bits, INT shift)BITS: bits SHL shift; OP >> = (BITS bits, INT shift)BITS: bits SHR shift;

  1. define nibble opertors for left/right shift and append #

OP << = (NIBBLE nibble, INT shift)NIBBLE:

 (width OF nibble + shift, bits OF nibble << shift);

OP >> = (NIBBLE nibble, INT shift)NIBBLE:

 (width OF nibble - shift, bits OF nibble >> shift);

OP +:= = (REF NIBBLE lhs, NIBBLE rhs)REF NIBBLE: (

 BITS rhs mask := BIN(ABS(2r1 << width OF rhs)-1);
 lhs := ( width OF lhs + width OF rhs, bits OF lhs << width OF rhs OR bits OF rhs AND rhs mask)

);

  1. define MODEs for generating NIBBLE streams and yielding NIBBLEs #

MODE YIELDNIBBLE = PROC(NIBBLE)VOID; MODE GENNIBBLE = PROC(YIELDNIBBLE)VOID;

PROC gen resize nibble = (

 INT out width,
 GENNIBBLE gen nibble, 
 YIELDNIBBLE yield

)VOID:(

    NIBBLE buf := (0, 2r0), out;
    BITS out mask := BIN(ABS(2r1 << out width)-1);
  1. FOR NIBBLE nibble IN # gen nibble( # ) DO #
    1. (NIBBLE in nibble)VOID:(
   buf +:= in nibble;
   WHILE width OF buf >= out width DO
     out := buf >> ( width OF buf - out width);
     width OF buf -:= out width; # trim 'out' from buf #
     yield((out width, bits OF out AND out mask))
   OD
  1. OD # ))

);

  1. Routines for joining strings and generating a stream of nibbles #

PROC gen nibble from 7bit chars = (STRING string, YIELDNIBBLE yield)VOID:

 FOR key FROM LWB string TO UPB string DO yield((7, BIN ABS string[key])) OD;

PROC gen nibble from 8bit chars = (STRING string, YIELDNIBBLE yield)VOID:

 FOR key FROM LWB string TO UPB string DO yield((8,BIN ABS string[key])) OD;

PROC gen join = ([]STRING strings, STRING new line, YIELDNIBBLE yield)VOID:

  FOR key FROM LWB strings TO UPB strings DO
    gen nibble from 8bit chars(strings[key]+new line, yield)
  OD;
  1. Two tables for uuencoding 6bits in printable ASCII chacters #

[0:63]CHAR encode uue 6bit:= # [0:63] => CHAR64 #

 "`!""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_"[@0];

[0:255]BITS decode uue 6bit; # CHAR64 => [0:63] #

 FOR key FROM LWB encode uue 6bit TO UPB encode uue 6bit DO 
   decode uue 6bit[ABS encode uue 6bit[key]] := BIN key
 OD;
 decode uue 6bit[ABS " "] := 2r0; # extra #
  1. Some basic examples #

PROC example uudecode nibble stream = VOID:(

 []STRING encoded uue 6bit hello world = (
   ":&5L;&\L('=O<FQD""DAE;&QO+""!W;W)L9""$*1V]O9&)Y92P@8W)U96P@=V]R",
   ";&0*22=M(&QE879I;F<@>6]U('1O9&%Y""D=O;V1B>64L(&=O;V1B>64L(&=O",
   ";V1B>64@""@``"
 );
 PROC gen join hello world = (YIELDNIBBLE yield)VOID: 
 # FOR NIBBLE nibble IN # gen join(encoded uue 6bit hello world, "", # ) DO # 
 ##   (NIBBLE nibble)VOID:(
   yield((6, decode uue 6bit[ABS bits OF nibble]))
 # OD # ));
 print(("Decode uue 6bit NIBBLEs into 8bit CHARs:", new line));
  1. FOR NIBBLE nibble IN # gen resize nibble(8, gen join hello world, # ) DO ( #
    1. (NIBBLE nibble)VOID:(
   print(REPR ABS bits OF nibble)
  1. OD # ))

);

PROC example uuencode nibble stream = VOID: (

 []STRING hello world = (
   "hello, world",
   "Hello, world!",
   "Goodbye, cruel world",
   "I'm leaving you today",
   "Goodbye, goodbye, goodbye "
 );
 PROC gen join hello world = (YIELDNIBBLE yield)VOID: 
   gen join(hello world, REPR ABS 8r12, yield); # 8r12 = ASCII new line #
 print((new line, "Encode 8bit CHARs into uue 6bit NIBBLEs:", new line));
 INT count := 0;
  1. FOR NIBBLE nibble IN # gen resize nibble(6, gen join hello world, # ) DO ( #
    1. (NIBBLE nibble)VOID:(
   print(encode uue 6bit[ABS bits OF nibble]);
   count+:=1;
   IF count MOD 60 = 0 THEN print(newline) FI
  1. OD # ));
   print(new line); print(new line)

);

PROC example compress 7bit chars = VOID: (

 STRING example 7bit string = "STRING & ABACUS";
 print(("Convert 7bit ASCII CHARS to a 1bit stream: ",new line,
         example 7bit string + " => "));
 PROC gen example 7bit string = (YIELDNIBBLE yield)VOID:
   gen nibble from 7bit chars(example 7bit string,yield);
  1. FOR NIBBLE nibble IN # gen resize nibble(1, gen example 7bit string, # ) DO ( #
    1. (NIBBLE nibble)VOID: (
   print(whole(ABS bits OF nibble,0))
  1. OD # ));
 print(new line)

);

example uudecode nibble stream; example uuencode nibble stream; example compress 7bit chars </lang> Output:

Decode uue 6bit NIBBLEs into 8bit CHARs:
hello, world
Hello, world!
Goodbye, cruel world
I'm leaving you today
Goodbye, goodbye, goodbye 

Encode 8bit CHARs into uue 6bit NIBBLEs:
:&5L;&\L('=O<FQD"DAE;&QO+"!W;W)L9"$*1V]O9&)Y92P@8W)U96P@=V]R
;&0*22=M(&QE879I;F<@>6]U('1O9&%Y"D=O;V1B>64L(&=O;V1B>64L(&=O
;V1B>64@"

Convert 7bit ASCII CHARS to a 1bit stream: 
STRING & ABACUS => 101001110101001010010100100110011101000111010000001001100100000100000110000101000001100001110101011010011

C

Note: errors handling in this code is experimental!

File: bitio.h

<lang c>#ifndef BIT_IO_H

  1. define BIT_IO_H
  1. include <stdio.h>
  1. define BITS_PER_BYTE 8

void bits_flush(FILE *o); int bits_write(unsigned int d, int n, FILE *o); int bits_read(unsigned int *d, int n, FILE *o); int bits_getlast(unsigned int *d);

  1. define BITERR_BITUNDERFLOW 1
  2. define BITERR_BITOVERFLOW 2
  3. define BITERR_NOERR 0

extern int biterr;

  1. endif</lang>

File: bitio.c

<lang c>#include "bitio.h"

int biterr;

static unsigned char bitbuf=0; static unsigned int cumulus=0; const static unsigned int sochar = sizeof(unsigned char)*BITS_PER_BYTE; const static unsigned int soint = sizeof(unsigned int)*BITS_PER_BYTE;

static unsigned char rbitbuf=0; static unsigned char rfree = 0;

static int read_bit(unsigned int *d, FILE *o) {

  int c;
  
  if ( rfree == 0 )
  {
     c = getc(o);
     if ( c == EOF )
     {
        biterr = BITERR_BITUNDERFLOW;
        return EOF;
     }
     rfree = sochar;
     rbitbuf = c;
  }
  
  *d <<= 1;
  *d |= ( rbitbuf >> (sochar - 1 ) ) & 1;
  rbitbuf <<= 1;
  rfree--;
  return 1;

}

static int appendbit(unsigned int d, FILE *o) {

  if ( cumulus == sochar )
  {
     putc(bitbuf, o);
     cumulus = 0; bitbuf = 0;
  }
  bitbuf <<= 1;
  d &= 1 << (soint - 1);
  d >>= (soint - 1);
  bitbuf |= (d&1);
  cumulus++;
  return 1;

}

void bits_flush(FILE *o) {

  bitbuf <<= (sochar - cumulus);
  putc(bitbuf, c);
  fflush(o);
  cumulus = 0; bitbuf = 0;

}

int bits_read(unsigned int *d, int n, FILE *o) {

  int rbit = 0;
  int rv;
  
  biterr = BITERR_NOERR;
  if ( n > soint ) { biterr = BITERR_BITOVERFLOW; return EOF; }
  while ( n-- > 0 )
  {
     rv = read_bit(d, o);
     if ( rv == EOF ) return EOF; /* return rv; ? */
     rbit += rv;
  }
  return rbit;

}

int bits_getlast(unsigned int *d) {

 int t = sochar - rfree;
 *d <<= t;
 *d |= rbitbuf >> rfree;
 rbitbuf = 0;
 rfree = 0;
 return t;

}

int bits_write(unsigned int d, int n, FILE *o) {

  unsigned int dpad;
  int wbit=0;
  
  if ( n > soint ) return -1;
  dpad = d << (soint - n);
  while( n-- > 0)
  {
     wbit += appendbit(dpad, o);
     dpad <<= 1;
  }
  return wbit;

}</lang>

Usage example

"Compression" of the ASCII byte standard input stream to the standard output:

<lang c>#include <stdio.h>

  1. include <stdlib.h>
  2. include "bitio.h"

int main() {

  int rbyte;
  while( (rbyte=getchar()) != EOF )
  {
     bits_write(rbyte, 7, stdout);
  }
  bits_flush(stdout);
  return 0;

}</lang>

"Decompression" of a 7-bit encoded ASCII stream to a "regular" ASCII byte stream:

<lang c>#include <stdio.h>

  1. include <stdlib.h>
  2. include "bitio.h"

int main() {

  unsigned int r=0;
  while( bits_read(&r, 7, stdin) != EOF )
  {
     putchar(r&0x7f);
  }
  return 0;

}</lang>

In some circumstances, the previous code could give an extra spurious byte; it happens when the original uncompressed input stream length (in byte) is 7 (mod 8); in this case, the last byte of the compressed stream contains only one "real" bit, the other 7 bits are just for padding. But the decompressor has no way to know this, and so it outputs the last 7 bits as they were "real", "expanding" them into a (spurious) byte.

C#

<lang csharp>using System; using System.IO;

public class BitReader {

   uint readData = 0;
   int startPosition = 0;
   int endPosition = 0;
   public int InBuffer
   {
       get { return endPosition - startPosition; }
   }
   private Stream stream;
   public Stream BaseStream
   {
       get { return stream; }
   }
   public BitReader(Stream stream)
   {
       this.stream = stream;
   }
   void EnsureData(int bitCount)
   {
       int readBits = bitCount - InBuffer;
       while (readBits > 0)
       {
           int b = BaseStream.ReadByte();
           if (b < 0) throw new InvalidOperationException("Unexpected end of stream");
           readData |= checked((uint)b << endPosition);
           endPosition += 8;
           readBits -= 8;
       }
   }
   public bool ReadBit()
   {
       return Read(1) > 0;
   }
   public int Read(int bitCount)
   {
       EnsureData(bitCount);
       int result = (int)(readData >> startPosition) & ((1 << bitCount) - 1);
       startPosition += bitCount;
       if (endPosition == startPosition)
       {
           endPosition = startPosition = 0;
           readData = 0;
       }
       else if (startPosition >= 8)
       {
           readData >>= startPosition;
           endPosition -= startPosition;
           startPosition = 0;
       }
       return result;
   }
   public void Align()
   {
       endPosition = startPosition = 0;
       readData = 0;
   }

}

public class BitWriter {

   uint data = 0;
   int dataLength = 0;
   Stream stream;
   public Stream BaseStream
   {
       get { return stream; }
   }
   public int BitsToAligment
   {
       get { return (32 - dataLength) % 8; }
   }
   public BitWriter(Stream stream)
   {
       this.stream = stream;
   }
   public void WriteBit(bool value)
   {
       Write(value ? 1 : 0, 1);
   }
   public void Write(int value, int length)
   {
       uint currentData = data | checked((uint)value << dataLength);
       int currentLength = dataLength + length;
       while (currentLength >= 8)
       {
           BaseStream.WriteByte((byte)currentData);
           currentData >>= 8;
           currentLength -= 8;
       }
       data = currentData;
       dataLength = currentLength;
   }
   public void Align()
   {
       if (dataLength > 0)
       {
           BaseStream.WriteByte((byte)data);
           data = 0;
           dataLength = 0;
       }
   }

}

class Program {

   static void Main(string[] args)
   {
       MemoryStream ms = new MemoryStream();
       BitWriter writer = new BitWriter(ms);
       writer.WriteBit(true);
       writer.Write(5, 3);
       writer.Write(0x0155, 11);
       writer.Align();
       ms.Position = 0;
       BitReader reader = new BitReader(ms);
       Console.WriteLine(reader.ReadBit());
       Console.WriteLine(reader.Read(3));
       Console.WriteLine(reader.Read(11).ToString("x4"));
       reader.Align();
   }

}</lang>

Forth

The stream status is kept on the stack ( b m ), where b is the character accumulator and m is a mask for the current bit. The accumulator is filled with bits starting with the MSB. (The writing code was originally used for Mandelbrot generation.)

<lang forth>\ writing

init-write ( -- b m ) 0 128 ;
flush-bits ( b m -- 0 128 ) drop emit init-write ;
?flush-bits ( b m -- b' m' ) dup 128 < if flush-bits then ;
write-bit ( b m f -- b' m' )
 if tuck or swap then
 2/ dup 0= if flush-bits then ;

\ reading

init-read ( -- b m ) key 128 ;
eof? ( b m -- b m f ) dup if false else key? 0= then ;
read-bit ( b m -- b' m' f )
 dup 0= if 2drop init-read then
 2dup and swap 2/ swap ;</lang>

Haskell

<lang haskell>import Data.List import Data.Char import Control.Monad import Control.Arrow import System.Environment

int2bin :: Int -> [Int] int2bin = unfoldr(\x -> if x==0 then Nothing

                         else Just (uncurry(flip(,)) (divMod x 2)))

bin2int :: [Int] -> Int bin2int = foldr ((.(2 *)).(+)) 0

bitReader = map (chr.bin2int). takeWhile(not.null). unfoldr(Just. splitAt 7)

 . (take =<< (7 *) . (`div` 7) . length)

bitWriter xs = tt ++ z00 where

 tt = concatMap (take 7.(++repeat 0).int2bin.ord) xs
 z00 = replicate (length xs `mod` 8) 0

main = do

 (xs:_) <- getArgs
 let bits = bitWriter xs
 putStrLn "Text to compress:"
 putStrLn $ '\t' : xs
 putStrLn $ "Uncompressed text length is " ++ show (length xs)
 putStrLn $ "Compressed text has " ++ show (length bits `div` 8) ++ " bytes."
 putStrLn "Read and decompress:"
 putStrLn $ '\t' : bitReader bits</lang>
  • 7-bits code has lsb leading.
*Main> :main ["This text is used to illustrate the Rosetta Code task 'bit oriented IO'."]
Text to compress:
        This text is used to illustrate the Rosetta Code task 'bit oriented IO'.
Uncompressed text length is 72
Compressed text has 63 bytes.
Read and decompress:
        This text is used to illustrate the Rosetta Code task 'bit oriented IO'.

J

Solution <lang j>bitReader =: a. {~ _7 #.\ ({.~ <.&.(%&7)@#) bitWriter =: , @ ((7$2) & #: @ (a.&i.)), 0 $~ 8 | #</lang>

Usage

Do and undo bit oriented IO: <lang j>text=: 'This text is used to illustrate the Rosetta Code task about bit oriented IO.'

  bitReader bitWriter text

This text is used to illustrate the Rosetta Code task about 'bit oriented IO'.</lang> Original text length: <lang j> # text 78</lang> Compressed length: <lang j>  %&8 # bitWriter text 69</lang>

Note: this implementation writes the bytes to the session. Other targets would need different code.

OCaml

The extLib provides bit oriented IO functions.

<lang ocaml>let write_7bit_string ~filename ~str =

 let oc = open_out filename in
 let ob = IO.output_bits(IO.output_channel oc) in
 String.iter (fun c -> IO.write_bits ob 7 (int_of_char c)) str;
 IO.flush_bits ob;
 close_out oc;
</lang>

<lang ocaml>let read_7bit_string ~filename =

 let ic = open_in filename in
 let ib = IO.input_bits(IO.input_channel ic) in
 let buf = Buffer.create 2048 in
 try while true do
   let c = IO.read_bits ib 7 in
   Buffer.add_char buf (char_of_int c);
 done; ""
 with IO.No_more_input ->
   (Buffer.contents buf)</lang>

MIPS Assembly

See Bitwise IO/MIPS Assembly

Perl

<lang perl>#! /usr/bin/perl

use strict;

  1. $buffer = write_bits(*STDOUT, $buffer, $number, $bits)

sub write_bits( $$$$ ) {

   my ($out, $l, $num, $q) = @_;
   $l .= substr(unpack("B*", pack("N", $num)),

-$q);

   if ( (length($l) > 8) ) {

my $left = substr($l, 8); print $out pack("B8", $l); $l = $left;

   }
   return $l;

}

  1. flush_bits(*STDOUT, $buffer)

sub flush_bits( $$ ) {

   my ($out, $b) = @_;
   print $out pack("B*", $b);

}

  1. ($val, $buf) = read_bits(*STDIN, $buf, $n)

sub read_bits( $$$ ) {

   my ( $in, $b, $n ) = @_;
   # we put a limit in the number of bits we can read
   # with one shot; this should mirror the limit of the max
   # integer value perl can hold
   if ( $n > 32 ) { return 0; }
   while ( length($b) < $n ) {

my $v; my $red = read($in, $v, 1); if ( $red < 1 ) { return ( 0, -1 ); } $b .= substr(unpack("B*", $v), -8);

   }
   my $bits = "0" x ( 32-$n ) . substr($b, 0, $n);
   my $val = unpack("N", pack("B32", $bits));
   $b = substr($b, $n);
   return ($val, $b);

}</lang>

Crunching bytes discarding most significant bit (lossless compression for ASCII and few more!)

<lang perl>my $buf = ""; my $c; while( read(*STDIN, $c, 1) > 0 ) {

   $buf = write_bits(*STDOUT, $buf, unpack("C1", $c), 7);

} flush_bits(*STDOUT, $buf);</lang>

Expanding each seven bits to fit a byte (padding the eight most significant bit with 0):

<lang perl>my $buf = ""; my $v; while(1) {

   ( $v, $buf ) = read_bits(*STDIN, $buf, 7);
   last if ($buf < 0); 
   print pack("C1", $v);

}</lang>

PL/I

<lang PL/I> declare onebit bit(1) aligned, bs bit (1000) varying aligned; on endfile (sysin) go to ending; bs = b; do forever;

  get edit (onebit) (F(1));
  bs = bs || onebit;

end; ending: bs = bs || copy('0'b, mod(length(bs), 8) );

                                /* pad length to a multiple of 8 */

put edit (bs) (b); </lang>

Python

The module file bitio.py

<lang python>class BitWriter:

   def __init__(self, f):
       self.accumulator = 0
       self.bcount = 0
       self.out = f
   def __del__(self):
       self.flush()
   def writebit(self, bit):
       if self.bcount == 8 :
           self.flush()
       if bit > 0:
           self.accumulator |= (1 << (7-self.bcount))
       self.bcount += 1
   def writebits(self, bits, n):
       while n > 0:
           self.writebit( bits & (1 << (n-1)) )
           n -= 1
   def flush(self):
       self.out.write(chr(self.accumulator))
       self.accumulator = 0
       self.bcount = 0


class BitReader:

   def __init__(self, f):
       self.input = f
       self.accumulator = 0
       self.bcount = 0
       self.read = 0
   def readbit(self):
       if self.bcount == 0 :
           a = self.input.read(1)
           if ( len(a) > 0 ):
               self.accumulator = ord(a)
           self.bcount = 8
           self.read = len(a)
       rv = ( self.accumulator & ( 1 << (self.bcount-1) ) ) >> (self.bcount-1)
       self.bcount -= 1
       return rv
   def readbits(self, n):
       v = 0
       while n > 0:
           v = (v << 1) | self.readbit()
           n -= 1
       return v</lang>

Usage example to "crunch" an 8-bit byte ASCII stream discarding the most significative "unused" bit...

<lang python>#! /usr/bin/env python import sys import bitio

o = bitio.BitWriter(sys.stdout) c = sys.stdin.read(1) while len(c) > 0:

   o.writebits(ord(c), 7)
   c = sys.stdin.read(1)</lang>

... and to "decrunch" the same stream:

<lang python>#! /usr/bin/env python import sys import bitio

r = bitio.BitReader(sys.stdin) while True:

   x = r.readbits(7)
   if ( r.read == 0 ):
       break
   sys.stdout.write(chr(x))</lang>

Ruby

Translation of: Tcl

<lang ruby>def crunch(ascii)

 bitstring = ascii.bytes.inject("") {|s, b| s << "%07d" % b.to_s(2)}
 [bitstring].pack("B*")

end

def expand(binary)

 bitstring = binary.unpack("B*")[0]
 bitstring.scan(/[01]{7}/).inject("") {|s, b| s << Integer("0b#{b}").chr}

end

original = "This is an ascii string that will be crunched, written, read and expanded." puts "my ascii string is #{original.length} bytes"

filename = "crunched.out"

  1. write the compressed data

File.open(filename, "w") do |fh|

 fh.binmode
 fh.print crunch(original)

end

filesize = File.size(filename) puts "the file containing the crunched text is #{filesize} bytes"

  1. read and expand

expanded = File.open(filename, "r") do |fh|

 fh.binmode
 expand(fh.read)

end

if original == expanded

 puts "success"

else

 puts "fail!"

end</lang>

Tcl

<lang tcl>package require Tcl 8.5

proc crunch {ascii} {

   binary scan $ascii B* bitstring
   # crunch: remove the extraneous leading 0 bit
   regsub -all {0(.{7})} $bitstring {\1} 7bitstring
   set padded "$7bitstring[string repeat 0 [expr {8 - [string length $7bitstring]%8}]]"
   return [binary format B* $padded]

}

proc expand {binary} {

   binary scan $binary B* padded
   # expand the 7 bit segments with their leading 0 bit
   set bitstring "0[join [regexp -inline -all {.{7}} $padded] 0]"
   return [binary format B* $bitstring]

}

proc crunch_and_write {ascii filename} {

   set fh [open $filename w]
   fconfigure $fh -translation binary
   puts -nonewline $fh [crunch $ascii]
   close $fh

}

proc read_and_expand {filename} {

   set fh [open $filename r]
   fconfigure $fh -translation binary
   set input [read $fh [file size $filename]]
   close $fh
   return [expand $input]

}

set original "This is an ascii string that will be crunched, written, read and expanded." puts "my ascii string is [string length $original] bytes"

set filename crunched.out crunch_and_write $original $filename

set filesize [file size $filename] puts "the file containing the crunched text is $filesize bytes"

set expanded [read_and_expand $filename]

if {$original eq $expanded} {

   puts "the expanded string is the same as the original"

} else {

   error "not the same"

}</lang> outputs

my ascii string is 74 bytes
the file containing the crunched text is 65 bytes
the expanded string is the same as the original