TESTS: added tests for `<integer!> op <byte! variable>` expressions

Red/System [
	Title:   "Red/System math mixed tests script"
	Author:  "Nenad Rakocevic"
	File: 	 %math-mixed-test.reds
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include %../../quick-test/quick-test.reds

~~~start-file~~~ "math-mixed"

===start-group=== "Math implicit type castings"

	--test-- "math-implicit-cast-1" --assert 10 - #"^C" = 7
	--test-- "math-implicit-cast-2" --assert -1 - #"^C" = -4
	--test-- "math-implicit-cast-3" --assert 10 + #"^C" = 13
	--test-- "math-implicit-cast-4" --assert -1 + #"^C" = 2
	--test-- "math-implicit-cast-5" --assert 10 * #"^C" = 30
	--test-- "math-implicit-cast-6" --assert -1 * #"^C" = -3
	--test-- "math-implicit-cast-7" --assert 10 / #"^C" = 3
	--test-- "math-implicit-cast-8" --assert -10 / #"^C" = -3
	--test-- "math-implicit-cast-9" --assert 1000 - #"^C" = 997

	byte: #"^C"
	--test-- "math-implicit-cast-10" --assert 10 - byte = 7
	--test-- "math-implicit-cast-11" --assert -1 - byte = -4
	--test-- "math-implicit-cast-12" --assert 10 + byte = 13
	--test-- "math-implicit-cast-13" --assert -1 + byte = 2
	--test-- "math-implicit-cast-14" --assert 10 * byte = 30
	--test-- "math-implicit-cast-15" --assert -1 * byte = -3
	--test-- "math-implicit-cast-16" --assert 10 / byte = 3
	--test-- "math-implicit-cast-17" --assert -10 / byte = -3
	--test-- "math-implicit-cast-18" --assert 1000 - byte = 997

	--test-- "math-implicit-cast-19" --assert 1000 or (as-integer byte) = 1003

===end-group===

===start-group=== "Simple nested expressions"

	ident: func [i [integer!] return: [integer!]][i]

	a: 1
	b: 2
	c: 3

	--test-- "math-nested-1"
	--assert 1 + (3 - 2) = 2

	--test-- "math-nested-2"
	--assert a + (3 - 2) = 2

	--test-- "math-nested-3"
	--assert a + (3 - b) = 2

	--test-- "math-nested-4"
	--assert a + (c - 2) = 2

	--test-- "math-nested-5"
	--assert a + (c - b) = b

	--test-- "math-nested-6"
	--assert (3 - 1) + (3 - 2) = 3

	--test-- "math-nested-7"
	--assert (c - a) + (c - b) = c

	--test-- "math-nested-8"
	--assert ((3 - 1) - (3 - 2)) - ((3 - 1) - (3 - 2)) = 0

	--test-- "math-nested-9"
	--assert ((c - a) - (c - b)) - ((c - a) - (c - b)) = 0

	--test-- "math-nested-10"
	--assert (3 * 1) + (3 * 2) = 9

	--test-- "math-nested-11"
	--assert (3 / 1) + (3 / 2) = 4

	--test-- "math-nested-12"
	--assert ((3 * 1) - (3 * 2)) * ((3 * 1) - (3 * 2)) = 9

	--test-- "math-nested-13"
	--assert (c * a) + (c * b) = 9

	--test-- "math-nested-14"
	--assert (3 * ident 1) + (3 * ident 2) = 9

	--test-- "math-nested-15"
	--assert ((ident 3) * ident 1) + ((ident 3) * ident 2) = 9

	foo-nested: func [
		/local a b c
	][
		a: 2
		b: 3
		c: 4

		--test-- "loc-math-nested-1"
		--assert 1 + (3 - 2) = 2

		--test-- "loc-math-nested-2"
		--assert a + (3 - 2) = 3

		--test-- "loc-math-nested-3"
		--assert a + (3 - b) = 2

		--test-- "loc-math-nested-4"
		--assert a + (c - 2) = 4

		--test-- "loc-math-nested-5"
		--assert a + (c - b) = b

		--test-- "loc-math-nested-6"
		--assert (3 - 1) + (3 - 2) = 3

		--test-- "loc-math-nested-7"
		--assert (c - a) + (c - b) = b

		--test-- "loc-math-nested-8"
		--assert ((3 - 1) - (3 - 2)) - ((3 - 1) - (3 - 2)) = 0

		--test-- "loc-math-nested-9"
		--assert ((c - a) - (c - b)) - ((c - a) - (c - b)) = 0
	]
	foo-nested

===end-group===

===start-group=== "Mixed nested expressions"

	fooA: func [a [int-ptr!] return: [int-ptr!]][a]
	fooB: func [b [integer!] return: [integer!]][b]

	s: declare struct! [
		a	[int-ptr!]
		b	[integer!]
		c	[int-ptr!]
	]
	s/b: 3
	size: 2

	--test-- "math-mixed-1"
	s/a: as int-ptr! 1000h
	s/a: s/a + 2								;-- reg/imm
	--assert s/a = as int-ptr! 1008h

	--test-- "math-mixed-2"
	s/a: as int-ptr! 1000h
	i: 2 + as-integer s/a						;-- imm/reg
	--assert i = 1002h

	--test-- "math-mixed-3"
	s/a: as int-ptr! 1000h
	s/a: (as int-ptr! 2) + as-integer s/a		;-- imm/reg
	--assert s/a = as int-ptr! 4002h

	--test-- "math-mixed-4"
	s/a: as int-ptr! s/b + size					;-- reg/ref
	--assert s/a = as int-ptr! 05h

	--test-- "math-mixed-5"
	i: size + s/b								;-- ref/reg
	--assert i = 05h

	--test-- "math-mixed-6"
	s/a: as int-ptr! size + s/b					;-- ref/reg
	--assert s/a = as int-ptr! 05h

	--test-- "math-mixed-7"
	i: s/b + size - 1							;-- (reg/ref)/imm
	--assert i = 04h

	--test-- "math-mixed-8"
	i: s/b - 1 + size							;-- (reg/imm)/ref
	--assert i = 04h

	--test-- "math-mixed-9"
	s/a: as int-ptr! 1000h
	s/a: s/a + size - 1							;-- (reg/ref)/imm
	--assert s/a = as int-ptr! 1004h

	--test-- "math-mixed-10"
	s/a: as int-ptr! 1000h
	s/a: s/a - 1 + size							;-- (reg/imm)/ref
	--assert s/a = as int-ptr! 1004h

	--test-- "math-mixed-11"
	s/a: as int-ptr! 1000h
	s/c: s/a + s/b + 2							;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-12"
	s/a: as int-ptr! 1000h
	s/c: s/a + s/b + size						;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-13"
	s/a: as int-ptr! 1000h
	s/c: s/a + s/b + s/b						;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 1018h

	--test-- "math-mixed-14"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) + 2							;-- reg/imm
	--assert s/a = as int-ptr! 1008h

	--test-- "math-mixed-15"
	s/a: as int-ptr! 1000h
	i: 2 + as-integer fooA s/a					;-- imm/reg
	--assert i = 1002h

	--test-- "math-mixed-16"
	s/a: as int-ptr! 1000h
	s/a: (as int-ptr! 2) + as-integer fooA s/a	;-- imm/reg
	--assert s/a = as int-ptr! 4002h

	--test-- "math-mixed-17"
	s/a: (as int-ptr! fooB s/b) + size			;-- reg/ref
	--assert s/a = as int-ptr! 0Bh

	--test-- "math-mixed-18"
	i: size + fooB s/b							;-- ref/reg
	--assert i = 05h

	--test-- "math-mixed-19"
	s/a: (as int-ptr! size) + fooB s/b			;-- ref/reg
	--assert s/a = as int-ptr! 0Eh

	--test-- "math-mixed-20"
	i: (fooB s/b) + size - 1					;-- (reg/ref)/imm
	--assert i = 04h

	--test-- "math-mixed-21"
	i: (fooB s/b) - 1 + size					;-- (reg/imm)/ref
	--assert i = 04h

	--test-- "math-mixed-22"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) + size - 1					;-- (reg/ref)/imm
	--assert s/a = as int-ptr! 1004h

	--test-- "math-mixed-23"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) - 1 + size					;-- (reg/imm)/ref
	--assert s/a = as int-ptr! 1004h

	--test-- "math-mixed-24"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + s/b + 2					;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-25"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + s/b + size				;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-26"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + (fooB s/b) + s/b			;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 1018h

	--test-- "math-mixed-27"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + (fooB s/b) + 2			;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-28"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + (fooB s/b) + size			;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-29"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + s/b + (fooB s/b) 			;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 1018h

	--test-- "math-mixed-30"
	s/a: as int-ptr! 1000h
	i: s/b + (fooA s/a) + (fooB s/b) 			;-- (reg/reg)/reg
	--assert i = 1006h

	--test-- "math-mixed-31"
	s/a: as int-ptr! 1000h
	i: 2 + (fooA s/a) + (fooB s/b) 				;-- (imm/reg)/reg
	--assert i = 1005h

	--test-- "math-mixed-32"
	s/a: as int-ptr! 1000h
	i: 2 + (fooA s/a) + size					;-- (imm/reg)/ref
	--assert i = 1004h

	--test-- "math-mixed-33"
	s/a: as int-ptr! 1000h
	i: 2 + (fooA s/a) + 3						;-- (imm/reg)/imm
	--assert i = 1005h

	--test-- "math-mixed-34"
	s/a: as int-ptr! 1000h
	s/a: s/a - 2								;-- reg/imm
	--assert s/a = as int-ptr! 0FF8h

	--test-- "math-mixed-35"
	s/a: as int-ptr! 1000h
	i: 2000h - as-integer s/a					;-- imm/reg
	--assert i = 1000h

	--test-- "math-mixed-36"
	s/a: as int-ptr! 1000h
	s/a: (as int-ptr! 6000h) - as-integer s/a	;-- imm/reg
	--assert s/a = as int-ptr! 2000h

	--test-- "math-mixed-37"
	s/a: as int-ptr! s/b - size					;-- reg/ref
	--assert s/a = as int-ptr! 01h

	--test-- "math-mixed-38"
	i: size - s/b								;-- ref/reg
	--assert i = -1

	--test-- "math-mixed-39"
	s/a: (as int-ptr! size) - s/b				;-- ref/reg
	--assert s/a = as int-ptr! -10

	--test-- "math-mixed-40"
	i: s/b - size - 1							;-- (reg/ref)/imm
	--assert i = 0

	--test-- "math-mixed-41"
	i: s/b - 1 - size							;-- (reg/imm)/ref
	--assert i = 0

	--test-- "math-mixed-42"
	s/a: as int-ptr! 1000h
	s/a: s/a - size - 1							;-- (reg/ref)/imm
	--assert s/a = as int-ptr! 0FF4h

	--test-- "math-mixed-43"
	s/a: as int-ptr! 1000h
	s/a: s/a - 1 - size							;-- (reg/imm)/ref
	--assert s/a = as int-ptr! 0FF4h

	--test-- "math-mixed-44"
	s/a: as int-ptr! 1000h
	s/c: s/a - s/b - 2							;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-45"
	s/a: as int-ptr! 1000h
	s/c: s/a - s/b - size						;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-46"
	s/a: as int-ptr! 1000h
	s/c: s/a - s/b - s/b						;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 0FE8h

	--test-- "math-mixed-47"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) - 2							;-- reg/imm
	--assert s/a = as int-ptr! 0FF8h

	--test-- "math-mixed-48"
	s/a: as int-ptr! 1000h
	i: 2 - as-integer fooA s/a					;-- imm/reg
	--assert i = FFFFF002h

	--test-- "math-mixed-49"
	s/a: as int-ptr! 1000h
	s/a: (as int-ptr! 2) - as-integer fooA s/a	;-- imm/reg
	--assert s/a = as int-ptr! FFFFC002h

	--test-- "math-mixed-50"
	s/a: (as int-ptr! fooB s/b) - size			;-- reg/ref
	--assert s/a = as int-ptr! -5

	--test-- "math-mixed-51"
	i: size - fooB s/b							;-- ref/reg
	--assert i = -1

	--test-- "math-mixed-52"
	s/a: (as int-ptr! size) - fooB s/b			;-- ref/reg
	--assert s/a = as int-ptr! -10

	--test-- "math-mixed-53"
	i: (fooB s/b) - size - 1					;-- (reg/ref)/imm
	--assert i = 0

	--test-- "math-mixed-54"
	i: (fooB s/b) - 1 - size					;-- (reg/imm)/ref
	--assert i = 0

	--test-- "math-mixed-55"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) - size - 1					;-- (reg/ref)/imm
	--assert s/a = as int-ptr! 0FF4h

	--test-- "math-mixed-56"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) - 1 - size					;-- (reg/imm)/ref
	--assert s/a = as int-ptr! 0FF4h

	--test-- "math-mixed-57"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - s/b - 2					;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-58"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - s/b - size				;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-59"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - (fooB s/b) - s/b			;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 0FE8h

	--test-- "math-mixed-60"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - (fooB s/b) - 2			;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-61"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - (fooB s/b) - size			;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-62"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - s/b - (fooB s/b) 			;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 0FE8h

	--test-- "math-mixed-63"
	s/a: as int-ptr! 1000h
	i: s/b - (fooA s/a) - (fooB s/b) 			;-- (reg/reg)/reg
	--assert i = FFFFF000h

	--test-- "math-mixed-64"
	s/a: as int-ptr! 1000h
	i: 2 - (fooA s/a) - (fooB s/b) 				;-- (imm/reg)/reg
	--assert i = FFFFEFFFh

	--test-- "math-mixed-65"
	s/a: as int-ptr! 1000h
	i: 2 - (fooA s/a) - size					;-- (imm/reg)/ref
	--assert i = FFFFF000h

	--test-- "math-mixed-66"
	s/a: as int-ptr! 1000h
	i: 2 - (fooA s/a) - 3						;-- (imm/reg)/imm
	--assert i = FFFFEFFFh

	--test-- "math-mixed-67"
	s/a: as int-ptr! 1000h
	s/c: as int-ptr! 1010h
	i: as-integer s/c - s/a						;-- reg/reg (pointer - pointer)
	--assert i = 10h

	--test-- "math-mixed-68"
	s/a: as int-ptr! 1000h
	s/c: as int-ptr! 1010h
	i: as-integer (s/c - s/a) + 1				;-- reg/reg (pointer - pointer)
	--assert i = 14h

	--test-- "math-mixed-69"
	s/a: as int-ptr! 00154E28h
	s/c: as int-ptr! 00150018h
	i: (as-integer (s/a - s/c) + 1)	/ 4			;-- reg/reg (pointer - pointer)
	--assert i = 4997

	--test-- "math-mixed-70"
	p: declare struct! [
		a	[byte-ptr!]
		c	[int-ptr!]
	]
	p/a: as byte-ptr! 001F0014h
	p/c: as int-ptr!  001D0004h
	i: as-integer (p/a - ((as byte-ptr! p/c) + 16))	;-- reg/(reg/imm)
	--assert i = 00020000h

	--test-- "math-mixed-71"
	p/a: as byte-ptr! 001F0014h
	p/c: as int-ptr!  001D0014h
	series: p/c
	sz: 32
	--assert ((as byte-ptr! series) + sz) < p/a		;-- (ref/ref)/reg

