Rebol [
	Title: "Peek-Poke"
	File: %peekpoke.r
	Author: "Ladislav Mecir"
	Date: 10-Aug-2009/14:08:16+2:00
	Purpose: {structure manipulations}
]

comment {
Hi all,

for the ones who want to "play with fire", 
I wrote the functions described below. 
Usage:

	; little endian form of a 64-bit IEEE 754 FP number
	; (for Intel processors e.g.)
	convert 0.2 ; == #{9A9999999999C93F}
	; If you prefer a big endian form,
	; which is more (human) readable, use:
	head reverse convert 0.2 ; == #{3FC999999999999A}
	; the endianness of the processor can be found as follows:
	endian?: pick [little big] 1 = first convert 1
	; another way:
	endian?: get-modes system/ports/system 'endian
	reverse-convert #{9A9999999999C93F} 'decimal! ; == 0.2
	; conversion to 32-bit IEEE 754 FP format
	convert/to 0.2 'float ; == #{CDCC4C3E}

	; memory manipulations
	a: "1234" ; == "1234"
	adr: string-address? a
	as-string get-memory adr 1 ; == "1"
	as-string get-memory adr + 1 1 ; == "2"
	as-string get-memory adr + 2 1 ; == "3"
	as-string get-memory adr + 3 1 ; == "4"
	as-string get-memory adr + 4 1 ; == #"^@"
	set-memory adr + 1 "a"
	a ; == "1a34"
}

use [
	int-struct
	string-struct
	struct-struct
] [
	int-struct: make struct! [int [int]] none
	string-struct: make struct! [string [char*]] none
	struct-struct: make struct! [struct [struct! [[save] c [char]]]] none

	string-address?: func [
		{get the address of the given string}
		string [any-string!]
	] [
		string-struct/string: string
		change third int-struct third string-struct
		int-struct/int
	]
	
	struct-address?: func [
		{get the address of the given struct}
		struct [struct!]
	] [
		string-address? third struct
	]
	
	get-memory: func [
		{copy a region of memory given at address with the given size}
		address [integer!]
		size [integer!]
		/local struct
	] [
		int-struct/int: address
		struct: make struct! compose/deep [string [char-array (size)]] none
		change third struct third int-struct
		as-binary struct/string
	]
	
	set-memory: func [
		{set a region of memory at address}
		address [integer!]
		contents [binary! string!]
	] [
		int-struct/int: address
		foreach char as-string contents [
			change third struct-struct third int-struct
			struct-struct/struct/c: char
			int-struct/int: int-struct/int + 1
		]
	]
	
	convert: func [
		{
			convert the given x to binary
			- for the list of supported types see http://www.rebol.com/docs/library.html
		}
		x
		/to type [word!]
		/local y
	] [
		any [to type: type?/word x]
		y: make struct! compose/deep [x [(type)]] reduce [x]
		third y
	]
	
	reverse-convert: func [
		{
			convert the given binary x to the given type
			- for the list of supported types see http://www.rebol.com/docs/library.html
		}
		x [binary!]
		type [word!]
		/local y
	] [
		y: make struct! compose/deep [x [(type)]] none
		change third y x
		y/x
	]
	
	; !this function does not work in 2.7.6 and later!
	ilt: func [
		{
			compare any type VALUE with integer NUM using the REPEAT function
			- NUM has to be >= 1
			- TRUE means VALUE "is lesser" than NUM, FALSE means the opposite
		}
		value [any-type!]
		num [integer!]
		/local stop
	] [
		stop: false
		repeat i num [
			either stop [return true] [
				stop: true
				error? set/any 'i get/any 'value
			]
		]
		false
	]
	
	; !this function does not work in 2.7.6 and later!
	as-int: func [
		{find out which nonnegative integer corresponds to the given value}
		value [any-type!]
		/local a b c
	] [
		a: 0
		b: to integer! #7fffffff
		while [a < b] [
			c: to integer! 1.0 + a + b / 2
			either ilt get/any 'value c [b: c - 1] [a: c]
		]
	]
	
	; !this function does not work in 2.7.6 and later!
	block-address?: func [
		{get the address of the given block}
		block [any-block!]
	] [
		reverse-convert get-memory 8 + as-int block 4 'integer!
	]
	
	; !this function does not work in 2.7.6 and later!
	representation?: func [
		{get the binary representation of the given value}
		value [any-type!]
		/local blk
	] [
		blk: make block! 0
		insert/only blk get/any 'value
		get-memory block-address? blk 16
	]
	
	; !this function does not work in 2.7.6 and later!
	unbind: func [
		{return the unbound version of the given word}
		word [any-word!]
		/local blk addr
	] [
		blk: reduce [:word]
		addr: block-address? blk
		set-memory addr + 1 #{01}
		set-memory addr + 8 #{0000000000000000}
		first blk
	]
]