FIX: possible corruption of buffer for -2^32 value.

Red/System [
	Title:   "Red/System native implementations of basic functions"
	Author:  "Nenad Rakocevic"
	File: 	 %lib-natives.reds
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt
	}
]

allocate:  func [						;-- needs a Red/System native implementation
	size		[integer!]
	return:		[byte-ptr!]
][
	;TBD
]

free: func [							;-- needs a Red/System native implementation
	buffer		[byte-ptr!]
][
	;TBD
]

set-memory: func [						;; fill a memory buffer with the same given byte ;;
	target		[byte-ptr!]				;; pointer to start of the buffer ;;
	filler		[byte!]					;; filler byte ;;
	size		[integer!]				;; size of the buffer to fill ;;
	return:		[byte-ptr!]				;; returns the start of the buffer ;;
][
	unless zero? size [
		until [
			target/1: filler
			target: target + 1
			size: size - 1
			zero? size
		]
	]
	target
]

copy-memory: func [						;; copy a memory buffer to a new region in a safe way ;;
	target		[byte-ptr!]				;; target start address ;;
	source		[byte-ptr!]				;; source start address ;;
	size		[integer!]				;; number of bytes to copy ;;
	return:		[byte-ptr!]				;; returns the target start address ;;
	/local c
][
	unless any [zero? size source = target][
		either source < target [
			until [
				target/size: source/size
				size: size - 1
				zero? size
			]
		][
			c: 0
			until [
				target/c: source/c
				c: c + 1
				size: size - 1
				zero? size
			]
		]
	]
	target
]

length?: func [							;; return the number of characters from a c-string value ;;
	s 		[c-string!]					;; c-string value ;;
	return: [integer!]
	/local base
][
	base: s
	while [s/1 <> null-byte][s: s + 1]
	as-integer s - base 				;-- do not count the terminal zero
]

;-- Debugging helper functions --

