B

Task/Bitwise-IO/0DESCRIPTION

@@ -0,0 +1,22 @@
+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 <tt>asciiprint "STRING"</tt> 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 0'''000''' (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 or variable ''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

Task/Bitwise-IO/ALGOL-68/bitwise-io.alg

@@ -0,0 +1,131 @@
+# 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;
+
+# 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)
+);
+
+# 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);
+# FOR NIBBLE nibble IN # gen nibble( # ) DO #
+##   (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
+# OD # ))
+);
+
+# 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;
+
+# 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 #
+
+# 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));
+
+# FOR NIBBLE nibble IN # gen resize nibble(8, gen join hello world, # ) DO ( #
+##   (NIBBLE nibble)VOID:(
+    print(REPR ABS bits OF nibble)
+# 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;
+# FOR NIBBLE nibble IN # gen resize nibble(6, gen join hello world, # ) DO ( #
+##   (NIBBLE nibble)VOID:(
+    print(encode uue 6bit[ABS bits OF nibble]);
+    count+:=1;
+    IF count MOD 60 = 0 THEN print(newline) FI
+# 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);
+
+# FOR NIBBLE nibble IN # gen resize nibble(1, gen example 7bit string, # ) DO ( #
+##   (NIBBLE nibble)VOID: (
+    print(whole(ABS bits OF nibble,0))
+# OD # ));
+  print(new line)
+);
+
+example uudecode nibble stream;
+example uuencode nibble stream;
+example compress 7bit chars

Task/Bitwise-IO/Ada/bitwise-io-1.ada

@@ -0,0 +1,20 @@
+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;

Task/Bitwise-IO/Ada/bitwise-io-2.ada

@@ -0,0 +1,33 @@
+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;

Task/Bitwise-IO/Ada/bitwise-io-3.ada

@@ -0,0 +1,33 @@
+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;

Task/Bitwise-IO/BBC-BASIC/bitwise-io.bbc

@@ -0,0 +1,43 @@
+      file$ = @tmp$ + "bitwise.tmp"
+      test$ = "Hello, world!"
+
+      REM Write to file, 7 bits per character:
+      file% = OPENOUT(file$)
+      FOR i% = 1 TO LEN(test$)
+        PROCwritebits(file%, ASCMID$(test$,i%), 7)
+      NEXT
+      PROCwritebits(file%, 0, 0)
+      CLOSE #file%
+
+      REM Read from file, 7 bits per character:
+      file% = OPENIN(file$)
+      REPEAT
+        ch% = FNreadbits(file%, 7)
+        VDU ch%
+      UNTIL ch% = 0
+      PRINT
+      CLOSE #file%
+      END
+
+      REM Write n% bits from b% to file f% (n% = 0 to flush):
+      DEF PROCwritebits(f%, b%, n%)
+      PRIVATE a%, c%
+      IF n% = 0 BPUT #f%,a% : a% = 0 : c% = 0
+      WHILE n%
+        IF c% = 8 BPUT #f%,a% : a% = 0 : c% = 0
+        n% -= 1
+        c% += 1
+        IF b% AND 1 << n% THEN a% OR= 1 << (8 - c%)
+      ENDWHILE
+      ENDPROC
+
+      REM Read n% bits from file f%:
+      DEF FNreadbits(f%, n%)
+      PRIVATE a%, c% : LOCAL v%
+      WHILE n%
+        IF c% = 0 a% = BGET#f% : c% = 8
+        n% -= 1
+        c% -= 1
+        v% = v% << 1 OR (a% >> c%) AND 1
+      ENDWHILE
+      = v%

Task/Bitwise-IO/C/bitwise-io.c