===end-group===

~~~end-file~~~

Red/System [
	Title:   "Red/System math mixed tests script"
	Author:  "Nenad Rakocevic"
	File: 	 %math-mixed-test.reds
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/origin/BSD-3-License.txt"
]

#include %../../quick-test/quick-test.reds

~~~start-file~~~ "math-mixed"

===start-group=== "Simple nested expressions"

	ident: func [i [integer!] return: [integer!]][i]

	a: 1
	b: 2
	c: 3

	--test-- "math-nested-1"
	--assert 1 + (3 - 2) = 2

	--test-- "math-nested-2"
	--assert a + (3 - 2) = 2

	--test-- "math-nested-3"
	--assert a + (3 - b) = 2

	--test-- "math-nested-4"
	--assert a + (c - 2) = 2

	--test-- "math-nested-5"
	--assert a + (c - b) = b

	--test-- "math-nested-6"
	--assert (3 - 1) + (3 - 2) = 3

	--test-- "math-nested-7"
	--assert (c - a) + (c - b) = c

	--test-- "math-nested-8"
	--assert ((3 - 1) - (3 - 2)) - ((3 - 1) - (3 - 2)) = 0

	--test-- "math-nested-9"
	--assert ((c - a) - (c - b)) - ((c - a) - (c - b)) = 0

	--test-- "math-nested-10"
	--assert (3 * 1) + (3 * 2) = 9

	--test-- "math-nested-11"
	--assert (3 / 1) + (3 / 2) = 4

	--test-- "math-nested-12"
	--assert ((3 * 1) - (3 * 2)) * ((3 * 1) - (3 * 2)) = 9

	--test-- "math-nested-13"
	--assert (c * a) + (c * b) = 9

	--test-- "math-nested-14"
	--assert (3 * ident 1) + (3 * ident 2) = 9

	--test-- "math-nested-15"
	--assert ((ident 3) * ident 1) + ((ident 3) * ident 2) = 9

	foo-nested: func [
		/local a b c
	][
		a: 2
		b: 3
		c: 4

		--test-- "loc-math-nested-1"
		--assert 1 + (3 - 2) = 2

		--test-- "loc-math-nested-2"
		--assert a + (3 - 2) = 3

		--test-- "loc-math-nested-3"
		--assert a + (3 - b) = 2

		--test-- "loc-math-nested-4"
		--assert a + (c - 2) = 4

		--test-- "loc-math-nested-5"
		--assert a + (c - b) = b

		--test-- "loc-math-nested-6"
		--assert (3 - 1) + (3 - 2) = 3

		--test-- "loc-math-nested-7"
		--assert (c - a) + (c - b) = b

		--test-- "loc-math-nested-8"
		--assert ((3 - 1) - (3 - 2)) - ((3 - 1) - (3 - 2)) = 0

		--test-- "loc-math-nested-9"
		--assert ((c - a) - (c - b)) - ((c - a) - (c - b)) = 0
	]
	foo-nested

===end-group===