prin-int: func [i [integer!] return: [integer!] /local s c n][
	;-- modified version of form-signed by Rudolf W. MEIJER (https://gist.github.com/952998)
	;-- used in signal handlers, so dynamic allocation removed to limit interferences

	if zero? i [prin "0" return 0]
	s: "-0000000000"					;-- 11 bytes wide
	if i = -2147483648 [prin "-2147483648" return i]
	n: negative? i
	if n [i: negate i]
	c: 11
	while [i <> 0][
		s/c: #"0" + (i // 10)
		i: i / 10
		c: c - 1
	]
	if n [s/c: #"-" c: c - 1]
	prin s + c
	i
]

prin-hex: func [i [integer!] return: [integer!] /local s c d ret][
	;-- modified version of form-hex by Rudolf W. MEIJER (https://gist.github.com/952998)
	;-- used in signal handlers, so dynamic allocation removed to limit interferences

	if zero? i [prin "0" return i]
	s: "00000000"
	c: 8
	ret: i
	until [
		d: i // 16
		if d > 9 [d: d + 7]				;-- 7 = (#"A" - 1) - #"9"
		s/c: #"0" + d
		i: i >>> 4
		c: c - 1
		zero? c							;-- iterate on all 8 bytes to overwrite previous values
	]
	prin s
	ret
]

Red/System [
	Title:   "Red/System native implementations of basic functions"
	Author:  "Nenad Rakocevic"
	File: 	 %lib-natives.reds
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/dockimbel/Red/blob/master/red-system/runtime/BSL-License.txt
	}
]

allocate:  func [						;-- needs a Red/System native implementation
	size		[integer!]
	return:		[byte-ptr!]
][
	;TBD
]

free: func [							;-- needs a Red/System native implementation
	buffer		[byte-ptr!]
][
	;TBD
]

set-memory: func [						;; fill a memory buffer with the same given byte ;;
	target		[byte-ptr!]				;; pointer to start of the buffer ;;
	filler		[byte!]					;; filler byte ;;
	size		[integer!]				;; size of the buffer to fill ;;
	return:		[byte-ptr!]				;; returns the start of the buffer ;;
][
	unless zero? size [
		until [
			target/1: filler
			target: target + 1
			size: size - 1
			zero? size
		]
	]
	target
]

copy-memory: func [						;; copy a memory buffer to a new region in a safe way ;;
	target		[byte-ptr!]				;; target start address ;;
	source		[byte-ptr!]				;; source start address ;;
	size		[integer!]				;; number of bytes to copy ;;
	return:		[byte-ptr!]				;; returns the target start address ;;
	/local c
][
	unless any [zero? size source = target][
		either source < target [
			until [
				target/size: source/size
				size: size - 1
				zero? size
			]
		][
			c: 0
			until [
				target/c: source/c
				c: c + 1
				size: size - 1
				zero? size
			]
		]
	]
	target
]

length?: func [							;; return the number of characters from a c-string value ;;
	s 		[c-string!]					;; c-string value ;;
	return: [integer!]
	/local base
][
	base: s
	while [s/1 <> null-byte][s: s + 1]
	as-integer s - base 				;-- do not count the terminal zero
]

;-- Debugging helper functions --

prin-int: func [i [integer!] return: [integer!] /local s c n][
	;-- modified version of form-signed by Rudolf W. MEIJER (https://gist.github.com/952998)
	;-- used in signal handlers, so dynamic allocation removed to limit interferences

	if zero? i [prin "0" return 0]
	s: "-2147483648"					;-- 11 bytes wide
	if i = -2147483648 [prin s return i]
	n: negative? i
	if n [i: negate i]
	c: 11
	while [i <> 0][
		s/c: #"0" + (i // 10)
		i: i / 10
		c: c - 1
	]
	if n [s/c: #"-" c: c - 1]
	prin s + c
	i
]

prin-hex: func [i [integer!] return: [integer!] /local s c d ret][
	;-- modified version of form-hex by Rudolf W. MEIJER (https://gist.github.com/952998)
	;-- used in signal handlers, so dynamic allocation removed to limit interferences

	if zero? i [prin "0" return i]
	s: "00000000"
	c: 8
	ret: i
	until [
		d: i // 16
		if d > 9 [d: d + 7]				;-- 7 = (#"A" - 1) - #"9"
		s/c: #"0" + d
		i: i >>> 4
		c: c - 1
		zero? c							;-- iterate on all 8 bytes to overwrite previous values
	]
	prin s
	ret
]


FIX: debug assert failed when create a hash with empty block

Red/System [
	Title:   "Hash! datatype runtime functions"
	Author:  "Qingtian Xie"
	File:	 %hash.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2014-2015 Qingtian Xie. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/red/red/blob/master/BSL-License.txt
	}
]

hash: context [
	verbose: 0

	;--- Actions ---

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

		blk?: no
		switch TYPE_OF(spec) [
			TYPE_INTEGER [
				int: as red-integer! spec
				size: int/value
				if negative? size [fire [TO_ERROR(script out-of-range) spec]]
			]
			TYPE_BLOCK [
				size: block/rs-length? as red-block! spec
				blk?: yes
			]
			default [--NOT_IMPLEMENTED--]
		]

		unless positive? size [size: 1]
		blk: block/make-at as red-block! stack/push* size
		if blk? [
			block/copy as red-block! spec blk null no null
		]
		table: _hashtable/init size blk HASH_TABLE_HASH
		hash: as red-hash! blk
		hash/header: TYPE_HASH							;-- implicit reset of all header flags
		hash/table: table
		hash
	]

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

		string/concatenate-literal buffer "make hash! "
		block/mold as red-block! hash buffer only? all? flat? arg part - 11 indent
	]

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

		blk: as red-block! hash
		_hashtable/clear hash/table blk/head block/rs-length? blk
		block/rs-clear blk
		as red-value! hash
	]

	copy: func [
		hash    	[red-hash!]
		new			[red-block!]
		part-arg	[red-value!]
		deep?		[logic!]
		types		[red-value!]
		return:		[red-series!]
		/local
			size	[integer!]
			table	[node!]
	][
		#if debug? = yes [if verbose > 0 [print-line "hash/copy"]]

		block/copy as red-block! hash new part-arg deep? types
		size: block/rs-length? new
		table: _hashtable/init size new HASH_TABLE_HASH
		hash: as red-hash! new
		hash/header: TYPE_HASH							;-- implicit reset of all header flags
		hash/table: table
		as red-series! hash
	]

	sort: func [
		hash		[red-hash!]
		case?		[logic!]
		skip		[red-integer!]
		comparator	[red-function!]
		part		[red-value!]
		all?		[logic!]
		reverse?	[logic!]
		stable?		[logic!]
		return:		[red-hash!]
		/local
			blk		[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "hash/sort"]]

		blk: as red-block! hash
		block/sort blk case? skip comparator part all? reverse? stable?
		_hashtable/clear hash/table blk/head block/rs-length? blk
		_hashtable/put-all hash/table blk/head 1
		hash
	]

	trim: func [
		hash		[red-hash!]
		head?		[logic!]
		tail?		[logic!]
		auto?		[logic!]
		lines?		[logic!]
		all?		[logic!]
		with-arg	[red-value!]
		return:		[red-hash!]
		/local
			blk		[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "hash/trim"]]

		blk: as red-block! hash
		block/trim blk head? tail? auto? lines? all? with-arg
		_hashtable/clear hash/table blk/head block/rs-length? blk
		_hashtable/put-all hash/table blk/head 1
		hash
	]

	init: does [
		datatype/register [
			TYPE_HASH
			TYPE_BLOCK
			"hash!"
			;-- General actions --
			:make
			null			;random
			null			;reflect
			null			;to
			INHERIT_ACTION	;form
			:mold
			INHERIT_ACTION	;eval-path
			null			;set-path
			INHERIT_ACTION	;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 --
			null			;append
			INHERIT_ACTION	;at
			INHERIT_ACTION	;back
			null			;change
			:clear
			:copy
			INHERIT_ACTION	;find
			INHERIT_ACTION	;head
			INHERIT_ACTION	;head?
			INHERIT_ACTION	;index?
			INHERIT_ACTION	;insert
			INHERIT_ACTION	;length?
			INHERIT_ACTION	;next
			INHERIT_ACTION	;pick
			INHERIT_ACTION	;poke
			null			;put
			INHERIT_ACTION	;remove
			INHERIT_ACTION	;reverse
			INHERIT_ACTION	;select
			:sort
			INHERIT_ACTION	;skip
			INHERIT_ACTION	;swap
			INHERIT_ACTION	;tail
			INHERIT_ACTION	;tail?
			INHERIT_ACTION	;take
			: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:   "Hash! datatype runtime functions"
	Author:  "Qingtian Xie"
	File:	 %hash.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2014-2015 Qingtian Xie. All rights reserved."
	License: {
		Distributed under the Boost Software License, Version 1.0.
		See https://github.com/red/red/blob/master/BSL-License.txt
	}
]

hash: context [
	verbose: 0

	;--- Actions ---

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

		blk?: no
		size: 1
		switch TYPE_OF(spec) [
			TYPE_INTEGER [
				int: as red-integer! spec
				size: int/value
				if negative? size [fire [TO_ERROR(script out-of-range) spec]]
			]
			TYPE_BLOCK [
				size: block/rs-length? as red-block! spec
				blk?: yes
			]
			default [--NOT_IMPLEMENTED--]
		]
		blk: block/make-at as red-block! stack/push* size
		if blk? [
			block/copy as red-block! spec blk null no null
		]
		table: _hashtable/init size blk HASH_TABLE_HASH
		hash: as red-hash! blk
		hash/header: TYPE_HASH							;-- implicit reset of all header flags
		hash/table: table
		hash
	]

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

		string/concatenate-literal buffer "make hash! "
		block/mold as red-block! hash buffer only? all? flat? arg part - 11 indent
	]

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

		blk: as red-block! hash
		_hashtable/clear hash/table blk/head block/rs-length? blk
		block/rs-clear blk
		as red-value! hash
	]

	copy: func [
		hash    	[red-hash!]
		new			[red-block!]
		part-arg	[red-value!]
		deep?		[logic!]
		types		[red-value!]
		return:		[red-series!]
		/local
			size	[integer!]
			table	[node!]
	][
		#if debug? = yes [if verbose > 0 [print-line "hash/copy"]]

		block/copy as red-block! hash new part-arg deep? types
		size: block/rs-length? new
		table: _hashtable/init size new HASH_TABLE_HASH
		hash: as red-hash! new
		hash/header: TYPE_HASH							;-- implicit reset of all header flags
		hash/table: table
		as red-series! hash
	]

	sort: func [
		hash		[red-hash!]
		case?		[logic!]
		skip		[red-integer!]
		comparator	[red-function!]
		part		[red-value!]
		all?		[logic!]
		reverse?	[logic!]
		stable?		[logic!]
		return:		[red-hash!]
		/local
			blk		[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "hash/sort"]]

		blk: as red-block! hash
		block/sort blk case? skip comparator part all? reverse? stable?
		_hashtable/clear hash/table blk/head block/rs-length? blk
		_hashtable/put-all hash/table blk/head 1
		hash
	]

	trim: func [
		hash		[red-hash!]
		head?		[logic!]
		tail?		[logic!]
		auto?		[logic!]
		lines?		[logic!]
		all?		[logic!]
		with-arg	[red-value!]
		return:		[red-hash!]
		/local
			blk		[red-block!]
	][
		#if debug? = yes [if verbose > 0 [print-line "hash/trim"]]

		blk: as red-block! hash
		block/trim blk head? tail? auto? lines? all? with-arg
		_hashtable/clear hash/table blk/head block/rs-length? blk
		_hashtable/put-all hash/table blk/head 1
		hash
	]

	init: does [
		datatype/register [
			TYPE_HASH
			TYPE_BLOCK
			"hash!"
			;-- General actions --
			:make
			null			;random
			null			;reflect
			null			;to
			INHERIT_ACTION	;form
			:mold
			INHERIT_ACTION	;eval-path
			null			;set-path
			INHERIT_ACTION	;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 --
			null			;append
			INHERIT_ACTION	;at
			INHERIT_ACTION	;back
			null			;change
			:clear
			:copy
			INHERIT_ACTION	;find
			INHERIT_ACTION	;head
			INHERIT_ACTION	;head?
			INHERIT_ACTION	;index?
			INHERIT_ACTION	;insert
			INHERIT_ACTION	;length?
			INHERIT_ACTION	;next
			INHERIT_ACTION	;pick
			INHERIT_ACTION	;poke
			null			;put
			INHERIT_ACTION	;remove
			INHERIT_ACTION	;reverse
			INHERIT_ACTION	;select
			:sort
			INHERIT_ACTION	;skip
			INHERIT_ACTION	;swap
			INHERIT_ACTION	;tail
			INHERIT_ACTION	;tail?
			INHERIT_ACTION	;take
			: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
		]
	]
]


