REBOL [
	Title:  "Binary strings and bit rotations"
	Author: "Gregg Irwin"
	Type:	'non-graphic
	Purpose:	{
		Shows how you could implement bit-rotation routines and 
		how to convert between strings of binary digits and integers.
		Demonstrates simple bit testing and alteration, looping,
		branching, and series modification.
	}
]

	print "Binary Strings"
	bin-str-to-int: rebcode [
		{Converts a string of binary digits, zeros or ones, to a signed
		integer value. The first digit represents the sign bit.}
		s "string of binary digits; up to 32 chars"
		/local len res dig bit
	] [
		tail? s
		ift [return 0]		; bail if empty string
		length? len s
		gt.i  len 32
		ift [return none]	; bail if s more than 32 chars

		set  res 0			; this is our accumulator
		tail s				; we'll be walking the string backwards
		set  bit 1			; which bit are we going to flip for 1's

		until [
			back s
			pick dig s 1
			eq.i   dig 49		; 49 = #"1"
			braf not-a-one	; not a 1, skip bit flipping
			or   res bit		; it's a 1; flip the bit

		label not-a-one
			lsl bit 1		; shift our bit so we flip the next one  
							; on each pass.
			head? s			; done when we hit the head
		]

		return res
	]

	print 'bin-str-to-int
	foreach val [
		"1" "11" "10" 
		"111111111111111111111111111111111"
		"1111111111111111111111111111111"
		"11111111111111111111111111111111"
		"01111111111111111111111111111111"
		"10000000000000000000000000000000"
	] [print [val bin-str-to-int val]]


	
	int-to-bin-str: rebcode [
		{Converts a signed integer to a string of binary digits. 
		The sign bit represents the first digit.}
		val [integer!]
		/local res tmp bit
	] [
		copy res "00000000000000000000000000000000" -1

		tail res			; we'll be walking the string backwards
		set bit 1			; which bit are we going to flip for 1's

		until [
			back res
			set  tmp val
			and  tmp bit
			neq.i  tmp 0
			braf not-a-one	; not a 1, skip digit setting
			poke res 1 49	; 49 = #"1"

		label not-a-one
			lsl bit 1		; shift our bit so we flip the next one  
							; on each pass.
			head? res		; done when we hit the head
		]

		return res
	]

	print 'int-to-bin-str 
	foreach val [
		1 3 2147483647 -2147483648
		-1 15 255 65535 65536
	] [print [val int-to-bin-str val]]


	print "^/Bit Rotation"

	ror: rebcode [
		"Rotate an integer value a number of bits to the right."
		val [integer!] 
		bits [integer!] 
		/local v1 b
	][
		set v1  val
		lsr v1  bits
		set b   32 
		sub.i b   bits
		lsl val b
		or  val v1
		return  val
	]

	;test-ror: func [val bits] [
	;	print [int-to-bin-str val  int-to-bin-str ror val bits]
	;]	

	print 'ror
	test-ror: does [
		repeat i 32 [
			print int-to-bin-str ror 1 i
		]
	]	
	test-ror
	

	rol: rebcode [
		"Rotate an integer value a number of bits to the left."
		val [integer!] 
		bits [integer!] 
		/local v1 b
	][
		set v1  val
		lsl v1  bits
		set b   32 
		sub.i b   bits
		lsr val b
		or  val v1
		return  val
	]

	;test-rol: func [val bits] [
	;	print [int-to-bin-str val  int-to-bin-str rol val bits]
	;]	

	print 'rol
	test-rol: does [
		repeat i 32 [
			print int-to-bin-str rol 1 i
		]
	]
	test-rol