===start-group=== "Mixed nested expressions"

	fooA: func [a [int-ptr!] return: [int-ptr!]][a]
	fooB: func [b [integer!] return: [integer!]][b]

	s: declare struct! [
		a	[int-ptr!]
		b	[integer!]
		c	[int-ptr!]
	]
	s/b: 3
	size: 2

	--test-- "math-mixed-1"
	s/a: as int-ptr! 1000h
	s/a: s/a + 2								;-- reg/imm
	--assert s/a = as int-ptr! 1008h

	--test-- "math-mixed-2"
	s/a: as int-ptr! 1000h
	i: 2 + as-integer s/a						;-- imm/reg
	--assert i = 1002h

	--test-- "math-mixed-3"
	s/a: as int-ptr! 1000h
	s/a: (as int-ptr! 2) + as-integer s/a		;-- imm/reg
	--assert s/a = as int-ptr! 4002h

	--test-- "math-mixed-4"
	s/a: as int-ptr! s/b + size					;-- reg/ref
	--assert s/a = as int-ptr! 05h

	--test-- "math-mixed-5"
	i: size + s/b								;-- ref/reg
	--assert i = 05h

	--test-- "math-mixed-6"
	s/a: as int-ptr! size + s/b					;-- ref/reg
	--assert s/a = as int-ptr! 05h

	--test-- "math-mixed-7"
	i: s/b + size - 1							;-- (reg/ref)/imm
	--assert i = 04h

	--test-- "math-mixed-8"
	i: s/b - 1 + size							;-- (reg/imm)/ref
	--assert i = 04h

	--test-- "math-mixed-9"
	s/a: as int-ptr! 1000h
	s/a: s/a + size - 1							;-- (reg/ref)/imm
	--assert s/a = as int-ptr! 1004h

	--test-- "math-mixed-10"
	s/a: as int-ptr! 1000h
	s/a: s/a - 1 + size							;-- (reg/imm)/ref
	--assert s/a = as int-ptr! 1004h

	--test-- "math-mixed-11"
	s/a: as int-ptr! 1000h
	s/c: s/a + s/b + 2							;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-12"
	s/a: as int-ptr! 1000h
	s/c: s/a + s/b + size						;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-13"
	s/a: as int-ptr! 1000h
	s/c: s/a + s/b + s/b						;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 1018h

	--test-- "math-mixed-14"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) + 2							;-- reg/imm
	--assert s/a = as int-ptr! 1008h

	--test-- "math-mixed-15"
	s/a: as int-ptr! 1000h
	i: 2 + as-integer fooA s/a					;-- imm/reg
	--assert i = 1002h

	--test-- "math-mixed-16"
	s/a: as int-ptr! 1000h
	s/a: (as int-ptr! 2) + as-integer fooA s/a	;-- imm/reg
	--assert s/a = as int-ptr! 4002h

	--test-- "math-mixed-17"
	s/a: (as int-ptr! fooB s/b) + size			;-- reg/ref
	--assert s/a = as int-ptr! 0Bh

	--test-- "math-mixed-18"
	i: size + fooB s/b							;-- ref/reg
	--assert i = 05h

	--test-- "math-mixed-19"
	s/a: (as int-ptr! size) + fooB s/b			;-- ref/reg
	--assert s/a = as int-ptr! 0Eh

	--test-- "math-mixed-20"
	i: (fooB s/b) + size - 1					;-- (reg/ref)/imm
	--assert i = 04h

	--test-- "math-mixed-21"
	i: (fooB s/b) - 1 + size					;-- (reg/imm)/ref
	--assert i = 04h

	--test-- "math-mixed-22"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) + size - 1					;-- (reg/ref)/imm
	--assert s/a = as int-ptr! 1004h

	--test-- "math-mixed-23"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) - 1 + size					;-- (reg/imm)/ref
	--assert s/a = as int-ptr! 1004h

	--test-- "math-mixed-24"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + s/b + 2					;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-25"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + s/b + size				;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-26"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + (fooB s/b) + s/b			;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 1018h

	--test-- "math-mixed-27"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + (fooB s/b) + 2			;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-28"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + (fooB s/b) + size			;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 1014h

	--test-- "math-mixed-29"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) + s/b + (fooB s/b) 			;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 1018h

	--test-- "math-mixed-30"
	s/a: as int-ptr! 1000h
	i: s/b + (fooA s/a) + (fooB s/b) 			;-- (reg/reg)/reg
	--assert i = 1006h

	--test-- "math-mixed-31"
	s/a: as int-ptr! 1000h
	i: 2 + (fooA s/a) + (fooB s/b) 				;-- (imm/reg)/reg
	--assert i = 1005h

	--test-- "math-mixed-32"
	s/a: as int-ptr! 1000h
	i: 2 + (fooA s/a) + size					;-- (imm/reg)/ref
	--assert i = 1004h

	--test-- "math-mixed-33"
	s/a: as int-ptr! 1000h
	i: 2 + (fooA s/a) + 3						;-- (imm/reg)/imm
	--assert i = 1005h

	--test-- "math-mixed-34"
	s/a: as int-ptr! 1000h
	s/a: s/a - 2								;-- reg/imm
	--assert s/a = as int-ptr! 0FF8h

	--test-- "math-mixed-35"
	s/a: as int-ptr! 1000h
	i: 2000h - as-integer s/a					;-- imm/reg
	--assert i = 1000h

	--test-- "math-mixed-36"
	s/a: as int-ptr! 1000h
	s/a: (as int-ptr! 6000h) - as-integer s/a	;-- imm/reg
	--assert s/a = as int-ptr! 2000h

	--test-- "math-mixed-37"
	s/a: as int-ptr! s/b - size					;-- reg/ref
	--assert s/a = as int-ptr! 01h

	--test-- "math-mixed-38"
	i: size - s/b								;-- ref/reg
	--assert i = -1

	--test-- "math-mixed-39"
	s/a: (as int-ptr! size) - s/b				;-- ref/reg
	--assert s/a = as int-ptr! -10

	--test-- "math-mixed-40"
	i: s/b - size - 1							;-- (reg/ref)/imm
	--assert i = 0

	--test-- "math-mixed-41"
	i: s/b - 1 - size							;-- (reg/imm)/ref
	--assert i = 0

	--test-- "math-mixed-42"
	s/a: as int-ptr! 1000h
	s/a: s/a - size - 1							;-- (reg/ref)/imm
	--assert s/a = as int-ptr! 0FF4h

	--test-- "math-mixed-43"
	s/a: as int-ptr! 1000h
	s/a: s/a - 1 - size							;-- (reg/imm)/ref
	--assert s/a = as int-ptr! 0FF4h

	--test-- "math-mixed-44"
	s/a: as int-ptr! 1000h
	s/c: s/a - s/b - 2							;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-45"
	s/a: as int-ptr! 1000h
	s/c: s/a - s/b - size						;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-46"
	s/a: as int-ptr! 1000h
	s/c: s/a - s/b - s/b						;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 0FE8h

	--test-- "math-mixed-47"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) - 2							;-- reg/imm
	--assert s/a = as int-ptr! 0FF8h

	--test-- "math-mixed-48"
	s/a: as int-ptr! 1000h
	i: 2 - as-integer fooA s/a					;-- imm/reg
	--assert i = FFFFF002h

	--test-- "math-mixed-49"
	s/a: as int-ptr! 1000h
	s/a: (as int-ptr! 2) - as-integer fooA s/a	;-- imm/reg
	--assert s/a = as int-ptr! FFFFC002h

	--test-- "math-mixed-50"
	s/a: (as int-ptr! fooB s/b) - size			;-- reg/ref
	--assert s/a = as int-ptr! -5

	--test-- "math-mixed-51"
	i: size - fooB s/b							;-- ref/reg
	--assert i = -1

	--test-- "math-mixed-52"
	s/a: (as int-ptr! size) - fooB s/b			;-- ref/reg
	--assert s/a = as int-ptr! -10

	--test-- "math-mixed-53"
	i: (fooB s/b) - size - 1					;-- (reg/ref)/imm
	--assert i = 0

	--test-- "math-mixed-54"
	i: (fooB s/b) - 1 - size					;-- (reg/imm)/ref
	--assert i = 0

	--test-- "math-mixed-55"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) - size - 1					;-- (reg/ref)/imm
	--assert s/a = as int-ptr! 0FF4h

	--test-- "math-mixed-56"
	s/a: as int-ptr! 1000h
	s/a: (fooA s/a) - 1 - size					;-- (reg/imm)/ref
	--assert s/a = as int-ptr! 0FF4h

	--test-- "math-mixed-57"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - s/b - 2					;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-58"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - s/b - size				;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-59"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - (fooB s/b) - s/b			;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 0FE8h

	--test-- "math-mixed-60"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - (fooB s/b) - 2			;-- (reg/reg)/imm
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-61"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - (fooB s/b) - size			;-- (reg/reg)/ref
	--assert s/c = as int-ptr! 0FECh

	--test-- "math-mixed-62"
	s/a: as int-ptr! 1000h
	s/c: (fooA s/a) - s/b - (fooB s/b) 			;-- (reg/reg)/reg
	--assert s/c = as int-ptr! 0FE8h

	--test-- "math-mixed-63"
	s/a: as int-ptr! 1000h
	i: s/b - (fooA s/a) - (fooB s/b) 			;-- (reg/reg)/reg
	--assert i = FFFFF000h

	--test-- "math-mixed-64"
	s/a: as int-ptr! 1000h
	i: 2 - (fooA s/a) - (fooB s/b) 				;-- (imm/reg)/reg
	--assert i = FFFFEFFFh

	--test-- "math-mixed-65"
	s/a: as int-ptr! 1000h
	i: 2 - (fooA s/a) - size					;-- (imm/reg)/ref
	--assert i = FFFFF000h

	--test-- "math-mixed-66"
	s/a: as int-ptr! 1000h
	i: 2 - (fooA s/a) - 3						;-- (imm/reg)/imm
	--assert i = FFFFEFFFh

	--test-- "math-mixed-67"
	s/a: as int-ptr! 1000h
	s/c: as int-ptr! 1010h
	i: as-integer s/c - s/a						;-- reg/reg (pointer - pointer)
	--assert i = 10h

	--test-- "math-mixed-68"
	s/a: as int-ptr! 1000h
	s/c: as int-ptr! 1010h
	i: as-integer (s/c - s/a) + 1				;-- reg/reg (pointer - pointer)
	--assert i = 14h

	--test-- "math-mixed-69"
	s/a: as int-ptr! 00154E28h
	s/c: as int-ptr! 00150018h
	i: (as-integer (s/a - s/c) + 1)	/ 4			;-- reg/reg (pointer - pointer)
	--assert i = 4997

	--test-- "math-mixed-70"
	p: declare struct! [
		a	[byte-ptr!]
		c	[int-ptr!]
	]
	p/a: as byte-ptr! 001F0014h
	p/c: as int-ptr!  001D0004h
	i: as-integer (p/a - ((as byte-ptr! p/c) + 16))	;-- reg/(reg/imm)
	--assert i = 00020000h

	--test-- "math-mixed-71"
	p/a: as byte-ptr! 001F0014h
	p/c: as int-ptr!  001D0014h
	series: p/c
	sz: 32
	--assert ((as byte-ptr! series) + sz) < p/a		;-- (ref/ref)/reg