@@ -0,0 +1,114 @@
+#include <stdio.h>
+#include <stdlib.h>
+#include <stdint.h>
+#include <string.h>
+
+typedef uint8_t byte;
+typedef struct {
+	FILE *fp;
+	uint32_t accu;
+	int bits;
+} bit_io_t, *bit_filter;
+
+bit_filter b_attach(FILE *f)
+{
+	bit_filter b = malloc(sizeof(bit_io_t));
+	b->bits = b->accu = 0;
+	b->fp = f;
+	return b;
+}
+
+void b_write(byte *buf, size_t n_bits, size_t shift, bit_filter bf)
+{
+	uint32_t accu = bf->accu;
+	int bits = bf->bits;
+
+	buf += shift / 8;
+	shift %= 8;
+
+	while (n_bits || bits >= 8) {
+		while (bits >= 8) {
+			bits -= 8;
+			fputc(accu >> bits, bf->fp);
+			accu &= (1 << bits) - 1;
+		}
+		while (bits < 8 && n_bits) {
+			accu = (accu << 1) | (((128 >> shift) & *buf) >> (7 - shift));
+			--n_bits;
+			bits++;
+			if (++shift == 8) {
+				shift = 0;
+				buf++;
+			}
+		}
+	}
+	bf->accu = accu;
+	bf->bits = bits;
+}
+
+size_t b_read(byte *buf, size_t n_bits, size_t shift, bit_filter bf)
+{
+	uint32_t accu = bf->accu;
+	int bits = bf->bits;
+	int mask, i = 0;
+
+	buf += shift / 8;
+	shift %= 8;
+
+	while (n_bits) {
+		while (bits && n_bits) {
+			mask = 128 >> shift;
+			if (accu & (1 << (bits - 1))) *buf |= mask;
+			else *buf &= ~mask;
+
+			n_bits--;
+			bits--;
+
+			if (++shift >= 8) {
+				shift = 0;
+				buf++;
+			}
+		}
+		if (!n_bits) break;
+		accu = (accu << 8) | fgetc(bf->fp);
+		bits += 8;
+	}
+	bf->accu = accu;
+	bf->bits = bits;
+
+	return i;
+}
+
+void b_detach(bit_filter bf)
+{
+	if (bf->bits) {
+		bf->accu <<= 8 - bf->bits;
+		fputc(bf->accu, bf->fp);
+	}
+	free(bf);
+}
+
+int main()
+{
+	unsigned char s[] = "abcdefghijk";
+	unsigned char s2[11] = {0};
+	int i;
+
+	FILE *f = fopen("test.bin", "wb");
+	bit_filter b = b_attach(f);
+	/* for each byte in s, write 7 bits skipping 1 */
+	for (i = 0; i < 10; i++) b_write(s + i, 7, 1, b);
+	b_detach(b);
+	fclose(f);
+
+	/* read 7 bits and expand to each byte of s2 skipping 1 bit */
+	f = fopen("test.bin", "rb");
+	b = b_attach(f);
+	for (i = 0; i < 10; i++) b_read(s2 + i, 7, 1, b);
+	b_detach(b);
+	fclose(f);
+
+	printf("%10s\n", s2); /* should be the same first 10 bytes as in s */
+
+	return 0;
+}

Task/Bitwise-IO/Forth/bitwise-io.fth

@@ -0,0 +1,21 @@
+\ 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 ;

Task/Bitwise-IO/Haskell/bitwise-io.hs

@@ -0,0 +1,30 @@
+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

Task/Bitwise-IO/Perl/bitwise-io-1.pl

@@ -0,0 +1,44 @@
+#! /usr/bin/perl
+
+use strict;
+
+# $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;
+}
+
+# flush_bits(*STDOUT, $buffer)
+sub flush_bits( $$ )
+{
+    my ($out, $b) = @_;
+    print $out pack("B*", $b);
+}
+
+# ($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);
+}

Task/Bitwise-IO/Perl/bitwise-io-2.pl

@@ -0,0 +1,6 @@
+my $buf = "";
+my $c;
+while( read(*STDIN, $c, 1) > 0 ) {
+    $buf = write_bits(*STDOUT, $buf, unpack("C1", $c), 7);
+}
+flush_bits(*STDOUT, $buf);

Task/Bitwise-IO/Perl/bitwise-io-3.pl

