# 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('=O6]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