Tried to revise the team page to reflect 1.4 release team and contributors past and present.

h1. The Team

CruiseControl.rb has been the product of a lot of hard work from some very bright and committed people.
This page is a small recognition of their efforts.

We appreciate you!

<br/>
h1. Version 1.4 Team:

* *Alexey Verkhovsky* [averkhov at thoughtworks.com]
* "*Jeremy Stell-Smith*":http://onemanswalk.com/ [jeremystellsmith at gmail.com] yahoo:stellsmi
* *Chad Woolley* [thewoolleyman at gmail.com]
* *Sidu Ponnappa* [schonira at thoughtworks.com]
* "*Brian Guthrie*":http://blog.brianguthrie.com [bguthrie at thoughtworks.com]

h1. Contributors:

* *Arthur Tam* (past contributor)
* *Daniel Manges* (growl patch)
* *Danilo Sato* (localization patch)
* *Dmitry Verkhovsky* (jabber plugin)
* *Joe Poon* (past contributor)
* *Peter Zhao* (past contributor)
* *Ricky Lui* (past contributor)
* *Stephen Chu* (past contributor)
* *Brian Takita* (improved RSpec support)
* *Marcel Molina* (improved RSpec support)
* *Jeff Xiong* [gigix1980 at gmail.com] (past contributor)
* *Josh Evnin* (past contributor)
* *Zhang Lin* (past contributor)
* *Rolf Russel* (past iteration manager, has been spotted writing code on more than one occasion)

