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

132 lines
4.3 KiB
Plaintext

# 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