@@ -0,0 +1,7 @@
+my $buf = "";
+my $v;
+while(1) {
+    ( $v, $buf ) = read_bits(*STDIN, $buf, 7);
+    last if ($buf < 0);
+    print pack("C1", $v);
+}

Task/Bitwise-IO/PicoLisp/bitwise-io-1.l

@@ -0,0 +1,22 @@
+(de write7bitwise (Lst)
+   (let (Bits 0  Byte)
+      (for N Lst
+         (if (=0 Bits)
+            (setq Bits 7  Byte (* 2 N))
+            (wr (| Byte (>> (dec 'Bits) N)))
+            (setq Byte (>> (- Bits 8) N)) ) )
+      (unless (=0 Bits)
+         (wr Byte) ) ) )
+
+(de read7bitwise ()
+   (make
+      (let (Bits 0  Byte)
+         (while (rd 1)
+            (let N @
+               (link
+                  (if (=0 Bits)
+                     (>> (one Bits) N)
+                     (| Byte (>> (inc 'Bits) N)) ) )
+               (setq Byte (& 127 (>> (- Bits 7) N))) ) )
+         (when (= 7 Bits)
+            (link Byte) ) ) ) )

Task/Bitwise-IO/PicoLisp/bitwise-io-2.l

@@ -0,0 +1,11 @@
+(out 'a (write7bitwise (127 0 127 0 127 0 127 0 127)))
+(hd 'a)
+(in 'a (println (read7bitwise)))
+
+(out 'a (write7bitwise (0 127 0 127 0 127 0 127 0)))
+(hd 'a)
+(in 'a (println (read7bitwise)))
+
+(out 'a (write7bitwise (mapcar char (chop "STRING"))))
+(hd 'a)
+(println (mapcar char (in 'a (read7bitwise))))

Task/Bitwise-IO/Python/bitwise-io-1.py

@@ -0,0 +1,51 @@
+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

Task/Bitwise-IO/Python/bitwise-io-2.py

@@ -0,0 +1,9 @@
+#! /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)

Task/Bitwise-IO/Python/bitwise-io-3.py

@@ -0,0 +1,10 @@
+#! /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))

Task/Bitwise-IO/REXX/bitwise-io.rexx

@@ -0,0 +1,26 @@
+/* REXX ****************************************************************
+* 01.11.2012 Walter Pachl
+***********************************************************************/
+s='STRING'                             /* Test input                  */
+Say 's='s
+ol=''                                  /* initialize target           */
+Do While s<>''                         /* loop through input          */
+  Parse Var s c +1 s                   /* pick a character            */
+  cx=c2x(c)                            /* convert to hex              */
+  cb=x2b(cx)                           /* convert to bits             */
+  ol=ol||substr(cb,2)                  /* append to target            */
+  End
+l=length(ol)                           /* current length              */
+lm=l//8
+ol=ol||copies('0',8-lm)                /* pad to multiple of 8        */
+pd=copies(' ',l)||copies('0',8-lm)
+Say 'b='ol                             /* show target                 */
+Say '  'pd 'padding'
+r=''                                   /* initialize result           */
+Do While length(ol)>6                  /* loop through target         */
+  Parse Var ol b +7 ol                 /* pick 7 bits                 */
+  b='0'||b                             /* add a leading '0'           */
+  x=b2x(b)                             /* convert to hex              */
+  r=r||x2c(x)                          /* convert to character        */
+  End                                  /* and append to result        */
+Say 'r='r                              /* show result                 */

Task/Bitwise-IO/Ruby/bitwise-io.rb

@@ -0,0 +1,35 @@
+def crunch(ascii)
+  bitstring = ascii.bytes.collect {|b| "%07b" % b}.join
+  [bitstring].pack("B*")
+end
+
+def expand(binary)
+  bitstring = binary.unpack("B*")[0]
+  bitstring.scan(/[01]{7}/).collect {|b| b.to_i(2).chr}.join
+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"
+
+# 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"
+
+# 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

Task/Bitwise-IO/Tcl/bitwise-io.tcl

@@ -0,0 +1,48 @@
+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"
+}