h1. The Team

CruiseControl.rb has been the product of a lot of hard work from some very bright and committed people.
This page is a small recognition of their efforts.

We appreciate you!

<br/>
h1. Version 1.1 Team :

* *Rolf Russel* (iteration manager, has been spotted writing code on more than one occasion)
* *Alexey Verkhovsky*  (lead) [averkhov at thoughtworks.com]
* "*Jeremy Stell-Smith*":http://onemanswalk.com/ (lead) [jeremystellsmith at gmail.com] yahoo:stellsmi

* *Jeff Xiong* [gigix1980 at gmail.com]
* *Josh Evnin*
* *Zhang Lin*

h1. Contributors:

* *Arthur Tam* (past contributor)
* *Daniel Manges* (growl patch)
* *Danilo Sato* (localization patch)
* *Dmitry Verkhovsky* (jabber plugin)
* *Joe Poon* (past contributor)
* *Peter Zhao* (past contributor)
* *Ricky Lui* (past contributor)
* *Stephen Chu* (past contributor)


FEAT: added preliminary support for HELP, WHAT and SOURCE mezz functions to the console.

Red [
	Title:	"Red console"
	Author: ["Nenad Rakocevic" "Kaj de Vos"]
	File: 	%console.red
	Tabs: 	4
	Rights: "Copyright (C) 2012-2013 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
	}
]

#system-global [
	#either OS = 'Windows [
		#import [
			"kernel32.dll" stdcall [
				AttachConsole: 	 "AttachConsole" [
					processID		[integer!]
					return:			[integer!]
				]
				SetConsoleTitle: "SetConsoleTitleA" [
					title			[c-string!]
					return:			[integer!]
				]
				ReadConsole: 	 "ReadConsoleA" [
					consoleInput	[integer!]
					buffer			[byte-ptr!]
					charsToRead		[integer!]
					numberOfChars	[int-ptr!]
					inputControl	[int-ptr!]
					return:			[integer!]
				]
			]
		]
		line-buffer-size: 16 * 1024
		line-buffer: allocate line-buffer-size
	][
		#switch OS [
			MacOSX [
				#define ReadLine-library "libreadline.dylib"
			]
			#default [
				#define ReadLine-library "libreadline.so.6"
				#define History-library  "libhistory.so.6"
			]
		]
		#import [
			ReadLine-library cdecl [
				read-line: "readline" [  ; Read a line from the console.
					prompt			[c-string!]
					return:			[c-string!]
				]
				rl-bind-key: "rl_bind_key" [
					key				[integer!]
					command			[integer!]
					return:			[integer!]
				]
				rl-insert:	 "rl_insert" [
					count			[integer!]
					key				[integer!]
					return:			[integer!]
				]
			]
			#if OS <> 'MacOSX [
				History-library cdecl [
					add-history: "add_history" [  ; Add line to the history.
						line		[c-string!]
					]
				]
			]
		]

		rl-insert-wrapper: func [
			[cdecl]
			count   [integer!]
			key	    [integer!]
			return: [integer!]
		][
			rl-insert count key
		]

	]
]

#include %help.red

read-argument: routine [
	/local
		args [str-array!]
		str	 [red-string!]
][
	if system/args-count <> 2 [
		SET_RETURN(none-value)
		exit
	]
	args: system/args-list + 1							;-- skip binary filename
	str: simple-io/read-txt args/item
	SET_RETURN(str)
]

init-console: routine [
	str [string!]
	/local
		ret
][
	#either OS = 'Windows [
		;ret: AttachConsole -1
		;if zero? ret [print-line "ReadConsole failed!" halt]

		ret: SetConsoleTitle as c-string! string/rs-head str
		if zero? ret [print-line "SetConsoleTitle failed!" halt]
	][
		rl-bind-key as-integer tab as-integer :rl-insert-wrapper
	]
]

input: routine [
	prompt [string!]
	/local
		len ret str buffer line
][
	#either OS = 'Windows [
		len: 0
		print as c-string! string/rs-head prompt
		ret: ReadConsole stdin line-buffer line-buffer-size :len null
		if zero? ret [print-line "ReadConsole failed!" halt]
		len: len - 1									;-- move at beginning of CRLF sequence
		line-buffer/len: null-byte						;-- overwrite CR with NUL
		str: string/load as c-string! line-buffer len
	][
		line: read-line as c-string! string/rs-head prompt
		if line = null [halt]  ; EOF

		 #if OS <> 'MacOSX [add-history line]

		str: string/load line  1 + length? line
;		free as byte-ptr! line
	]
	SET_RETURN(str)
]

count-delimiters: function [
	buffer	[string!]
	return: [block!]
][
	list: copy [0 0]
	c: none

	foreach c buffer [
		case [
			escaped?	[escaped?: no]
			in-comment? [if c = #"^/" [in-comment?: no]]
			'else [
				switch c [
					#"^^" [escaped?: yes]
					#";"  [if zero? list/2 [in-comment?: yes]]
					#"["  [unless in-string? [list/1: list/1 + 1]]
					#"]"  [unless in-string? [list/1: list/1 - 1]]
					#"{"  [if zero? list/2 [in-string?: yes] list/2: list/2 + 1]
					#"}"  [if 1 = list/2   [in-string?: no]  list/2: list/2 - 1]
				]
			]
		]
	]
	list
]