===end-group===

~~~end-file~~~


FIX: removed leftover debugging code.

FIX: removed leftover debugging code.

Red/System [
	Title:   "Block! datatype runtime functions"
	Author:  "Nenad Rakocevic"
	File: 	 %block.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

block: context [
	verbose: 0

	depth: 0											;-- used to trace nesting level for FORM/MOLD

	rs-length?: func [
		blk 	[red-block!]
		return: [integer!]
		/local
			s	[series!]
	][
		s: GET_BUFFER(blk)
		(as-integer (s/tail - s/offset)) >> 4 - blk/head
	]

	rs-head: func [
		blk 	[red-block!]
		return: [red-value!]
		/local
			s	[series!]
	][
		s: GET_BUFFER(blk)
		s/offset
	]

	rs-tail: func [
		blk 	[red-block!]
		return: [red-value!]
		/local
			s	[series!]
	][
		s: GET_BUFFER(blk)
		s/tail
	]

	get-position: func [
		base	   [integer!]
		return:	   [integer!]
		/local
			blk	   [red-block!]
			index  [red-integer!]
			s	   [series!]
			offset [integer!]
			max	   [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/get-position"]]

		blk: as red-block! stack/arguments
		index: as red-integer! blk + 1

		assert TYPE_OF(blk)   = TYPE_BLOCK
		assert TYPE_OF(index) = TYPE_INTEGER

		s: GET_BUFFER(blk)

		offset: blk/head + index/value - base			;-- index is one-based
		if negative? offset [offset: 0]
		max: (as-integer s/tail - s/offset) >> 4
		if offset > max [offset: max]

		offset
	]

	append*: func [
		return: [red-block!]
		/local
			arg	[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/append*"]]

		arg: as red-block! stack/arguments
		;assert TYPE_OF(arg) = TYPE_BLOCK				;@@ disabled until we have ANY_BLOCK check

		copy-cell
			as cell! arg + 1
			ALLOC_TAIL(arg)

		arg
	]

	make-in: func [
		parent	[red-block!]
		size 	[integer!]								;-- number of cells to pre-allocate
		return:	[red-block!]
		/local
			blk [red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/make-in"]]

		blk: either null? parent [
			_root
		][
			assert TYPE_OF(parent) = TYPE_BLOCK
			as red-block! ALLOC_TAIL(parent)
		]
		blk/header: TYPE_BLOCK							;-- implicit reset of all header flags
		blk/head: 	0
		blk/node: 	alloc-cells size
		blk
	]

	push*: func [
		size	[integer!]
		return: [red-block!]
		/local
			blk [red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/push*"]]

		blk: as red-block! ALLOC_TAIL(root)
		blk/header: TYPE_BLOCK							;-- implicit reset of all header flags
		blk/head: 	0
		blk/node: 	alloc-cells size
		push blk
		blk
	]

	push: func [
		blk [red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/push"]]

		copy-cell as red-value! blk stack/push*
	]

	mold-each: func [
		blk		  [red-block!]
		buffer	  [red-string!]
		only?	  [logic!]
		all?	  [logic!]
		flat?	  [logic!]
		arg		  [red-value!]
		part 	  [integer!]
		return:   [integer!]
		/local
			s	  [series!]
			value [red-value!]
			i     [integer!]
	][
		s: GET_BUFFER(blk)
		i: blk/head
		while [
			value: s/offset + i
			value < s/tail
		][
			if all [OPTION?(arg) part <= 0][return part]

			depth: depth + 1
			part: actions/mold value buffer only? all? flat? arg part

			if positive? depth [
				string/append-char GET_BUFFER(buffer) as-integer space
				part: part - 1
			]
			depth: depth - 1
			i: i + 1
		]
		s: GET_BUFFER(buffer)
		if i <> blk/head [								;-- test if not empty block
			s/tail: as cell! (as byte-ptr! s/tail) - 1	;-- remove extra white space
			part: part + 1
		]
		part
	]

	compare-each: func [
		blk1	   [red-block!]							;-- first operand
		blk2	   [red-block!]							;-- second operand
		op		   [integer!]							;-- type of comparison
		return:	   [logic!]
		/local
			s1	   [series!]
			s2	   [series!]
			size1  [integer!]
			size2  [integer!]
			end	   [red-value!]
			value1 [red-value!]
			value2 [red-value!]
			res	   [logic!]
	][
		s1: GET_BUFFER(blk1)
		s2: GET_BUFFER(blk2)
		size1: (as-integer s1/tail - s1/offset) >> 4 - blk1/head
		size2: (as-integer s2/tail - s2/offset) >> 4 - blk2/head

		if size1 <> size2 [								;-- shortcut exit for different sizes
			if any [op = COMP_EQUAL op = COMP_STRICT_EQUAL][return false]
			if op = COMP_NOT_EQUAL [return true]
		]
		if zero? size1 [								;-- shortcut exit for empty blocks
			return any [op = COMP_EQUAL op = COMP_STRICT_EQUAL]
		]

		value1: s1/offset + blk1/head
		value2: s2/offset + blk2/head
		end: s1/tail									;-- only one "end" is needed
		until [
			res: actions/compare value1 value2 op
			value1: value1 + 1
			value2: value2 + 1
			any [
				not res
				value1 >= end
			]
		]
		res
	]

	;--- Actions ---

	make: func [
		proto 	 [red-value!]
		spec	 [red-value!]
		return:	 [red-block!]
		/local
			blk  [red-block!]
			size [integer!]
			int	 [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/make"]]

		size: 1
		switch TYPE_OF(spec) [
			TYPE_INTEGER [
				int: as red-integer! spec
				size: int/value
			]
			default [--NOT_IMPLEMENTED--]
		]
		blk: as red-block! stack/push*
		blk/header: TYPE_BLOCK							;-- implicit reset of all header flags
		blk/head: 	0
		blk/node: 	alloc-cells size
		blk
	]

	form: func [
		blk		  [red-block!]
		buffer	  [red-string!]
		arg		  [red-value!]
		part 	  [integer!]
		return:   [integer!]
		/local
			s	  [series!]
			value [red-value!]
			i     [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/form"]]

		s: GET_BUFFER(blk)
		i: blk/head

		while [
			value: s/offset + i
			value < s/tail
		][
			if all [OPTION?(arg) part <= 0][return part]

			part: actions/form value buffer arg part
			i: i + 1

			if 	s/offset + i < s/tail [
				string/append-char GET_BUFFER(buffer) as-integer space
				part: part - 1
			]
		]
		part
	]

	mold: func [
		blk		  [red-block!]
		buffer	  [red-string!]
		only?	  [logic!]
		all?	  [logic!]
		flat?	  [logic!]
		arg		  [red-value!]
		part 	  [integer!]
		return:   [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/mold"]]

		unless only? [
			string/append-char GET_BUFFER(buffer) as-integer #"["
			part: part - 1
		]
		part: mold-each blk buffer only? all? flat? arg part

		unless only? [
			string/append-char GET_BUFFER(buffer) as-integer #"]"
			part: part - 1
		]
		part
	]

	compare: func [
		blk1	   [red-block!]							;-- first operand
		blk2	   [red-block!]							;-- second operand
		op		   [integer!]							;-- type of comparison
		return:	   [logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/compare"]]

		if TYPE_OF(blk2) <> TYPE_BLOCK [RETURN_COMPARE_OTHER]
		compare-each blk1 blk2 op
	]

	;--- Property reading actions ---

	head?: func [
		return:	  [red-value!]
		/local
			blk	  [red-block!]
			state [red-logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/head?"]]

		blk:   as red-block! stack/arguments
		state: as red-logic! blk

		state/header: TYPE_LOGIC
		state/value:  zero? blk/head
		as red-value! state
	]

	tail?: func [
		return:	  [red-value!]
		/local
			blk	  [red-block!]
			state [red-logic!]
			s	  [series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/tail?"]]

		blk:   as red-block! stack/arguments
		state: as red-logic! blk

		s: GET_BUFFER(blk)

		state/header: TYPE_LOGIC
		state/value:  (s/offset + blk/head) = s/tail
		as red-value! state
	]

	index?: func [
		return:	  [red-value!]
		/local
			blk	  [red-block!]
			index [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/index?"]]

		blk:   as red-block! stack/arguments
		index: as red-integer! blk

		index/header: TYPE_INTEGER
		index/value:  blk/head + 1
		as red-value! index
	]

	length?: func [
		return: [red-value!]
		/local
			blk	[red-block!]
			int [red-integer!]
			s	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/length?"]]

		blk: as red-block! stack/arguments

		s: GET_BUFFER(blk)

		int: as red-integer! blk
		int/header: TYPE_INTEGER
		int/value:  (as-integer s/tail - s/offset - blk/head) >> 4
		as red-value! int
	]

	;--- Navigation actions ---

	at: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/at"]]

		blk: as red-block! stack/arguments
		blk/head: get-position 1
		as red-value! blk
	]

	back: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
			s	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/back"]]

		blk: as red-block! stack/arguments

		s: GET_BUFFER(blk)

		if blk/head >= 1 [blk/head: blk/head - 1]
		as red-value! blk
	]

	next: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
			s	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/next"]]

		blk: as red-block! stack/arguments

		s: GET_BUFFER(blk)

		if (s/offset + blk/head + 1) <= s/tail [
			blk/head: blk/head + 1
		]
		as red-value! blk
	]

	skip: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/skip"]]

		blk: as red-block! stack/arguments
		blk/head: get-position 0
		as red-value! blk
	]

	head: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/head"]]

		blk: as red-block! stack/arguments
		blk/head: 0
		as red-value! blk
	]

	tail: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
			s	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/tail"]]

		blk: as red-block! stack/arguments
		s: GET_BUFFER(blk)

		blk/head: (as-integer s/tail - s/offset) >> 4
		as red-value! blk
	]

	find: func [
		blk			[red-block!]
		value		[red-value!]
		part		[red-value!]
		only?		[logic!]
		case?		[logic!]
		any?		[logic!]
		with-arg	[red-string!]
		skip		[red-integer!]
		last?		[logic!]
		reverse?	[logic!]
		tail?		[logic!]
		match?		[logic!]
		return:		[red-value!]
		/local
			s		[series!]
			s2		[series!]
			slot	[red-value!]
			slot2	[red-value!]
			end		[red-value!]
			end2	[red-value!]
			int		[red-integer!]
			b		[red-block!]
			dt		[red-datatype!]
			values	[integer!]
			step	[integer!]
			n		[integer!]
			part?	[logic!]
			op		[integer!]
			type	[integer!]
			found?	[logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/find"]]

		s: GET_BUFFER(blk)
		if s/offset = s/tail [							;-- early exit if blk is empty
			blk/header: TYPE_NONE
			return as red-value! blk
		]
		step:  1
		part?: no

		if OPTION?(skip) [
			assert TYPE_OF(skip) = TYPE_INTEGER
			step: skip/value
		]
		if OPTION?(part) [
			part: either TYPE_OF(part) = TYPE_INTEGER [
				int: as red-integer! part
				if int/value <= 0 [						;-- early exit if part <= 0
					blk/header: TYPE_NONE
					return as red-value! blk
				]
				s/offset + int/value - 1				;-- int argument is 1-based
			][
				b: as red-block! part
				unless all [
					TYPE_OF(b) = TYPE_OF(blk)			;-- handles ANY-BLOCK!
					b/node = blk/node
				][
					print "*** Error: invalid /part series argument"	;@@ replace with error!
					halt
				]
				s/offset + b/head
			]
			part?: yes
		]

		type: TYPE_OF(value)
		values: either only? [0][						;-- values > 0 => series comparison mode
			either any [								;@@ replace with ANY_BLOCK?
				type = TYPE_BLOCK
				type = TYPE_PAREN
				type = TYPE_PATH
				type = TYPE_GET_PATH
				type = TYPE_SET_PATH
				type = TYPE_LIT_PATH
			][
				b: as red-block! value
				s2: GET_BUFFER(b)
				value: s2/offset + b/head
				end2: s2/tail
				(as-integer s2/tail - s2/offset) >> 4 - b/head
			][0]
		]
		if negative? values [values: 0]					;-- empty value series case

		case [
			last? [
				step: 0 - step
				slot: either part? [part][s/tail - 1]
				end: s/offset
			]
			reverse? [
				step: 0 - step
				slot: either part? [part][s/offset + blk/head - 1]
				end: s/offset
				if slot < end [							;-- early exit if blk/head = 0
					blk/header: TYPE_NONE
					return as red-value! blk
				]
			]
			true [
				slot: s/offset + blk/head
				end: either part? [part + 1][s/tail]	;-- + 1 => compensate for the '>= test
			]
		]
		op: either case? [COMP_STRICT_EQUAL][COMP_EQUAL] ;-- warning: /case <> STRICT...
		reverse?: any [reverse? last?]					;-- reduce both flags to one

		type: either type = TYPE_DATATYPE [
			dt: as red-datatype! value
			dt/value
		][-1]											;-- disable "type searching" mode

		until [
			either zero? values [
				found?: either positive? type [
					type = TYPE_OF(slot)				;-- simple type comparison
				][
					actions/compare slot value op		;-- atomic comparison
				]
				if match? [slot: slot + 1]				;-- /match option returns tail of match
			][
				n: 0
				slot2: slot
				until [									;-- series comparison
					found?: actions/compare slot2 value + n op
					slot2: slot2 + 1
					n: n + 1
					any [
						not found?						;-- no match
						n = values						;-- values exhausted
						all [reverse?     slot2 <= end]	;-- block series head reached
						all [not reverse? slot2 >= end]	;-- block series tail reached
					]
				]
				if all [n < values slot2 >= end][found?: no] ;-- partial match case, make it fail
				if all [match? found?][slot: slot2]		;-- slot2 points to tail of match
			]
			slot: slot + step
			any [
				match?									;-- /match option limits to one comparison
				all [not match? found?]					;-- match found
				all [reverse? slot <= end]				;-- head of block series reached
				all [not reverse? slot >= end]			;-- tail of block series reached
			]
		]
		unless tail? [slot: slot - step]				;-- point before/after found value

		either found? [
			blk/head: (as-integer slot - s/offset) >> 4	;-- just change the head position on stack
		][
			blk/header: TYPE_NONE						;-- change the stack 1st argument to none.
		]
		slot
	]

	select: func [
		blk		 [red-block!]
		value	 [red-value!]
		part	 [red-value!]
		only?	 [logic!]
		case?	 [logic!]
		any?	 [logic!]
		with-arg [red-string!]
		skip	 [red-integer!]
		last?	 [logic!]
		reverse? [logic!]
		tail?	 [logic!]
		match?	 [logic!]
		return:	 [red-value!]
		/local
			s	   [series!]
			p	   [red-value!]
			b	   [red-block!]
			type   [integer!]
			offset [integer!]
	][
		p: find blk value part only? case? any? with-arg skip last? reverse? no no

		if TYPE_OF(blk) <> TYPE_NONE [
			offset: either only? [1][					;-- values > 0 => series comparison mode
				type: TYPE_OF(value)
				either any [							;@@ replace with ANY_BLOCK?
					type = TYPE_BLOCK
					type = TYPE_PAREN
					type = TYPE_PATH
					type = TYPE_GET_PATH
					type = TYPE_SET_PATH
					type = TYPE_LIT_PATH
				][
					b: as red-block! value
					s: GET_BUFFER(b)
					(as-integer s/tail - s/offset) >> 4 - b/head
				][1]
			]
			s: GET_BUFFER(blk)
			p: s/offset + blk/head + offset

			either p < s/tail [
				stack/set-last p
			][
				blk/header: TYPE_NONE
			]
		]
		p
	]

	;--- Reading actions ---

	pick: func [
		blk	       [red-block!]
		index  	   [integer!]
		return:	   [red-value!]
		/local
			cell   [red-value!]
			s	   [series!]
			offset [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/pick"]]

		s: GET_BUFFER(blk)

		offset: blk/head + index - 1					;-- index is one-based
		if negative? index [offset: offset + 1]
		cell: s/offset + offset

		either any [
			zero? index
			cell >= s/tail
			cell < s/offset
		][
			none-value
		][
			cell
		]
	]

	;--- Modifying actions ---

	append: func [
		blk		  [red-block!]
		value	  [red-value!]
		part-arg  [red-value!]
		only?	  [logic!]
		dup-arg	  [red-value!]
		return:	  [red-value!]
		/local
			src	  [red-block!]
			cell  [red-value!]
			limit [red-value!]
			int	  [red-integer!]
			b	  [red-block!]
			s	  [series!]
			cnt	  [integer!]
			part  [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/append"]]

		cnt:  1
		part: -1

		if OPTION?(part-arg) [
			part: either TYPE_OF(part-arg) = TYPE_INTEGER [
				int: as red-integer! part-arg
				int/value
			][
				b: as red-block! part-arg
				assert all [
					TYPE_OF(b) = TYPE_BLOCK
					b/node = blk/node
				]
				b/head + 1								;-- /head is 0-based
			]
		]
		if OPTION?(dup-arg) [
			int: as red-integer! dup-arg
			cnt: int/value
		]

		while [not zero? cnt][							;-- /dup support
			either all [
				not only?								;-- /only support
				any [
					TYPE_OF(value) = TYPE_BLOCK			;@@ replace it with: typeset/any-block?
					TYPE_OF(value) = TYPE_PATH			;@@ replace it with: typeset/any-block?
				]
			][
				src: as red-block! value
				if negative? part [part: rs-length? src] ;-- if not /part, use whole value length
				s: GET_BUFFER(src)
				cell: s/offset + src/head
				limit: cell + part						;-- /part support

				while [cell < limit][					;-- multiple values case
					copy-cell cell ALLOC_TAIL(blk)
					cell: cell + 1
				]
			][											;-- single value case
				copy-cell value	ALLOC_TAIL(blk)
			]
			cnt: cnt - 1
		]
		as red-value! blk
	]

	clear: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
			s	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/clear"]]

		blk: as red-block! stack/arguments
		s: GET_BUFFER(blk)
		s/tail: s/offset + blk/head
		as red-value! blk
	]

	poke: func [
		blk		   [red-block!]
		index	   [integer!]
		data       [red-value!]
		return:	   [red-value!]
		/local
			cell   [red-value!]
			s	   [series!]
			offset [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/poke"]]

		s: GET_BUFFER(blk)

		offset: blk/head + index - 1					;-- index is one-based
		if negative? index [offset: offset + 1]
		cell: s/offset + offset

		either any [
			zero? index
			cell >= s/tail
			cell < s/offset
		][
			;TBD: placeholder waiting for error! to be implemented
			stack/set-last none-value					;@@ should raise an error!
		][
			copy-cell data cell
			stack/set-last data
		]
		as red-value! data
	]

	;--- Misc actions ---

	copy: func [
		blk	    	[red-block!]
		part-arg	[red-value!]
		deep?		[logic!]
		types		[red-value!]
		return:		[red-series!]
		/local
			int		[red-integer!]
			b		[red-block!]
			offset	[red-value!]
			slot	[red-value!]
			buffer	[series!]
			new		[node!]
			part	[integer!]
			slots	[integer!]
			type	[integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/copy"]]

		s: GET_BUFFER(blk)

		slots:	rs-length? blk
		offset: s/offset + blk/head
		part:   as-integer s/tail - offset

		if OPTION?(types) [--NOT_IMPLEMENTED--]

		if OPTION?(part-arg) [
			part: either TYPE_OF(part-arg) = TYPE_INTEGER [
				int: as red-integer! part-arg
				case [
					int/value > (part >> 4) [part >> 4]
					positive? int/value 	[int/value]
					true					[0]
				]
			][
				b: as red-block! part-arg
				unless all [
					TYPE_OF(b) = TYPE_OF(blk)			;-- handles ANY-BLOCK!
					b/node = blk/node
				][
					print "*** Error: invalid /part series argument"	;@@ replace with error!
					halt
				]
				b/head
			]
			slots: part
			part: part << 4
		]

		new: 	alloc-cells slots + 1
		buffer: as series! new/value

		unless zero? part [
			copy-memory
				as byte-ptr! buffer/offset
				as byte-ptr! offset
				part

			buffer/tail: buffer/offset + slots
		]
		blk/node: new									;-- reuse the block slot
		blk/head: 0										;-- reset head offset

		if deep? [
			slot: buffer/offset
			until [
				type: TYPE_OF(slot)
				if any [								;@@ replace with ANY_SERIES?
					type = TYPE_BLOCK
					type = TYPE_PAREN
					type = TYPE_PATH
					type = TYPE_GET_PATH
					type = TYPE_SET_PATH
					type = TYPE_LIT_PATH
					type = TYPE_STRING
				][
					actions/copy as red-series! slot null yes null
				]
				slot: slot + 1
				slot >= buffer/tail
			]
		]

		as red-series! blk
	]

	datatype/register [
		TYPE_BLOCK
		TYPE_VALUE
		"block!"
		;-- General actions --
		:make
		null			;random
		null			;reflect
		null			;to
		:form
		:mold
		null			;get-path
		null			;set-path
		:compare
		;-- Scalar actions --
		null			;absolute
		null			;add
		null			;divide
		null			;multiply
		null			;negate
		null			;power
		null			;remainder
		null			;round
		null			;subtract
		null			;even?
		null			;odd?
		;-- Bitwise actions --
		null			;and~
		null			;complement
		null			;or~
		null			;xor~
		;-- Series actions --
		:append
		:at
		:back
		null			;change
		:clear
		:copy
		:find
		:head
		:head?
		:index?
		null			;insert
		:length?
		:next
		:pick
		:poke
		null			;remove
		null			;reverse
		:select
		null			;sort
		:skip
		null			;swap
		:tail
		:tail?
		null			;take
		null			;trim
		;-- I/O actions --
		null			;create
		null			;close
		null			;delete
		null			;modify
		null			;open
		null			;open?
		null			;query
		null			;read
		null			;rename
		null			;update
		null			;write
	]
]

Red/System [
	Title:   "Block! datatype runtime functions"
	Author:  "Nenad Rakocevic"
	File: 	 %block.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-2012 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/BSL-License.txt
	}
]

block: context [
	verbose: 0

	depth: 0											;-- used to trace nesting level for FORM/MOLD

	rs-length?: func [
		blk 	[red-block!]
		return: [integer!]
		/local
			s	[series!]
	][
		s: GET_BUFFER(blk)
		(as-integer (s/tail - s/offset)) >> 4 - blk/head
	]

	rs-head: func [
		blk 	[red-block!]
		return: [red-value!]
		/local
			s	[series!]
	][
		s: GET_BUFFER(blk)
		s/offset
	]

	rs-tail: func [
		blk 	[red-block!]
		return: [red-value!]
		/local
			s	[series!]
	][
		s: GET_BUFFER(blk)
		s/tail
	]

	get-position: func [
		base	   [integer!]
		return:	   [integer!]
		/local
			blk	   [red-block!]
			index  [red-integer!]
			s	   [series!]
			offset [integer!]
			max	   [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/get-position"]]

		blk: as red-block! stack/arguments
		index: as red-integer! blk + 1

		assert TYPE_OF(blk)   = TYPE_BLOCK
		assert TYPE_OF(index) = TYPE_INTEGER

		s: GET_BUFFER(blk)

		offset: blk/head + index/value - base			;-- index is one-based
		if negative? offset [offset: 0]
		max: (as-integer s/tail - s/offset) >> 4
		if offset > max [offset: max]

		offset
	]

	append*: func [
		return: [red-block!]
		/local
			arg	[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/append*"]]

		arg: as red-block! stack/arguments
		;assert TYPE_OF(arg) = TYPE_BLOCK				;@@ disabled until we have ANY_BLOCK check

		copy-cell
			as cell! arg + 1
			ALLOC_TAIL(arg)

		arg
	]

	make-in: func [
		parent	[red-block!]
		size 	[integer!]								;-- number of cells to pre-allocate
		return:	[red-block!]
		/local
			blk [red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/make-in"]]

		blk: either null? parent [
			_root
		][
			assert TYPE_OF(parent) = TYPE_BLOCK
			as red-block! ALLOC_TAIL(parent)
		]
		blk/header: TYPE_BLOCK							;-- implicit reset of all header flags
		blk/head: 	0
		blk/node: 	alloc-cells size
		blk
	]

	push*: func [
		size	[integer!]
		return: [red-block!]
		/local
			blk [red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/push*"]]

		blk: as red-block! ALLOC_TAIL(root)
		blk/header: TYPE_BLOCK							;-- implicit reset of all header flags
		blk/head: 	0
		blk/node: 	alloc-cells size
		push blk
		blk
	]

	push: func [
		blk [red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/push"]]

		copy-cell as red-value! blk stack/push*
	]

	mold-each: func [
		blk		  [red-block!]
		buffer	  [red-string!]
		only?	  [logic!]
		all?	  [logic!]
		flat?	  [logic!]
		arg		  [red-value!]
		part 	  [integer!]
		return:   [integer!]
		/local
			s	  [series!]
			value [red-value!]
			i     [integer!]
	][
		s: GET_BUFFER(blk)
		i: blk/head
		while [
			value: s/offset + i
			value < s/tail
		][
			if all [OPTION?(arg) part <= 0][return part]

			depth: depth + 1
			part: actions/mold value buffer only? all? flat? arg part

			if positive? depth [
				string/append-char GET_BUFFER(buffer) as-integer space
				part: part - 1
			]
			depth: depth - 1
			i: i + 1
		]
		s: GET_BUFFER(buffer)
		if i <> blk/head [								;-- test if not empty block
			s/tail: as cell! (as byte-ptr! s/tail) - 1	;-- remove extra white space
			part: part + 1
		]
		part
	]

	compare-each: func [
		blk1	   [red-block!]							;-- first operand
		blk2	   [red-block!]							;-- second operand
		op		   [integer!]							;-- type of comparison
		return:	   [logic!]
		/local
			s1	   [series!]
			s2	   [series!]
			size1  [integer!]
			size2  [integer!]
			end	   [red-value!]
			value1 [red-value!]
			value2 [red-value!]
			res	   [logic!]
	][
		s1: GET_BUFFER(blk1)
		s2: GET_BUFFER(blk2)
		size1: (as-integer s1/tail - s1/offset) >> 4 - blk1/head
		size2: (as-integer s2/tail - s2/offset) >> 4 - blk2/head

		if size1 <> size2 [								;-- shortcut exit for different sizes
			if any [op = COMP_EQUAL op = COMP_STRICT_EQUAL][return false]
			if op = COMP_NOT_EQUAL [return true]
		]
		if zero? size1 [								;-- shortcut exit for empty blocks
			return any [op = COMP_EQUAL op = COMP_STRICT_EQUAL]
		]

		value1: s1/offset + blk1/head
		value2: s2/offset + blk2/head
		end: s1/tail									;-- only one "end" is needed
		until [
			res: actions/compare value1 value2 op
			value1: value1 + 1
			value2: value2 + 1
			any [
				not res
				value1 >= end
			]
		]
		res
	]

	;--- Actions ---

	make: func [
		proto 	 [red-value!]
		spec	 [red-value!]
		return:	 [red-block!]
		/local
			blk  [red-block!]
			size [integer!]
			int	 [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/make"]]

		size: 1
		switch TYPE_OF(spec) [
			TYPE_INTEGER [
				int: as red-integer! spec
				size: int/value
			]
			default [--NOT_IMPLEMENTED--]
		]
		blk: as red-block! stack/push*
		blk/header: TYPE_BLOCK							;-- implicit reset of all header flags
		blk/head: 	0
		blk/node: 	alloc-cells size
		blk
	]

	form: func [
		blk		  [red-block!]
		buffer	  [red-string!]
		arg		  [red-value!]
		part 	  [integer!]
		return:   [integer!]
		/local
			s	  [series!]
			value [red-value!]
			i     [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/form"]]

		s: GET_BUFFER(blk)
		i: blk/head

		while [
			value: s/offset + i
			value < s/tail
		][
			if all [OPTION?(arg) part <= 0][return part]

			part: actions/form value buffer arg part
			i: i + 1

			if 	s/offset + i < s/tail [
				string/append-char GET_BUFFER(buffer) as-integer space
				part: part - 1
			]
		]
		part
	]

	mold: func [
		blk		  [red-block!]
		buffer	  [red-string!]
		only?	  [logic!]
		all?	  [logic!]
		flat?	  [logic!]
		arg		  [red-value!]
		part 	  [integer!]
		return:   [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/mold"]]

		unless only? [
			string/append-char GET_BUFFER(buffer) as-integer #"["
			part: part - 1
		]
		part: mold-each blk buffer only? all? flat? arg part

		unless only? [
			string/append-char GET_BUFFER(buffer) as-integer #"]"
			part: part - 1
		]
		part
	]

	compare: func [
		blk1	   [red-block!]							;-- first operand
		blk2	   [red-block!]							;-- second operand
		op		   [integer!]							;-- type of comparison
		return:	   [logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/compare"]]

		if TYPE_OF(blk2) <> TYPE_BLOCK [RETURN_COMPARE_OTHER]
		compare-each blk1 blk2 op
	]

	;--- Property reading actions ---

	head?: func [
		return:	  [red-value!]
		/local
			blk	  [red-block!]
			state [red-logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/head?"]]

		blk:   as red-block! stack/arguments
		state: as red-logic! blk

		state/header: TYPE_LOGIC
		state/value:  zero? blk/head
		as red-value! state
	]

	tail?: func [
		return:	  [red-value!]
		/local
			blk	  [red-block!]
			state [red-logic!]
			s	  [series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/tail?"]]

		blk:   as red-block! stack/arguments
		state: as red-logic! blk

		s: GET_BUFFER(blk)

		state/header: TYPE_LOGIC
		state/value:  (s/offset + blk/head) = s/tail
		as red-value! state
	]

	index?: func [
		return:	  [red-value!]
		/local
			blk	  [red-block!]
			index [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/index?"]]

		blk:   as red-block! stack/arguments
		index: as red-integer! blk

		index/header: TYPE_INTEGER
		index/value:  blk/head + 1
		as red-value! index
	]

	length?: func [
		return: [red-value!]
		/local
			blk	[red-block!]
			int [red-integer!]
			s	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/length?"]]

		blk: as red-block! stack/arguments

		s: GET_BUFFER(blk)

		int: as red-integer! blk
		int/header: TYPE_INTEGER
		int/value:  (as-integer s/tail - s/offset - blk/head) >> 4
		as red-value! int
	]

	;--- Navigation actions ---

	at: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/at"]]

		blk: as red-block! stack/arguments
		blk/head: get-position 1
		as red-value! blk
	]

	back: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
			s	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/back"]]

		blk: as red-block! stack/arguments

		s: GET_BUFFER(blk)

		if blk/head >= 1 [blk/head: blk/head - 1]
		as red-value! blk
	]

	next: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
			s	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/next"]]

		blk: as red-block! stack/arguments

		s: GET_BUFFER(blk)

		if (s/offset + blk/head + 1) <= s/tail [
			blk/head: blk/head + 1
		]
		as red-value! blk
	]

	skip: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/skip"]]

		blk: as red-block! stack/arguments
		blk/head: get-position 0
		as red-value! blk
	]

	head: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/head"]]

		blk: as red-block! stack/arguments
		blk/head: 0
		as red-value! blk
	]

	tail: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
			s	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/tail"]]

		blk: as red-block! stack/arguments
		s: GET_BUFFER(blk)

		blk/head: (as-integer s/tail - s/offset) >> 4
		as red-value! blk
	]

	find: func [
		blk			[red-block!]
		value		[red-value!]
		part		[red-value!]
		only?		[logic!]
		case?		[logic!]
		any?		[logic!]
		with-arg	[red-string!]
		skip		[red-integer!]
		last?		[logic!]
		reverse?	[logic!]
		tail?		[logic!]
		match?		[logic!]
		return:		[red-value!]
		/local
			s		[series!]
			s2		[series!]
			slot	[red-value!]
			slot2	[red-value!]
			end		[red-value!]
			end2	[red-value!]
			int		[red-integer!]
			b		[red-block!]
			dt		[red-datatype!]
			values	[integer!]
			step	[integer!]
			n		[integer!]
			part?	[logic!]
			op		[integer!]
			type	[integer!]
			found?	[logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/find"]]

		s: GET_BUFFER(blk)
		if s/offset = s/tail [							;-- early exit if blk is empty
			blk/header: TYPE_NONE
			return as red-value! blk
		]
		step:  1
		part?: no

		if OPTION?(skip) [
			assert TYPE_OF(skip) = TYPE_INTEGER
			step: skip/value
		]
		if OPTION?(part) [
			part: either TYPE_OF(part) = TYPE_INTEGER [
				int: as red-integer! part
				if int/value <= 0 [						;-- early exit if part <= 0
					blk/header: TYPE_NONE
					return as red-value! blk
				]
				s/offset + int/value - 1				;-- int argument is 1-based
			][
				b: as red-block! part
				unless all [
					TYPE_OF(b) = TYPE_OF(blk)			;-- handles ANY-BLOCK!
					b/node = blk/node
				][
					print "*** Error: invalid /part series argument"	;@@ replace with error!
					halt
				]
				s/offset + b/head
			]
			part?: yes
		]

		type: TYPE_OF(value)
		values: either only? [0][						;-- values > 0 => series comparison mode
			either any [								;@@ replace with ANY_BLOCK?
				type = TYPE_BLOCK
				type = TYPE_PAREN
				type = TYPE_PATH
				type = TYPE_GET_PATH
				type = TYPE_SET_PATH
				type = TYPE_LIT_PATH
			][
				b: as red-block! value
				s2: GET_BUFFER(b)
				value: s2/offset + b/head
				end2: s2/tail
				(as-integer s2/tail - s2/offset) >> 4 - b/head
			][0]
		]
		if negative? values [values: 0]					;-- empty value series case

		case [
			last? [
				step: 0 - step
				slot: either part? [part][s/tail - 1]
				end: s/offset
			]
			reverse? [
				step: 0 - step
				slot: either part? [part][s/offset + blk/head - 1]
				end: s/offset
				if slot < end [							;-- early exit if blk/head = 0
					blk/header: TYPE_NONE
					return as red-value! blk
				]
			]
			true [
				slot: s/offset + blk/head
				end: either part? [part + 1][s/tail]	;-- + 1 => compensate for the '>= test
			]
		]
		op: either case? [COMP_STRICT_EQUAL][COMP_EQUAL] ;-- warning: /case <> STRICT...
		reverse?: any [reverse? last?]					;-- reduce both flags to one

		type: either type = TYPE_DATATYPE [
			dt: as red-datatype! value
			dt/value
		][-1]											;-- disable "type searching" mode

		until [
			either zero? values [
				found?: either positive? type [
					type = TYPE_OF(slot)				;-- simple type comparison
				][
					actions/compare slot value op		;-- atomic comparison
				]
				if match? [slot: slot + 1]				;-- /match option returns tail of match
			][
				n: 0
				slot2: slot
				until [									;-- series comparison
					found?: actions/compare slot2 value + n op
					slot2: slot2 + 1
					n: n + 1
					any [
						not found?						;-- no match
						n = values						;-- values exhausted
						all [reverse?     slot2 <= end]	;-- block series head reached
						all [not reverse? slot2 >= end]	;-- block series tail reached
					]
				]
				if all [n < values slot2 >= end][found?: no] ;-- partial match case, make it fail
				if all [match? found?][slot: slot2]		;-- slot2 points to tail of match
			]
			slot: slot + step
			any [
				match?									;-- /match option limits to one comparison
				all [not match? found?]					;-- match found
				all [reverse? slot <= end]				;-- head of block series reached
				all [not reverse? slot >= end]			;-- tail of block series reached
			]
		]
		unless tail? [slot: slot - step]				;-- point before/after found value

		either found? [
			blk/head: (as-integer slot - s/offset) >> 4	;-- just change the head position on stack
		][
			blk/header: TYPE_NONE						;-- change the stack 1st argument to none.
		]
		slot
	]

	select: func [
		blk		 [red-block!]
		value	 [red-value!]
		part	 [red-value!]
		only?	 [logic!]
		case?	 [logic!]
		any?	 [logic!]
		with-arg [red-string!]
		skip	 [red-integer!]
		last?	 [logic!]
		reverse? [logic!]
		tail?	 [logic!]
		match?	 [logic!]
		return:	 [red-value!]
		/local
			s	   [series!]
			p	   [red-value!]
			b	   [red-block!]
			type   [integer!]
			offset [integer!]
	][
		p: find blk value part only? case? any? with-arg skip last? reverse? no no

		if TYPE_OF(blk) <> TYPE_NONE [
			offset: either only? [1][					;-- values > 0 => series comparison mode
				type: TYPE_OF(value)
				either any [							;@@ replace with ANY_BLOCK?
					type = TYPE_BLOCK
					type = TYPE_PAREN
					type = TYPE_PATH
					type = TYPE_GET_PATH
					type = TYPE_SET_PATH
					type = TYPE_LIT_PATH
				][
					b: as red-block! value
					s: GET_BUFFER(b)
					(as-integer s/tail - s/offset) >> 4 - b/head
				][1]
			]
			s: GET_BUFFER(blk)
			p: s/offset + blk/head + offset

			either p < s/tail [
				stack/set-last p
			][
				blk/header: TYPE_NONE
			]
		]
		p
	]

	;--- Reading actions ---

	pick: func [
		blk	       [red-block!]
		index  	   [integer!]
		return:	   [red-value!]
		/local
			cell   [red-value!]
			s	   [series!]
			offset [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/pick"]]

		s: GET_BUFFER(blk)

		offset: blk/head + index - 1					;-- index is one-based
		if negative? index [offset: offset + 1]
		cell: s/offset + offset

		either any [
			zero? index
			cell >= s/tail
			cell < s/offset
		][
			none-value
		][
			cell
		]
	]

	;--- Modifying actions ---

	append: func [
		blk		  [red-block!]
		value	  [red-value!]
		part-arg  [red-value!]
		only?	  [logic!]
		dup-arg	  [red-value!]
		return:	  [red-value!]
		/local
			src	  [red-block!]
			cell  [red-value!]
			limit [red-value!]
			int	  [red-integer!]
			b	  [red-block!]
			s	  [series!]
			cnt	  [integer!]
			part  [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/append"]]

		cnt:  1
		part: -1

		if OPTION?(part-arg) [
			part: either TYPE_OF(part-arg) = TYPE_INTEGER [
				int: as red-integer! part-arg
				int/value
			][
				b: as red-block! part-arg
				assert all [
					TYPE_OF(b) = TYPE_BLOCK
					b/node = blk/node
				]
				b/head + 1								;-- /head is 0-based
			]
		]
		if OPTION?(dup-arg) [
			int: as red-integer! dup-arg
			cnt: int/value
		]

		while [not zero? cnt][							;-- /dup support
			either all [
				not only?								;-- /only support
				any [
					TYPE_OF(value) = TYPE_BLOCK			;@@ replace it with: typeset/any-block?
					TYPE_OF(value) = TYPE_PATH			;@@ replace it with: typeset/any-block?
				]
			][
				src: as red-block! value
				if negative? part [part: rs-length? src] ;-- if not /part, use whole value length
				s: GET_BUFFER(src)
				cell: s/offset + src/head
				limit: cell + part						;-- /part support

				while [cell < limit][					;-- multiple values case
					copy-cell cell ALLOC_TAIL(blk)
					cell: cell + 1
				]
			][											;-- single value case
				copy-cell value	ALLOC_TAIL(blk)
s: GET_BUFFER(blk)
dump4 s
			]
			cnt: cnt - 1
		]
		as red-value! blk
	]

	clear: func [
		return:	[red-value!]
		/local
			blk	[red-block!]
			s	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/clear"]]

		blk: as red-block! stack/arguments
		s: GET_BUFFER(blk)
		s/tail: s/offset + blk/head
		as red-value! blk
	]

	poke: func [
		blk		   [red-block!]
		index	   [integer!]
		data       [red-value!]
		return:	   [red-value!]
		/local
			cell   [red-value!]
			s	   [series!]
			offset [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/poke"]]

		s: GET_BUFFER(blk)

		offset: blk/head + index - 1					;-- index is one-based
		if negative? index [offset: offset + 1]
		cell: s/offset + offset

		either any [
			zero? index
			cell >= s/tail
			cell < s/offset
		][
			;TBD: placeholder waiting for error! to be implemented
			stack/set-last none-value					;@@ should raise an error!
		][
			copy-cell data cell
			stack/set-last data
		]
		as red-value! data
	]

	;--- Misc actions ---

	copy: func [
		blk	    	[red-block!]
		part-arg	[red-value!]
		deep?		[logic!]
		types		[red-value!]
		return:		[red-series!]
		/local
			int		[red-integer!]
			b		[red-block!]
			offset	[red-value!]
			slot	[red-value!]
			buffer	[series!]
			new		[node!]
			part	[integer!]
			slots	[integer!]
			type	[integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "block/copy"]]

		s: GET_BUFFER(blk)

		slots:	rs-length? blk
		offset: s/offset + blk/head
		part:   as-integer s/tail - offset

		if OPTION?(types) [--NOT_IMPLEMENTED--]

		if OPTION?(part-arg) [
			part: either TYPE_OF(part-arg) = TYPE_INTEGER [
				int: as red-integer! part-arg
				case [
					int/value > (part >> 4) [part >> 4]
					positive? int/value 	[int/value]
					true					[0]
				]
			][
				b: as red-block! part-arg
				unless all [
					TYPE_OF(b) = TYPE_OF(blk)			;-- handles ANY-BLOCK!
					b/node = blk/node
				][
					print "*** Error: invalid /part series argument"	;@@ replace with error!
					halt
				]
				b/head
			]
			slots: part
			part: part << 4
		]

		new: 	alloc-cells slots + 1
		buffer: as series! new/value

		unless zero? part [
			copy-memory
				as byte-ptr! buffer/offset
				as byte-ptr! offset
				part

			buffer/tail: buffer/offset + slots
		]
		blk/node: new									;-- reuse the block slot
		blk/head: 0										;-- reset head offset

		if deep? [
			slot: buffer/offset
			until [
				type: TYPE_OF(slot)
				if any [								;@@ replace with ANY_SERIES?
					type = TYPE_BLOCK
					type = TYPE_PAREN
					type = TYPE_PATH
					type = TYPE_GET_PATH
					type = TYPE_SET_PATH
					type = TYPE_LIT_PATH
					type = TYPE_STRING
				][
					actions/copy as red-series! slot null yes null
				]
				slot: slot + 1
				slot >= buffer/tail
			]
		]

		as red-series! blk
	]

	datatype/register [
		TYPE_BLOCK
		TYPE_VALUE
		"block!"
		;-- General actions --
		:make
		null			;random
		null			;reflect
		null			;to
		:form
		:mold
		null			;get-path
		null			;set-path
		:compare
		;-- Scalar actions --
		null			;absolute
		null			;add
		null			;divide
		null			;multiply
		null			;negate
		null			;power
		null			;remainder
		null			;round
		null			;subtract
		null			;even?
		null			;odd?
		;-- Bitwise actions --
		null			;and~
		null			;complement
		null			;or~
		null			;xor~
		;-- Series actions --
		:append
		:at
		:back
		null			;change
		:clear
		:copy
		:find
		:head
		:head?
		:index?
		null			;insert
		:length?
		:next
		:pick
		:poke
		null			;remove
		null			;reverse
		:select
		null			;sort
		:skip
		null			;swap
		:tail
		:tail?
		null			;take
		null			;trim
		;-- I/O actions --
		null			;create
		null			;close
		null			;delete
		null			;modify
		null			;open
		null			;open?
		null			;query
		null			;read
		null			;rename
		null			;update
		null			;write
	]
]