do-console: function [][
	buffer: make string! 10000
	prompt: red-prompt: "red>> "
	mode:  'mono

	switch-mode: [
		mode: case [
			cnt/1 > 0 ['block]
			cnt/2 > 0 ['string]
			'else 	  [
				prompt: red-prompt
				do eval
				'mono
			]
		]
		prompt: switch mode [
			block  ["[^-"]
			string ["{^-"]
			mono   [red-prompt]
		]
	]

	eval: [
		code: load/all buffer

		unless tail? code [
			set/any 'result do code

			unless unset? :result [
				if 67 = length? result: mold/part :result 67 [	;-- optimized for width = 72
					clear back tail result
					append result "..."
				]
				print ["==" result]
			]
		]
		clear buffer
	]

	while [true][
		unless tail? line: input prompt [
			append buffer line
			cnt: count-delimiters buffer
			append buffer lf							;-- needed for multiline modes

			switch mode [
				block  [if cnt/1 <= 0 [do switch-mode]]
				string [if cnt/2 <= 0 [do switch-mode]]
				mono   [do either any [cnt/1 > 0 cnt/2 > 0][switch-mode][eval]]
			]
		]
	]
]

q: :quit

if script: read-argument [
	script: load script
	either any [
		script/1 <> 'Red
		not block? script/2
	][
		print "*** Error: not a Red program!"
	][
		do skip script 2
	]
	quit
]

init-console "Red Console"

print {
-=== Red Console alpha version ===-
(only ASCII input supported)
}

do-console

Red [
	Title:	"Red console"
	Author: ["Nenad Rakocevic" "Kaj de Vos"]
	File: 	%console.red
	Tabs: 	4
	Rights: "Copyright (C) 2012-2013 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
	}
]

#system-global [
	#either OS = 'Windows [
		#import [
			"kernel32.dll" stdcall [
				AttachConsole: 	 "AttachConsole" [
					processID		[integer!]
					return:			[integer!]
				]
				SetConsoleTitle: "SetConsoleTitleA" [
					title			[c-string!]
					return:			[integer!]
				]
				ReadConsole: 	 "ReadConsoleA" [
					consoleInput	[integer!]
					buffer			[byte-ptr!]
					charsToRead		[integer!]
					numberOfChars	[int-ptr!]
					inputControl	[int-ptr!]
					return:			[integer!]
				]
			]
		]
		line-buffer-size: 16 * 1024
		line-buffer: allocate line-buffer-size
	][
		#switch OS [
			MacOSX [
				#define ReadLine-library "libreadline.dylib"
			]
			#default [
				#define ReadLine-library "libreadline.so.6"
				#define History-library  "libhistory.so.6"
			]
		]
		#import [
			ReadLine-library cdecl [
				read-line: "readline" [  ; Read a line from the console.
					prompt			[c-string!]
					return:			[c-string!]
				]
				rl-bind-key: "rl_bind_key" [
					key				[integer!]
					command			[integer!]
					return:			[integer!]
				]
				rl-insert:	 "rl_insert" [
					count			[integer!]
					key				[integer!]
					return:			[integer!]
				]
			]
			#if OS <> 'MacOSX [
				History-library cdecl [
					add-history: "add_history" [  ; Add line to the history.
						line		[c-string!]
					]
				]
			]
		]

		rl-insert-wrapper: func [
			[cdecl]
			count   [integer!]
			key	    [integer!]
			return: [integer!]
		][
			rl-insert count key
		]

	]
]

read-argument: routine [
	/local
		args [str-array!]
		str	 [red-string!]
][
	if system/args-count <> 2 [
		SET_RETURN(none-value)
		exit
	]
	args: system/args-list + 1							;-- skip binary filename
	str: simple-io/read-txt args/item
	SET_RETURN(str)
]

init-console: routine [
	str [string!]
	/local
		ret
][
	#either OS = 'Windows [
		;ret: AttachConsole -1
		;if zero? ret [print-line "ReadConsole failed!" halt]

		ret: SetConsoleTitle as c-string! string/rs-head str
		if zero? ret [print-line "SetConsoleTitle failed!" halt]
	][
		rl-bind-key as-integer tab as-integer :rl-insert-wrapper
	]
]

input: routine [
	prompt [string!]
	/local
		len ret str buffer line
][
	#either OS = 'Windows [
		len: 0
		print as c-string! string/rs-head prompt
		ret: ReadConsole stdin line-buffer line-buffer-size :len null
		if zero? ret [print-line "ReadConsole failed!" halt]
		len: len - 1									;-- move at beginning of CRLF sequence
		line-buffer/len: null-byte						;-- overwrite CR with NUL
		str: string/load as c-string! line-buffer len
	][
		line: read-line as c-string! string/rs-head prompt
		if line = null [halt]  ; EOF

		 #if OS <> 'MacOSX [add-history line]

		str: string/load line  1 + length? line
;		free as byte-ptr! line
	]
	SET_RETURN(str)
]

count-delimiters: function [
	buffer	[string!]
	return: [block!]
][
	list: copy [0 0]
	c: none

	foreach c buffer [
		case [
			escaped?	[escaped?: no]
			in-comment? [if c = #"^/" [in-comment?: no]]
			'else [
				switch c [
					#"^^" [escaped?: yes]
					#";"  [if zero? list/2 [in-comment?: yes]]
					#"["  [unless in-string? [list/1: list/1 + 1]]
					#"]"  [unless in-string? [list/1: list/1 - 1]]
					#"{"  [if zero? list/2 [in-string?: yes] list/2: list/2 + 1]
					#"}"  [if 1 = list/2   [in-string?: no]  list/2: list/2 - 1]
				]
			]
		]
	]
	list
]

do-console: function [][
	buffer: make string! 10000
	prompt: red-prompt: "red>> "
	mode:  'mono

	switch-mode: [
		mode: case [
			cnt/1 > 0 ['block]
			cnt/2 > 0 ['string]
			'else 	  [
				prompt: red-prompt
				do eval
				'mono
			]
		]
		prompt: switch mode [
			block  ["[^-"]
			string ["{^-"]
			mono   [red-prompt]
		]
	]

	eval: [
		code: load/all buffer

		unless tail? code [
			set/any 'result do code

			unless unset? :result [
				if 67 = length? result: mold/part :result 67 [	;-- optimized for width = 72
					clear back tail result
					append result "..."
				]
				print ["==" result]
			]
		]
		clear buffer
	]

	while [true][
		unless tail? line: input prompt [
			append buffer line
			cnt: count-delimiters buffer
			append buffer lf							;-- needed for multiline modes

			switch mode [
				block  [if cnt/1 <= 0 [do switch-mode]]
				string [if cnt/2 <= 0 [do switch-mode]]
				mono   [do either any [cnt/1 > 0 cnt/2 > 0][switch-mode][eval]]
			]
		]
	]
]

q: :quit

if script: read-argument [
	script: load script
	either any [
		script/1 <> 'Red
		not block? script/2
	][
		print "*** Error: not a Red program!"
	][
		do skip script 2
	]
	quit
]

init-console "Red Console"

print {
-=== Red Console alpha version ===-
(only ASCII input supported)
}

do-console


FIX: issue #672 (Presumable typo in %debug-tools.reds)

Red/System [
	Title:   "Red runtime debugging functions"
	Author:  "Nenad Rakocevic"
	File: 	 %debug-tools.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
	}
]

;-------------------------------------------
;-- Memory stats
;-------------------------------------------
memory-info: func [
	blk		[red-block!]
	verbose [integer!]						;-- stat verbosity level (1, 2 or 3)
	/local
		n-frame s-frame b-frame free-nodes base list nodes series bigs
][
	assert all [1 <= verbose verbose <= 3]

;-- Node frames stats --
	nodes: block/make-in blk 8
	n-frame: memory/n-head

	while [n-frame <> null][
		if verbose >= 2 [
			free-nodes: (as-integer (n-frame/top - n-frame/bottom) + 1) / 4
			list: block/make-in nodes 8
			integer/load-in list n-frame/nodes - free-nodes
			integer/load-in list free-nodes
			integer/load-in list n-frame/nodes
		]
		n-frame: n-frame/next
	]

;-- Series frames stats --
	series: block/make-in blk 8
	s-frame: memory/s-head

	while [s-frame <> null][
		if verbose >= 2 [
			base: (as byte-ptr! s-frame) + size? series-frame!
			list: block/make-in series 8
			integer/load-in list as-integer s-frame/tail - as byte-ptr! s-frame/heap
			integer/load-in list as-integer (as byte-ptr! s-frame/heap) - base
			integer/load-in list  as-integer s-frame/tail - base
		]
		s-frame: s-frame/next
	]

;-- Big frames stats --
	bigs: block/make-in blk 8
	b-frame: memory/b-head

	while [b-frame <> null][
		if verbose >= 2 [
			integer/load-in bigs b-frame/size
		]
		b-frame: b-frame/next
	]
]

;===========================================
;== Debugging functions
;===========================================

#if debug? = yes [

	dump-globals: func [
		/local ctx sym-table val-table len s symbol value w sym val syms i
	][
		ctx: TO_CTX(global-ctx)
		sym-table: ctx/symbols
		val-table: ctx/values

		s: as series! sym-table/value
		len: (as-integer s/tail - s/offset) >> 4
		symbol: s/offset

		s: as series! val-table/value
		value: s/offset

		s: GET_BUFFER(symbols)
		syms: as red-symbol! s/offset

		print-line "Global Context"
		print-line "--------------"
		i: 0
		until [
			w: as red-word! symbol + i
			sym: syms + w/symbol - 1
			val: value + i
			print-line [i ", " w/symbol "/" sym/alias ": " sym/cache "^- : " TYPE_OF(val)]
			i: i + 1
			i + 1 = len
		]
	]

	dump-symbols: func [
		/local tail s i sym
	][
		s: GET_BUFFER(symbols)
		sym: as red-symbol! s/offset
		tail: as red-symbol! s/tail

		print-line "Symbol Table"
		print-line "--------------"
		i: 0
		until [
			print-line [i "/" sym/alias ": " sym/cache]
			sym: sym + 1
			i: i + 1
			sym = tail
		]
	]

	;-------------------------------------------
	;-- Print usage stats about a given frame
	;-------------------------------------------
	frame-stats: func [
		free	[integer!]
		used	[integer!]
		total	[integer!]
		/local percent
	][
		assert free + used = total
		percent: 100 * used / total
		if all [not zero? used zero? percent][percent: 1]

		print [
			"used = " used "/" total " ("  percent "%), "
			"free = " free "/" total " (" 100 - percent "%)" lf
		]
	]

	;-------------------------------------------
	;-- List series buffer allocated in a given series frame
	;-------------------------------------------
	list-series-buffers: func [
		frame	[series-frame!]
		/local series alt? size block count head tail
	][
		count: 1
		series: as series-buffer! (as byte-ptr! frame) + size? series-frame!
		until [
			head: as-integer ((as byte-ptr! series/offset) - (as byte-ptr! series) - size? series-buffer!)
			tail: as-integer ((as byte-ptr! series/tail) - (as byte-ptr! series) - size? series-buffer!)
			print [
				" - " series
				": size = "	series/size
				", offset pos = " head ", tail pos = " tail
				"    "
			]
			if series/flags and flag-ins-head <> 0 [print "H"]
			if series/flags and flag-ins-tail <> 0 [print "T"]
			print lf
			count: count + 1

			series: as series-buffer! (as byte-ptr! series) + series/size + size? series-buffer!
			series >= frame/heap
		]
		assert series = frame/heap
	]

	;-------------------------------------------
	;-- Displays total frames count
	;-------------------------------------------
	print-frames-count: func [count [integer!] /local s][
		s: either count > 1 ["s^/"][newline]
		print ["^/    " count " frame" s lf]
	]

	;-------------------------------------------
	;-- Dump memory statistics on screen
	;-------------------------------------------
	memory-stats: func [
		verbose [integer!]						;-- stat verbosity level (1, 2 or 3)
		/local count n-frame s-frame b-frame free-nodes base
	][
		assert all [1 <= verbose verbose <= 3]

		print [lf "====== Red Memory Stats ======" lf]

	;-- Node frames stats --
		count: 0
		n-frame: memory/n-head

		print [lf "-- Node frames --" lf]
		while [n-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				free-nodes: (as-integer (n-frame/top - n-frame/bottom) + 1) / 4
				frame-stats
					free-nodes
					n-frame/nodes - free-nodes
					n-frame/nodes
			]
			count: count + 1
			n-frame: n-frame/next
		]
		print-frames-count count

	;-- Series frames stats --
		count: 0
		s-frame: memory/s-head

		print ["-- Series frames --" lf]
		while [s-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				base: (as byte-ptr! s-frame) + size? series-frame!
				frame-stats
					as-integer s-frame/tail - as byte-ptr! s-frame/heap
					as-integer (as byte-ptr! s-frame/heap) - base
					as-integer s-frame/tail - base
				if verbose >= 3 [
					list-series-buffers s-frame
				]
			]
			count: count + 1
			s-frame: s-frame/next
		]
		print-frames-count count

	;-- Big frames stats --
		count: 0
		b-frame: memory/b-head

		print ["-- Big frames --" lf]
		while [b-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				prin-int b-frame/size
			]
			count: count + 1
			b-frame: b-frame/next
		]
		print-frames-count count

		print [
			"Total memory used: " memory/total " bytes" lf
			"==============================" lf
		]
	]

	;-------------------------------------------
	;-- Dump memory layout of a given series frame
	;-------------------------------------------
	dump-series-frame: func [
		frame	[series-frame!]
		/local series alt? size block
	][
		series: as series-buffer! (as byte-ptr! frame) + size? series-frame!

		print [lf "=== Series layout for frame: <" frame "h>" lf]

		alt?: no
		until [
			block: either zero? (series/flags and series-in-use) [
				"."
			][
				alt?: not alt?
				either alt? ["x"]["o"]
			]

			size: series/size / 16
			until [
				print block
				size: size - 1
				zero? size
			]

			series: as series-buffer! (as byte-ptr! series) + series/size + size? series-buffer!
			series >= frame/heap
		]
		assert series = frame/heap
		print lf
	]

]

Red/System [
	Title:   "Red runtime debugging functions"
	Author:  "Nenad Rakocevic"
	File: 	 %debug-tools.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
	}
]

;-------------------------------------------
;-- Memory stats
;-------------------------------------------
memory-info: func [
	blk		[red-block!]
	verbose [integer!]						;-- stat verbosity level (1, 2 or 3)
	/local
		n-frame s-frame b-frame free-nodes base list nodes series bigs
][
	assert all [1 <= verbose verbose <= 3]

;-- Node frames stats --
	nodes: block/make-in blk 8
	n-frame: memory/n-head

	while [n-frame <> null][
		if verbose >= 2 [
			free-nodes: (as-integer (n-frame/top - n-frame/bottom) + 1) / 4
			list: block/make-in nodes 8
			integer/load-in list n-frame/nodes - free-nodes
			integer/load-in list free-nodes
			integer/load-in list n-frame/nodes
		]
		n-frame: n-frame/next
	]

;-- Series frames stats --
	series: block/make-in blk 8
	s-frame: memory/s-head

	while [s-frame <> null][
		if verbose >= 2 [
			base: (as byte-ptr! s-frame) + size? series-frame!
			list: block/make-in series 8
			integer/load-in list as-integer s-frame/tail - as byte-ptr! s-frame/heap
			integer/load-in list as-integer (as byte-ptr! s-frame/heap) - base
			integer/load-in list  as-integer s-frame/tail - base
		]
		s-frame: s-frame/next
	]

;-- Big frames stats --
	bigs: block/make-in blk 8
	b-frame: memory/b-head

	while [b-frame <> null][
		if verbose >= 2 [
			integer/load-in bigs b-frame/size
		]
		b-frame: b-frame/next
	]
]

;===========================================
;== Debugging functions
;===========================================

#if debug? = yes [

	dump-globals: func [
		/local ctx sym-table val-table len s symbol value w sym val syms i
	][
		ctx: TO_CTX(global-ctx)
		sym-table: ctx/symbols
		val-table: ctx/values

		s: as series! sym-table/value
		len: (as-integer s/tail - s/offset) >> 4
		symbol: s/offset

		s: as series! val-table/value
		value: s/offset

		s: GET_BUFFER(symbols)
		syms: as red-symbol! s/offset

		print-line "Global Context"
		print-line "--------------"
		i: 0
		until [
			w: as red-word! symbol + i
			sym: syms + w/symbol - 1
			val: value + i
			print-line [i ", " w/symbol "/" sym/alias ": " sym/cache "^- : " TYPE_OF(val)]
			i: i + 1
			i + 1 = len
		]
	]

	dump-symbols: func [
		/local tail s i qym
	][
		s: GET_BUFFER(symbols)
		sym: as red-symbol! s/offset
		tail: as red-symbol! s/tail

		print-line "Symbol Table"
		print-line "--------------"
		i: 0
		until [
			print-line [i "/" sym/alias ": " sym/cache]
			sym: sym + 1
			i: i + 1
			sym = tail
		]
	]

	;-------------------------------------------
	;-- Print usage stats about a given frame
	;-------------------------------------------
	frame-stats: func [
		free	[integer!]
		used	[integer!]
		total	[integer!]
		/local percent
	][
		assert free + used = total
		percent: 100 * used / total
		if all [not zero? used zero? percent][percent: 1]

		print [
			"used = " used "/" total " ("  percent "%), "
			"free = " free "/" total " (" 100 - percent "%)" lf
		]
	]

	;-------------------------------------------
	;-- List series buffer allocated in a given series frame
	;-------------------------------------------
	list-series-buffers: func [
		frame	[series-frame!]
		/local series alt? size block count head tail
	][
		count: 1
		series: as series-buffer! (as byte-ptr! frame) + size? series-frame!
		until [
			head: as-integer ((as byte-ptr! series/offset) - (as byte-ptr! series) - size? series-buffer!)
			tail: as-integer ((as byte-ptr! series/tail) - (as byte-ptr! series) - size? series-buffer!)
			print [
				" - " series
				": size = "	series/size
				", offset pos = " head ", tail pos = " tail
				"    "
			]
			if series/flags and flag-ins-head <> 0 [print "H"]
			if series/flags and flag-ins-tail <> 0 [print "T"]
			print lf
			count: count + 1

			series: as series-buffer! (as byte-ptr! series) + series/size + size? series-buffer!
			series >= frame/heap
		]
		assert series = frame/heap
	]

	;-------------------------------------------
	;-- Displays total frames count
	;-------------------------------------------
	print-frames-count: func [count [integer!] /local s][
		s: either count > 1 ["s^/"][newline]
		print ["^/    " count " frame" s lf]
	]

	;-------------------------------------------
	;-- Dump memory statistics on screen
	;-------------------------------------------
	memory-stats: func [
		verbose [integer!]						;-- stat verbosity level (1, 2 or 3)
		/local count n-frame s-frame b-frame free-nodes base
	][
		assert all [1 <= verbose verbose <= 3]

		print [lf "====== Red Memory Stats ======" lf]

	;-- Node frames stats --
		count: 0
		n-frame: memory/n-head

		print [lf "-- Node frames --" lf]
		while [n-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				free-nodes: (as-integer (n-frame/top - n-frame/bottom) + 1) / 4
				frame-stats
					free-nodes
					n-frame/nodes - free-nodes
					n-frame/nodes
			]
			count: count + 1
			n-frame: n-frame/next
		]
		print-frames-count count

	;-- Series frames stats --
		count: 0
		s-frame: memory/s-head

		print ["-- Series frames --" lf]
		while [s-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				base: (as byte-ptr! s-frame) + size? series-frame!
				frame-stats
					as-integer s-frame/tail - as byte-ptr! s-frame/heap
					as-integer (as byte-ptr! s-frame/heap) - base
					as-integer s-frame/tail - base
				if verbose >= 3 [
					list-series-buffers s-frame
				]
			]
			count: count + 1
			s-frame: s-frame/next
		]
		print-frames-count count

	;-- Big frames stats --
		count: 0
		b-frame: memory/b-head

		print ["-- Big frames --" lf]
		while [b-frame <> null][
			if verbose >= 2 [
				print ["#" count + 1 ": "]
				prin-int b-frame/size
			]
			count: count + 1
			b-frame: b-frame/next
		]
		print-frames-count count

		print [
			"Total memory used: " memory/total " bytes" lf
			"==============================" lf
		]
	]

	;-------------------------------------------
	;-- Dump memory layout of a given series frame
	;-------------------------------------------
	dump-series-frame: func [
		frame	[series-frame!]
		/local series alt? size block
	][
		series: as series-buffer! (as byte-ptr! frame) + size? series-frame!

		print [lf "=== Series layout for frame: <" frame "h>" lf]

		alt?: no
		until [
			block: either zero? (series/flags and series-in-use) [
				"."
			][
				alt?: not alt?
				either alt? ["x"]["o"]
			]

			size: series/size / 16
			until [
				print block
				size: size - 1
				zero? size
			]

			series: as series-buffer! (as byte-ptr! series) + series/size + size? series-buffer!
			series >= frame/heap
		]
		assert series = frame/heap
		print lf
	]

]