r304: How to contribute - done

r304: How to contribute - done

<% @sidebar = "sidebar_contributing" %>

h1. Contributing

Contributing to CruiseControl.rb boosts your self-esteem, improves your karma, looks good on your CV and generally
makes the world a happier place.

You can help in four different ways:

* report bugs
* create and publish your own plugins
* fix bugs and submit patches
* improve documentation

h2. Report bugs

CruiseControl.rb uses a public "JIRA bug tracker":http://jira.public.thoughtworks.org/browse/CCRB to keep track of bugs,
patches, ideas and development stories.

Before you can submit a bug, you need to
"create a JIRA account":http://jira.public.thoughtworks.org/secure/Signup!default.jspa for yourself. This way we protect
the tracker against spam and make sure that we can get in touch with you if we have questions (or answers).

Please try to be as specific as possible about the symptoms and likely root causes of the problem, include
screenshots, stack traces, quotes from log files or any other relevant information. Do not neglect
"reading the fine manual":manual.html, and consulting the "troubleshooting guide":troubleshooting.html
for some useful debugging / evidence gathering techniques.

Also, please try to make sure that the problem is in CruiseControl.rb, not in your build or CI configuration. It can be
quite embarrassing to go through a long chain of emails, and learn at the end of it that it was your problem and you
could have easily figured it out yourself.

h2. Create plugins

CruiseControl.rb design philosophy can be summarized as "be simple, and people will come to you". Of course, many
an open-source project started this way, and ended up as a truckload of half-heartedly implemented features. We have no
intention whatsoever to fall into that trap.

This is why CruiseControl is trying to satisfy the basic needs of its primary audience (which is small to medium size
Ruby or Rails projects), while providing enough opportunity for extending and hacking the tool without affecting the
sweet simplicity of the core codebase.

Ruby, of course, is an interpreted language with open classes. You can do practically anything you want, but remember:
with great powers come great dangers. In our case, the danger is that the next version of CruiseControl.rb may
simply be incompatible with your black belt hackery. To avoid such a scenario, you better constrain yourself to
interface points that are designed for pluggability.

CruiseControl.rb has a few of these.

h3. Dashboard plugins

Dashboard is a regular Rails application, that can be extended through the regular
Rails
"plugins":http://www.agilewebdevelopment.com/plugins/index
"infrastructure.":http://www.tutorialized.com/tutorial/HOWTO-Make-a-Rails-Plugin-From-Scratch/19055
"Enough said.":http://nubyonrails.com/articles/2006/05/04/the-complete-guide-to-rails-plugins-part-i

h3. Builder plugins

While checking source control for new revisions, building, or handling errors, a builder generates events. You can
write a listener for those events.

To know the types of events a builder sends to its listeners, look at implementation and usages of
Project#notify() method.

For an example of a working plugin, look at builder_plugins/installed/email_notifier.rb or
builder_plugins/available/jabber_notifier. Note that a plugin can be implemented as a single file, or a
directory (containing init.rb). Either way, the file or directory name should match the class name of the listener
class, and the plugin should be placed in builder_plugins/installed directory.

It would be good to have more documentation here, as well as some guarantees about published API for plugins, but it's
too early to make such commitments. Let's build some great plugins, and see what kind of API evolves in the process.
It's a fair bet that build_finished, build_fixed and build_broken will always be there, have access to
Build and Project instances, and know location of the build artifacts directory for the build in question.

h3. Custom Rake tasks

Surely, if there is a CI tool for Ruby, its capabilities can be greatly enhanced by writing cool Rake tasks and
sharing them with the world to.

For example, how about deploying an app to another box via Capistrano, running a battery of Selenium tests against it,
then pulling back test results and placing them in CC_BUILD_ARTIFACTS directory?

Or perhaps a much simpler task that is invoked in the end of a successful unit test build, and creates a "build now"
request for the Big Bang Selenium build described above?

h3. Custom schedulers

Scheduler is an object responsible for telling a Project when to build itself.
At the moment, we only have one kind of a scheduler: a PollingScheduler, which simply tells the project every so often
to check if source control has new revisions. You can write your own scheduler and inject it into the project through
a configuration file: project.scheduler = AstrologyAwareScheduler.new(current_phase_of_the_moon)

h2. Submit patches

We absolutely love receiving bug reports. Who doesn't, after all? But what can make us really happy is a bug
report coming with a patch that fixes the bug and adds unit tests to prevent it from ever happening again.
Contributing a well packaged patch that is accepted into the codebase will forever put your name into
CruiseControl.rb Eternal Hall of Fame, aka the Contributors section of README.

Official Standard Procedure for the Submission of Patches is hereby defined as follows:

1. Check out the latest source from Subversion repository: svn co svn://.......

2. Run the build, make sure that it passes: rake

3. Make changes to the source. Don't forget the unit tests.

4. Run the build again, make sure that it still passes.

p(hint). Besides, your tests should not leave any by-products in the file system. If you need to create a file in your
         test, use in_sandbox() or with_sandbox_project() test helpers.

5. Check that Subversion is fully aware of files you added/deleted/renamed : svn stat

6. Create a patch: svn diff > patch_to_fix_global_warming.diff

7. Login to JIRA

8. Create a new issue, prefix the summary with the word [PATCH].

9. Keep in touch by monitoring the issue. Think about joining the cruisecontrolrb-developers mailing list.

h2. Improve documentation

Believe it or not, but we value contributions to end user documentation as much as (if not more than) we value patches.

Documentation for CruiseControl.rb is included in the release package, as files under
the [cruise]/app/views/documentation directory. When you connect to CruiseControl.rb dashboard running on your computer
and click the Documentation link in the top right corner, its the content of those files that you see.

Packaging documentation with release makes sure that you are always looking at documentation for the same version
that you are running. It also makes it easy to submit documentation patches. Simply follow the aforementioned
Procedure for source code patches.

The *.red files are written in a mixture of "Textile":http://hobix.com/textile and HTML markup. The best way to edit
these files is to run CruiseControl.rb dashboard from your local checked out copy of the trunk, in development mode:

./cruise start -e development.

Any change that you make to a documentation file can be seen in the
browser as soon as you hit the Refresh button.

h2. Copyright considerarions

CruiseControl.rb is a professional open-source product developed by "ThoughtWorks":http://www.thoughtworks.com.
ThoughtWorks is an IT consultancy, and we build CruiseControl.rb primarily because our own project
teams need such a tool (these days, we do a lot of Ruby work).

It is released to the rest of the world under a free open-source "license":license.html. However, ThoughtWorks wants
to have copyright on the entire codebase. So, if you contribute code to CruiseControl.rb, and you don't work for
ThoughtWorks (by the way, is there any good reason why you don't?), we may ask you to grant copyright on your code
to us. This is not some sort of evil world domination scheme, just a legal precaution. Apache Software Foundation,
in fact, does "something quite similar":http://www.apache.org/licenses/icla.txt.

<% @sidebar = "sidebar_contributing" %>

h1. Contributing

Contributing to CruiseControl.rb improves your karma, looks good on your CV and generally makes the world a better
place.

There are four ways you can help:
* report bugs
* create and publish your own plugins
* fix bugs and submit patches
* improve documentation

h2. Report bugs

CruiseControl.rb uses a public "JIRA bug tracker":http://jira.public.thoughtworks.org/browse/CCRB to keep track of bugs,
patches, ideas and development stories.

Before you can submit a bug, you need to
"create an account":http://jira.public.thoughtworks.org/secure/Signup!default.jspa.

Please try to be as specific as possible about the symptoms and possible root causes of the problem, include
screenshots, stack traces, quotes from log files or any other relevant information.

Also, please try to make sure that the problem is in CruiseControl.rb, not in your build or CI configuration. It can be
quite embarrassing to go through a long chain of emails, and learn at the end of it that it was your problem and you
could have easily figured it out yourself.

Please, do "read the fine manual":manual.html, and do not neglect to consult the
"troubleshooting guide":troubleshooting.html for some useful debugging techniques.

h2. Create plugins

TODO: write me

h2. Submit patches

We absolutely love receiving bug reports. After all, who doesn't? What can make us really ecstatic, however, is a bug
report coming with a patch that fixes the bug and adds unit tests to prevent it from ever happening again.
Contributing a well packaged patch that is accepted into the codebase will forever put your name into
CruiseControl.rb Hall of Fame, aka the Contributors section of README.

TODO: finish me

h2. Improve documentation

TODO: write me


TESTS: added a test for testing NULL as a return value from a function

Red/System [
	Title:   "Red/System null test script"
	Author:  "Nenad Rakocevic"
	File: 	 %null-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~~~ "null"

===start-group=== "null first class tests"

	nt-struct: struct [a [pointer! [integer!]]]

	nt-foo: func [
		p [pointer! [integer!]]
		return: [pointer! [integer!]]
	][
		p
	]
	foo-null: func [return: [pointer! [integer!]]][null]

	nt-p: pointer [integer!]
	nt-p: null
	nt-q: struct [a [integer!]]
	nt-r: nt-foo null
	nt-struct/a: null

	--test-- "null-1"  --assert nt-p = null
	--test-- "null-2"  --assert null = nt-p
	--test-- "null-3"  --assert nt-p + 1 <> null
	--test-- "null-4"  --assert nt-q <> null
	--test-- "null-5"  --assert nt-p = nt-foo null
	--test-- "null-6"  --assert nt-r = null
	--test-- "null-7"  --assert nt-p = nt-foo null
	--test-- "null-8"  --assert nt-struct/a = null
	--test-- "null-9"  --assert null = nt-struct/a
	--test-- "null-10" --assert nt-struct/a = null
	--test-- "null-11" --assert null = foo-null

===end-group===

~~~end-file~~~

Red/System [
	Title:   "Red/System null test script"
	Author:  "Nenad Rakocevic"
	File: 	 %null-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~~~ "null"

===start-group=== "null first class tests"

	nt-struct: struct [a [pointer! [integer!]]]

	nt-foo: func [
		p [pointer! [integer!]]
		return: [pointer! [integer!]]
	][
		p
	]
	nt-p: pointer [integer!]
	nt-p: null
	nt-q: struct [a [integer!]]
	nt-r: nt-foo null
	nt-struct/a: null

	--test-- "null-1"  --assert nt-p = null
	--test-- "null-2"  --assert null = nt-p
	--test-- "null-3"  --assert nt-p + 1 <> null
	--test-- "null-4"  --assert nt-q <> null
	--test-- "null-5"  --assert nt-p = nt-foo null
	--test-- "null-6"  --assert nt-r = null
	--test-- "null-7"  --assert nt-p = nt-foo null
	--test-- "null-8"  --assert nt-struct/a = null
	--test-- "null-9"  --assert null = nt-struct/a
	--test-- "null-10" --assert nt-struct/a = null

===end-group===

~~~end-file~~~


FIX: crashing tests blk-sk39 and str-sk40. FEAT: minor code factorization.

Red/System [
	Title:   "PARSE dialect interpreter"
	Author:  "Nenad Rakocevic"
	File: 	 %parse.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-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
	}
]

parser: context [
	verbose: 0

	series: as red-block! 0
	rules:  as red-block! 0

	#define PARSE_PUSH_POSITIONS [
		p: as positions! ALLOC_TAIL(rules)
		p/header: TYPE_TRIPLE
		p/rule:	  (as-integer cmd - block/rs-head rule) >> 4	;-- save cmd position
		p/input:  input/head									;-- save input position
	]

	#define PARSE_SET_INPUT_LENGTH(word) [
		type: TYPE_OF(input)
		word: either any [								;TBD: replace with ANY_STRING?
			type = TYPE_STRING
			type = TYPE_FILE
		][
			string/rs-length? as red-string! input
		][
			block/rs-length? input
		]
	]

	#define PARSE_PICK_INPUT [
		type: TYPE_OF(input)
		either any [		;TBD: replace with ANY_STRING
			type = TYPE_STRING
			type = TYPE_FILE
		][
			char: as red-char! value
			char/header: TYPE_CHAR
			char/value: string/rs-abs-at as red-string! input p/input
		][
			value: block/rs-abs-at input p/input
		]
	]

	#enum states! [
		ST_PUSH_BLOCK
		ST_POP_BLOCK
		ST_PUSH_RULE
		ST_POP_RULE
		ST_CHECK_PENDING
		ST_DO_ACTION
		ST_NEXT_INPUT
		ST_NEXT_ACTION
		ST_MATCH
		ST_MATCH_RULE
		ST_FIND_ALTERN
		ST_WORD
		ST_END
		ST_EXIT
	]

	#enum rule-flags! [									;-- negative values to not collide with t/state counter
		R_NONE:		  -1
		R_TO:		  -2
		R_THRU:		  -3
		R_COPY:		  -4
		R_SET:		  -5
		R_NOT:		  -6
		R_INTO:		  -7
		R_THEN:		  -8
		R_REMOVE:	  -9
		R_INSERT:	  -10
		R_WHILE:	  -11
		R_COLLECT:	  -12
		R_KEEP:		  -13
		R_KEEP_PAREN: -14
	]

	triple!: alias struct! [
		header [integer!]
		min	   [integer!]
		max	   [integer!]
		state  [integer!]
	]

	positions!: alias struct! [
		header [integer!]
		rule   [integer!]
		input  [integer!]
		pad    [integer!]
	]

	#if debug? = yes [
		print-state: func [s [integer!]][
			print "state: "
			print-line switch s [
				ST_PUSH_BLOCK	 ["ST_PUSH_BLOCK"]
				ST_POP_BLOCK	 ["ST_POP_BLOCK"]
				ST_PUSH_RULE	 ["ST_PUSH_RULE"]
				ST_POP_RULE	 	 ["ST_POP_RULE"]
				ST_CHECK_PENDING ["ST_CHECK_PENDING"]
				ST_DO_ACTION	 ["ST_DO_ACTION"]
				ST_NEXT_INPUT	 ["ST_NEXT_INPUT"]
				ST_NEXT_ACTION	 ["ST_NEXT_ACTION"]
				ST_MATCH		 ["ST_MATCH"]
				ST_MATCH_RULE	 ["ST_MATCH_RULE"]
				ST_FIND_ALTERN	 ["ST_FIND_ALTERN"]
				ST_WORD			 ["ST_WORD"]
				ST_END			 ["ST_END"]
				ST_EXIT			 ["ST_EXIT"]
			]
		]
	]

	advance: func [
		str		[red-string!]
		value	[red-value!]							;-- char! or string! value
		return:	[logic!]
		/local
			end? [logic!]
			type [integer!]
	][
		type: TYPE_OF(value)
		end?: either any [type = TYPE_CHAR type = TYPE_BITSET][
			string/rs-next str
		][
			assert TYPE_OF(value) = TYPE_STRING
			string/rs-skip str string/rs-length? as red-string! value
		]
		end?
	]

	find-altern: func [									;-- search for next '| symbol
		rule	[red-block!]
		pos		[red-value!]
		return: [integer!]								;-- >= 0 found, -1 not found
		/local
			head  [red-value!]
			tail  [red-value!]
			value [red-value!]
			w	  [red-word!]
	][
		s: GET_BUFFER(rule)
		head:  s/offset + ((as-integer pos - s/offset) >> 4)
		tail:  s/tail
		value: head

		while [value < tail][
			if TYPE_OF(value) = TYPE_WORD [
				w: as red-word! value
				if w/symbol = words/pipe [
					return ((as-integer value - head) >> 4)
				]
			]
			value: value + 1
		]
		-1
	]

	adjust-input-index: func [
		input	[red-series!]
		pos		[positions!]
		base    [integer!]
		offset  [integer!]
		return: [logic!]
	][
		input/head: input/head + base + offset
		pos/input: either zero? input/head [0][input/head - base]
		yes
	]

	find-token?: func [									;-- optimized fast token lookup
		rules	[red-block!]							;-- (could be optimized even further)
		input	[red-series!]
		token	[red-value!]
		case?	[logic!]
		return: [logic!]
		/local
			pos*   [positions!]
			head   [red-value!]
			tail   [red-value!]
			value  [red-value!]
			char   [red-char!]
			bits   [red-bitset!]
			s	   [series!]
			p	   [byte-ptr!]
			phead  [byte-ptr!]
			ptail  [byte-ptr!]
			pbits  [byte-ptr!]
			pos    [byte-ptr!]
			p4	   [int-ptr!]
			cp	   [integer!]
			size   [integer!]
			unit   [integer!]
			type   [integer!]
			not?   [logic!]
			match? [logic!]
	][
		s: GET_BUFFER(rules)
		pos*: as positions! s/tail - 2

		type: TYPE_OF(input)
		either any [									;TBD: replace with ANY_STRING + TYPE_BINARY
			type = TYPE_STRING
			type = TYPE_FILE
			type = TYPE_BINARY
		][
			switch TYPE_OF(token) [
				TYPE_BITSET [
					s: 	   GET_BUFFER(input)
					unit:  GET_UNIT(s)
					phead: (as byte-ptr! s/offset) + (input/head << (unit >> 1))
					ptail: as byte-ptr! s/tail
					p: 	   phead

					bits:  as red-bitset! token
					s:	   GET_BUFFER(bits)
					pbits: as byte-ptr! s/offset
					not?:  FLAG_NOT?(s)
					size:  s/size << 3

					until [
						cp: switch unit [
							Latin1 [as-integer p/value]
							UCS-2  [(as-integer p/2) << 8 + p/1]
							UCS-4  [p4: as int-ptr! p p4/value]
						]
						either size < cp [
							match?: not?				;-- virtual bit
						][
							BS_TEST_BIT(pbits cp match?)
						]
						if match? [
							return adjust-input-index input pos* 1 ((as-integer p - phead) >> (unit >> 1))
						]
						p: p + unit
						p = ptail
					]
				]
				TYPE_STRING
				TYPE_FILE
				TYPE_BINARY [
					size: string/rs-length? as red-string! token
					if (string/rs-length? as red-string! input) < size [return no]

					s: GET_BUFFER(input)
					unit:  (GET_UNIT(s) >> 1)
					phead: as byte-ptr! s/offset
					ptail: as byte-ptr! s/tail

					until [
						if string/equal? as red-string! input as red-string! token COMP_EQUAL yes [
							return adjust-input-index input pos* size 0
						]
						input/head: input/head + 1
						phead + (input/head + size << unit) > ptail
					]
				]
				TYPE_CHAR [
					char: as red-char! token
					cp: char/value

					s: GET_BUFFER(input)
					unit: GET_UNIT(s)
					phead: (as byte-ptr! s/offset) + (input/head << (unit >> 1))
					ptail: as byte-ptr! s/tail
					p: phead

					switch unit [
						Latin1 [
							while [p < ptail][
								if p/value = as-byte cp [
									return adjust-input-index input pos* 1 (as-integer p - phead)
								]
								p: p + 1
							]
						]
						UCS-2 [
							while [p < ptail][
								if (as-integer p/2) << 8 + p/1 = cp [
									return adjust-input-index input pos* 1 ((as-integer p - phead) >> 1)
								]
								p: p + 2
							]
						]
						UCS-4 [
							p4: as int-ptr! p
							while [p4 < as int-ptr! ptail][
								if p4/value = cp [
									return adjust-input-index input pos* 1 ((as-integer p4 - phead) >> 2)
								]
								p4: p4 + 1
							]
						]
					]
				]
				default [
					print-line "*** Parse Error: invalid literal value to match on string"
				]
			]
		][
			head:  block/rs-head input
			tail:  block/rs-tail input
			value: head

			while [value < tail][
				if actions/compare value token COMP_EQUAL [
					return adjust-input-index input pos* 1 ((as-integer value - head) >> 4)
				]
				value: value + 1
			]
		]
		no
	]

	loop-bitset: func [									;-- optimized bitset matching loop
		input	[red-series!]
		bits	[red-bitset!]
		min		[integer!]
		max		[integer!]
		counter [int-ptr!]
		return: [logic!]
		/local
			s	   [series!]
			unit   [integer!]
			p	   [byte-ptr!]
			phead  [byte-ptr!]
			ptail  [byte-ptr!]
			pbits  [byte-ptr!]
			pos    [byte-ptr!]
			p4	   [int-ptr!]
			cp	   [integer!]
			cnt	   [integer!]
			size   [integer!]
			not?   [logic!]
			max?   [logic!]
			match? [logic!]
	][
		s:	   GET_BUFFER(input)
		unit:  GET_UNIT(s)
		phead: (as byte-ptr! s/offset) + (input/head << (unit >> 1))
		ptail: as byte-ptr! s/tail
		p:	   phead

		s:	   GET_BUFFER(bits)
		pbits: as byte-ptr! s/offset
		not?:  FLAG_NOT?(s)
		size:  s/size << 3

		cnt: 	0
		match?: yes
		max?:	max <> R_NONE

		until [
			cp: switch unit [
				Latin1 [as-integer p/value]
				UCS-2  [(as-integer p/2) << 8 + p/1]
				UCS-4  [p4: as int-ptr! p p4/value]
			]
			either size < cp [							;-- virtual bit
				match?: not?
			][
				BS_TEST_BIT(pbits cp match?)
			]
			if match? [
				p: p + unit
				cnt: cnt + 1
			]
			any [
				not match?
				p = ptail
				all [max? cnt >= max]
			]
		]
		input/head: input/head + ((as-integer p - phead) >> (unit >> 1))
		counter/value: cnt

		either not max? [min <= cnt][all [min <= cnt cnt <= max]]
	]

	loop-token: func [									;-- fast literal matching loop
		input	[red-series!]
		token	[red-value!]
		min		[integer!]
		max		[integer!]
		counter [int-ptr!]
		case?	[logic!]
		return: [logic!]
		/local
			len	   [integer!]
			cnt	   [integer!]
			type   [integer!]
			match? [logic!]
			end?   [logic!]
			s	   [series!]
	][
		PARSE_SET_INPUT_LENGTH(len)
		if any [zero? len len < min][return no]			;-- input too short

		cnt: 0
		match?: yes

		either any [									;TBD: replace with ANY_STRING
			type = TYPE_STRING
			type = TYPE_FILE
		][
			either TYPE_OF(token)= TYPE_BITSET [
				match?: loop-bitset input as red-bitset! token min max counter
			][
				until [										;-- ANY-STRING input matching
					match?: string/match? as red-string! input token COMP_EQUAL
					end?: all [match? advance as red-string! input token]	;-- consume matched input
					cnt: cnt + 1
					any [
						not match?
						end?
						all [max <> R_NONE cnt >= max]
					]
				]
			]
		][
			until [										;-- ANY-BLOCK input matching
				match?:	actions/compare block/rs-head input token COMP_EQUAL	;@@ sub-optimal!!
				end?: all [match? block/rs-next input]	;-- consume matched input
				cnt: cnt + 1
				any [
					not match?
					end?
					all [max <> R_NONE cnt >= max]
				]
			]
		]

		unless match? [
			cnt: cnt - 1
			match?: either max = R_NONE [min <= cnt][all [min <= cnt cnt <= max]]
		]
		counter/value: cnt
		match?
	]

	save-stack: func [
		/local
			cnt [integer!]
			p	[positions!]
	][
		cnt: block/rs-length? rules
		unless zero? cnt [
			p: as positions! ALLOC_TAIL(rules)
			p/input: series/head
			p/rule:  rules/head

			series/head: (block/rs-length? series) + 1
			rules/head:  cnt + 1
		]
	]

	restore-stack: func [
		/local
			s [series!]
			p [positions!]
	][
		if rules/head > 0 [
			s: GET_BUFFER(rules)
			s/tail: s/tail - 1
			p: as positions! s/tail
			series/head: p/input
			rules/head: p/rule
		]
	]

	process: func [
		input [red-series!]
		rule  [red-block!]
		case? [logic!]
		;strict? [logic!]
		return: [red-value!]
		/local
			new		 [red-series!]
			int		 [red-integer!]
			int2	 [red-integer!]
			blk		 [red-block!]
			sym*	 [red-symbol!]
			cmd		 [red-value!]
			tail	 [red-value!]
			value	 [red-value!]
			base	 [red-value!]
			char	 [red-char!]
			dt		 [red-datatype!]
			w		 [red-word!]
			t 		 [triple!]
			p		 [positions!]
			state	 [integer!]
			type	 [integer!]
			sym		 [integer!]
			min		 [integer!]
			max		 [integer!]
			s		 [series!]
			cnt		 [integer!]
			upper?	 [logic!]
			end?	 [logic!]
			ended?	 [logic!]
			match?	 [logic!]
			loop?	 [logic!]
			pop?	 [logic!]
			break?	 [logic!]
			rule?	 [logic!]
			collect? [logic!]
	][
		match?:	  yes
		end?:	  no
		ended?:   yes
		break?:	  no
		pop?:	  no
		rule?:	  no
		collect?: no
		value:	  null
		type:	  -1
		min:	  -1
		max:	  -1
		cnt:	  0
		state:    ST_NEXT_ACTION

		save-stack
		base: stack/push*								;-- slot on stack for COPY/SET operations (until OPTION?() is fixed)
		input: block/rs-append series as red-value! input	;-- input now points to the series stack entry

		cmd: (block/rs-head rule) - 1					;-- decrement to compensate for starting increment
		tail: block/rs-tail rule						;TBD: protect current rule block from changes

		until [
			#if debug? = yes [if verbose > 1 [print-state state]]

			switch state [
				ST_PUSH_BLOCK [
					none/rs-push rules
					PARSE_PUSH_POSITIONS
					block/rs-append rules as red-value! rule
					if all [value <> null value <> rule][
						assert TYPE_OF(value) = TYPE_BLOCK
						copy-cell value as red-value! rule
					]
					cmd: (block/rs-head rule) - 1		;-- decrement to compensate for starting increment
					tail: block/rs-tail rule			;TBD: protect current rule block from changes

					PARSE_SET_INPUT_LENGTH(cnt)
					end?: zero? cnt						;-- refresh end? flag
					state: ST_NEXT_ACTION
				]
				ST_POP_BLOCK [
					either zero? block/rs-length? rules [
						state: ST_END
					][
						loop?: no
						ended?: cmd = tail

						s: GET_BUFFER(rules)
						copy-cell s/tail - 1 as red-value! rule
						assert TYPE_OF(rule) = TYPE_BLOCK
						p: as positions! s/tail - 2

						cmd: (block/rs-head rule) + p/rule
						tail: block/rs-tail rule
						s/tail: s/tail - 3
						value: s/tail - 1

						state: either all [
							0 < block/rs-length? rules
							TYPE_OF(value) = TYPE_INTEGER
						][
							ST_POP_RULE
						][
							either match? [ST_NEXT_ACTION][ST_FIND_ALTERN]
						]
					]
				]
				ST_PUSH_RULE [
					either any [type = R_COPY type = R_SET][
						block/rs-append rules cmd
					][
						t: as triple! ALLOC_TAIL(rules)
						t/header: TYPE_TRIPLE
						t/min:	  min
						t/max:	  max
						t/state:  1
					]
					PARSE_PUSH_POSITIONS
					int: as red-integer! ALLOC_TAIL(rules)
					int/header: TYPE_INTEGER
					int/value: type
					if cmd < tail [cmd: cmd + 1]		;-- move after the rule prologue
					value: cmd
					state: ST_MATCH_RULE
				]
				ST_POP_RULE [
					s: GET_BUFFER(rules)
					value: s/tail - 1

					either any [
						s/offset + rules/head = s/tail	;-- rules stack empty already
						TYPE_OF(value) = TYPE_BLOCK
					][
						state: either pop? [pop?: no ST_POP_BLOCK][ST_NEXT_ACTION]
					][
						pop?: yes
						p: as positions! s/tail - 2
						int: as red-integer! value
						switch int/value [
							R_WHILE
							R_NONE [					;-- iterative rules (ANY, SOME, WHILE, ...)
								t: as triple! s/tail - 3
								cnt: t/state
								either match? [
									loop?: either t/max = R_NONE [match?][cnt < t/max]
								][
									match?: any [t/min <= (cnt - 1) zero? t/min]
								]
								if any [
									break?
									not match?
									all [int/value <> R_WHILE input/head = p/input]
								][
									loop?: no
									break?: no
								]
								either any [end? not loop?][
									if all [match? cnt < t/min][match?: no]
								][
									t/state: cnt + 1
									cmd: (block/rs-head rule) + p/rule ;-- loop rule
									state: ST_NEXT_ACTION
									pop?: no
								]
							]
							R_TO
							R_THRU [
								either match? [
									if int/value = R_TO [
										input/head: p/input	;-- move input before the last match
										end?: no
									]
								][
									type: TYPE_OF(input)
									end?: either any [	;TBD: replace with ANY_STRING?
										type = TYPE_STRING
										type = TYPE_FILE
									][
										string/rs-next as red-string! input
									][
										block/rs-next input
									]
									either end? [
										w: as red-word! (block/rs-head rule) + p/rule + 1 ;-- TO/THRU argument
										match?: all [
											TYPE_OF(w) = TYPE_WORD
											words/end = symbol/resolve w/symbol
										]
									][
										p/input: input/head	;-- refresh saved input head before new iteration
										cmd: (block/rs-head rule) + p/rule ;-- loop rule
										state: ST_NEXT_ACTION
										pop?: no
									]
								]
							]
							R_COPY [
								if match? [
									w: as red-word! s/tail - 3
									new: as red-series! value
									copy-cell as red-value! input as red-value! new
									copy-cell as red-value! input base
									new/head: p/input
									actions/copy new base no null
									_context/set w as red-value! new
								]
							]
							R_SET [
								if match? [
									w: as red-word! p - 1
									PARSE_PICK_INPUT
									_context/set w value
								]
							]
							R_KEEP
							R_KEEP_PAREN [
								if match? [
									blk: as red-block! stack/top - 1
									assert TYPE_OF(blk) = TYPE_BLOCK
									value: stack/top
									if int/value = R_KEEP [PARSE_PICK_INPUT]
									block/rs-append blk value
								]
							]
							R_REMOVE [
								if match? [
									int/value: input/head - p/input
									input/head: p/input
									assert positive? int/value
									actions/remove input as red-value! int
								]
							]
							R_NOT [
								match?: not match?
							]
							R_COLLECT [
								unless stack/top - 2 = base [
									blk: as red-block! stack/top - 2
									assert TYPE_OF(blk) = TYPE_BLOCK
									value: stack/top - 1
									assert TYPE_OF(value) = TYPE_BLOCK
									block/rs-append blk value
									stack/pop 1
								]
							]
							R_INTO [
								s: GET_BUFFER(series)
								s/tail: s/tail - 1
								input: as red-series! s/tail - 1
								unless ended? [match?: no]
								if match? [input/head: input/head + 1]	;-- skip parsed series

								PARSE_SET_INPUT_LENGTH(cnt)
								end?: zero? cnt			;-- refresh end? flag after popping series
								s: GET_BUFFER(rules)
							]
							R_THEN [
								s/tail: s/tail - 3		;-- pop rule stack frame
								state: either match? [cmd: tail ST_NEXT_ACTION][ST_FIND_ALTERN]
								pop?: no
							]
						]
						if pop? [
							s/tail: s/tail - 3			;-- pop rule stack frame
							state:  ST_CHECK_PENDING
						]
					]
					pop?: no
				]
				ST_CHECK_PENDING [
					s: GET_BUFFER(rules)
					value: s/tail - 1

					state: either any [					;-- order of conditional expressions matters!
						zero? block/rs-length? rules
						TYPE_OF(value) <> TYPE_INTEGER
					][
						either match? [ST_NEXT_ACTION][ST_FIND_ALTERN]
					][
						ST_POP_RULE
					]
				]
				ST_DO_ACTION [
					type: TYPE_OF(value)				;-- value is used in this state instead of cmd
					switch type [						;-- allows to enter the state with cmd or :cmd (if word!)
						TYPE_WORD 	[
							if all [value <> cmd TYPE_OF(cmd) = TYPE_WORD][
								print-line "*** Parse Error: invalid word in rule"
								halt
							]
							state: ST_WORD
						]
						TYPE_BLOCK 	[
							state: ST_PUSH_BLOCK
						]
						TYPE_DATATYPE [
							dt: as red-datatype! value
							value: block/rs-head input
							match?: TYPE_OF(value) = dt/value
							state: either match? [ST_NEXT_INPUT][ST_CHECK_PENDING]
						]
						TYPE_SET_WORD [
							_context/set as red-word! value as red-value! input
							state: ST_NEXT_ACTION
						]
						TYPE_GET_WORD [
							new: as red-series! _context/get as red-word! value
							either all [
								TYPE_OF(new) = TYPE_OF(input)
								new/node = input/node
							][
								input/head: new/head
								state: ST_NEXT_ACTION
							][
								print-line "*** Parse Error: get-word refers to a different series!"
							]
						]
						TYPE_INTEGER [
							int:  as red-integer! value
							int2: as red-integer! cmd + 1
							if all [
								int2 < tail
								TYPE_OF(int2) = TYPE_WORD
							][
								int2: as red-integer! _context/get as red-word! cmd + 1
							]
							upper?: TYPE_OF(int2) = TYPE_INTEGER
							if any [
								int2 = tail
								all [upper?	int2 + 1 = tail]
								all [upper? int/value > int2/value]
							][
								print-line "*** Parse Error: invalid integer rule"
							]
							min:   int/value
							max:   either upper? [cmd: cmd + 1 int2/value][min]
							type:  R_NONE
							state: ST_PUSH_RULE

						]
						TYPE_PAREN [
							interpreter/eval as red-block! value no
							stack/pop 1
							state: ST_CHECK_PENDING
						]
						default [						;-- try to match a literal value
							state: ST_MATCH
						]
					]
				]
				ST_NEXT_INPUT [
					type: TYPE_OF(input)
					end?: either any [					;TBD: replace with ANY_STRING
						type = TYPE_STRING
						type = TYPE_FILE
					][
						string/rs-next as red-string! input
					][
						block/rs-next input
					]
					state: ST_CHECK_PENDING
				]
				ST_NEXT_ACTION [
					if cmd < tail [cmd: cmd + 1]

					state: either cmd = tail [
						ST_POP_BLOCK
					][
						value: cmd
						ST_DO_ACTION
					]
				]
				ST_MATCH [
					either end? [
						match?: no
					][
						type: TYPE_OF(input)
						end?: either any [				;TBD: replace with ANY_STRING?
							type = TYPE_STRING
							type = TYPE_FILE
						][
							match?: either TYPE_OF(value) = TYPE_BITSET [
								string/match-bitset? as red-string! input as red-bitset! value
							][
								string/match? as red-string! input value COMP_EQUAL
							]
							all [match? advance as red-string! input value]	;-- consume matched input
						][
							match?: actions/compare block/rs-head input value COMP_EQUAL
							all [match? block/rs-next input]				;-- consume matched input
						]
					]
					state: ST_CHECK_PENDING
				]
				ST_MATCH_RULE [
					either all [value = tail][
						match?: no
						state: ST_CHECK_PENDING
					][
						switch TYPE_OF(value) [
							TYPE_BLOCK	 [state: ST_PUSH_BLOCK]
							TYPE_WORD	 [state: ST_WORD rule?: all [type <> R_COLLECT type <> R_KEEP]]
							TYPE_INTEGER [state: ST_DO_ACTION]
							default [
								either min = R_NONE [
									state: either any [type = R_TO type = R_THRU][
										match?: find-token? rules input value case?
										ST_POP_RULE
									][
										ST_DO_ACTION
									]
								][
									match?: loop-token input value min max :cnt case?
									if all [not match? zero? min][match?: yes]
									s: GET_BUFFER(rules)
									s/tail: s/tail - 3		;-- pop rule stack frame
									state: ST_CHECK_PENDING
								]
								PARSE_SET_INPUT_LENGTH(cnt)
								end?: zero? cnt
							]
						]
					]
				]
				ST_FIND_ALTERN [
					s: GET_BUFFER(rules)				;-- backtrack input
					p: as positions! s/tail - 2
					input/head: p/input
					PARSE_SET_INPUT_LENGTH(cnt)
					end?: zero? cnt						;-- refresh end? flag after backtracking

					cnt: find-altern rule cmd

					state: either cnt >= 0 [
						cmd: cmd + cnt					;-- point rule head to alternative part
						match?: yes						;-- reset match? flag
						ST_NEXT_ACTION
					][
						ST_POP_BLOCK
					]
				]
				ST_WORD [
					w: as red-word! cmd
					sym: symbol/resolve w/symbol
					#if debug? = yes [
						sym*: symbol/get sym
						if verbose > 0 [print-line ["parse: " sym*/cache]]
					]
					case [
						sym = words/pipe [				;-- |
							cmd: tail
							state: ST_POP_BLOCK
						]
						sym = words/skip [				;-- SKIP
							match?: not end?
							state: ST_NEXT_INPUT
						]
						sym = words/any* [				;-- ANY
							min:   0
							max:   R_NONE
							type:  R_NONE
							state: ST_PUSH_RULE
						]
						sym = words/some [				;-- SOME
							min:   1
							max:   R_NONE
							type:  R_NONE
							state: ST_PUSH_RULE
						]
						sym = words/copy [				;-- COPY
							cmd: cmd + 1
							if any [cmd = tail TYPE_OF(cmd) <> TYPE_WORD][
								print-line "*** Parse Error: invalid COPY rule"
							]
							min:   R_NONE
							type:  R_COPY
							state: ST_PUSH_RULE
						]
						sym = words/thru [				;-- THRU
							min:   R_NONE
							type:  R_THRU
							state: ST_PUSH_RULE
						]
						sym = words/to [				;-- TO
							min:   R_NONE
							type:  R_TO
							state: ST_PUSH_RULE
						]
						sym = words/remove [			;-- REMOVE
							min:   R_NONE
							type:  R_REMOVE
							state: ST_PUSH_RULE
						]
						sym = words/break* [			;-- BREAK
							match?: yes
							break?: yes
							cmd:	cmd + 1
							pop?:	yes
							state:	ST_POP_RULE
						]
						sym = words/opt [				;-- OPT
							min:   0
							max:   1
							type:  R_NONE
							state: ST_PUSH_RULE
						]
						sym = words/keep [				;-- KEEP
							value: cmd + 1
							min:   R_NONE
							type:  either TYPE_OF(value) = TYPE_PAREN [R_KEEP_PAREN][R_KEEP]
							state: ST_PUSH_RULE
						]
						sym = words/fail [				;-- FAIL
							match?: no
							state: ST_FIND_ALTERN
						]
						sym = words/while* [			;-- WHILE
							min:   0
							max:   R_NONE
							type:  R_WHILE
							state: ST_PUSH_RULE
						]
						sym = words/into [				;-- INTO
							if TYPE_OF(input) <> TYPE_BLOCK [
								print-line "*** Parse Error: INTO can only be used on a block! value"
							]
							value: cmd + 1
							if any [
								value = tail
								TYPE_OF(value) <> TYPE_BLOCK
							][
								print-line "*** Parse Error: INTO invalid argument"
							]
							value: block/rs-head input
							type: TYPE_OF(value)
							either any [				;@@ replace by ANY_SERIES?()
								type = TYPE_BLOCK
								type = TYPE_PAREN
								type = TYPE_PATH
								type = TYPE_LIT_PATH
								type = TYPE_SET_PATH
								type = TYPE_GET_PATH
								type = TYPE_STRING
								type = TYPE_FILE
							][
								input: block/rs-append series as red-value! block/rs-head input
								min:  R_NONE
								type: R_INTO
								state: ST_PUSH_RULE
							][
								match?: no
								state: ST_CHECK_PENDING
							]
						]
						sym = words/insert [			;-- INSERT
							w: as red-word! cmd + 1
							max: as-integer all [
								(as red-value! w) < tail
								TYPE_OF(w) = TYPE_WORD
								words/only = symbol/resolve w/symbol
							]
							cmd: cmd + max + 1
							actions/insert input cmd null max = 1 null no
							state: ST_NEXT_ACTION
						]
						sym = words/end [				;-- END
							PARSE_SET_INPUT_LENGTH(cnt)
							match?: zero? cnt
							state: ST_POP_RULE
						]
						sym = words/then [				;-- THEN
							if cmd + 1 = tail [
								print-line "*** Parse Error: THEN requires an argument rule"
							]
							min:   R_NONE
							type:  R_THEN
							state: ST_PUSH_RULE
						]
						sym = words/if* [				;-- IF
							cmd: cmd + 1
							if any [cmd = tail TYPE_OF(cmd) <> TYPE_PAREN][
								print-line "*** Parse Error: IF requires a paren argument"
							]
							interpreter/eval as red-block! cmd no
							match?: logic/top-true?
							stack/pop 1
							state: ST_CHECK_PENDING
						]
						sym = words/not* [				;-- NOT
							min:   R_NONE
							type:  R_NOT
							state: ST_PUSH_RULE
						]
						sym = words/quote [				;-- QUOTE
							cmd: cmd + 1
							if cmd = tail [
								print-line "*** Parse Error: missing QUOTE argument"
							]
							value: cmd
							state: ST_MATCH
						]
						sym = words/collect [			;-- COLLECT
							collect?: yes
							block/push* 8
							min:   R_NONE
							type:  R_COLLECT
							state: ST_PUSH_RULE
						]
						sym = words/reject [			;-- REJECT
							match?: no
							break?: yes
							pop?:	yes
							state:	ST_POP_RULE
						]
						sym = words/set [				;-- SET
							cmd: cmd + 1
							if any [cmd = tail TYPE_OF(cmd) <> TYPE_WORD][
								print-line "*** Parse Error: invalid COPY rule"
							]
							min:   R_NONE
							type:  R_SET
							state: ST_PUSH_RULE
						]
						sym = words/none [				;-- NONE
							match?: yes
							state: ST_CHECK_PENDING
						]
						true [
							value: _context/get w
							state: either rule? [ST_MATCH_RULE][ST_DO_ACTION] ;-- enable fast loops for word argument
							rule?: no
						]
					]
				]
				ST_END [
					if match? [match?: cmd = tail]

					PARSE_SET_INPUT_LENGTH(cnt)
					if all [
						cnt > 0
						1 = block/rs-length? series
					][
						match?: no
					]
					state: ST_EXIT
				]
			]
			state = ST_EXIT
		]

		block/clear series
		block/clear rules
		restore-stack

		either collect? [
			base + 1
		][
			as red-value! logic/push match?
		]
	]

	init: does [
		series: block/make-in root 8
		rules:  block/make-in root 100
	]
]

Red/System [
	Title:   "PARSE dialect interpreter"
	Author:  "Nenad Rakocevic"
	File: 	 %parse.reds
	Tabs:	 4
	Rights:  "Copyright (C) 2011-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
	}
]

parser: context [
	verbose: 0

	series: as red-block! 0
	rules:  as red-block! 0

	#define PARSE_PUSH_POSITIONS [
		p: as positions! ALLOC_TAIL(rules)
		p/header: TYPE_TRIPLE
		p/rule:	  (as-integer cmd - block/rs-head rule) >> 4	;-- save cmd position
		p/input:  input/head									;-- save input position
	]

	#define PARSE_SET_INPUT_LENGTH(word) [
		type: TYPE_OF(input)
		word: either any [								;TBD: replace with ANY_STRING?
			type = TYPE_STRING
			type = TYPE_FILE
		][
			string/rs-length? as red-string! input
		][
			block/rs-length? input
		]
	]

	#enum states! [
		ST_PUSH_BLOCK
		ST_POP_BLOCK
		ST_PUSH_RULE
		ST_POP_RULE
		ST_CHECK_PENDING
		ST_DO_ACTION
		ST_NEXT_INPUT
		ST_NEXT_ACTION
		ST_MATCH
		ST_MATCH_RULE
		ST_FIND_ALTERN
		ST_WORD
		ST_END
		ST_EXIT
	]

	#enum rule-flags! [									;-- negative values to not collide with t/state counter
		R_NONE:		  -1
		R_TO:		  -2
		R_THRU:		  -3
		R_COPY:		  -4
		R_SET:		  -5
		R_NOT:		  -6
		R_INTO:		  -7
		R_THEN:		  -8
		R_REMOVE:	  -9
		R_INSERT:	  -10
		R_WHILE:	  -11
		R_COLLECT:	  -12
		R_KEEP:		  -13
		R_KEEP_PAREN: -14
	]

	triple!: alias struct! [
		header [integer!]
		min	   [integer!]
		max	   [integer!]
		state  [integer!]
	]

	positions!: alias struct! [
		header [integer!]
		rule   [integer!]
		input  [integer!]
		pad    [integer!]
	]

	#if debug? = yes [
		print-state: func [s [integer!]][
			print "state: "
			print-line switch s [
				ST_PUSH_BLOCK	 ["ST_PUSH_BLOCK"]
				ST_POP_BLOCK	 ["ST_POP_BLOCK"]
				ST_PUSH_RULE	 ["ST_PUSH_RULE"]
				ST_POP_RULE	 	 ["ST_POP_RULE"]
				ST_CHECK_PENDING ["ST_CHECK_PENDING"]
				ST_DO_ACTION	 ["ST_DO_ACTION"]
				ST_NEXT_INPUT	 ["ST_NEXT_INPUT"]
				ST_NEXT_ACTION	 ["ST_NEXT_ACTION"]
				ST_MATCH		 ["ST_MATCH"]
				ST_MATCH_RULE	 ["ST_MATCH_RULE"]
				ST_FIND_ALTERN	 ["ST_FIND_ALTERN"]
				ST_WORD			 ["ST_WORD"]
				ST_END			 ["ST_END"]
				ST_EXIT			 ["ST_EXIT"]
			]
		]
	]

	advance: func [
		str		[red-string!]
		value	[red-value!]							;-- char! or string! value
		return:	[logic!]
		/local
			end? [logic!]
			type [integer!]
	][
		type: TYPE_OF(value)
		end?: either any [type = TYPE_CHAR type = TYPE_BITSET][
			string/rs-next str
		][
			assert TYPE_OF(value) = TYPE_STRING
			string/rs-skip str string/rs-length? as red-string! value
		]
		end?
	]

	find-altern: func [									;-- search for next '| symbol
		rule	[red-block!]
		pos		[red-value!]
		return: [integer!]								;-- >= 0 found, -1 not found
		/local
			head  [red-value!]
			tail  [red-value!]
			value [red-value!]
			w	  [red-word!]
	][
		s: GET_BUFFER(rule)
		head:  s/offset + ((as-integer pos - s/offset) >> 4)
		tail:  s/tail
		value: head

		while [value < tail][
			if TYPE_OF(value) = TYPE_WORD [
				w: as red-word! value
				if w/symbol = words/pipe [
					return ((as-integer value - head) >> 4)
				]
			]
			value: value + 1
		]
		-1
	]

	adjust-input-index: func [
		input	[red-series!]
		pos		[positions!]
		base    [integer!]
		offset  [integer!]
		return: [logic!]
	][
		input/head: input/head + base + offset
		pos/input: either zero? input/head [0][input/head - base]
		yes
	]

	find-token?: func [									;-- optimized fast token lookup
		rules	[red-block!]							;-- (could be optimized even further)
		input	[red-series!]
		token	[red-value!]
		case?	[logic!]
		return: [logic!]
		/local
			pos*   [positions!]
			head   [red-value!]
			tail   [red-value!]
			value  [red-value!]
			char   [red-char!]
			bits   [red-bitset!]
			s	   [series!]
			p	   [byte-ptr!]
			phead  [byte-ptr!]
			ptail  [byte-ptr!]
			pbits  [byte-ptr!]
			pos    [byte-ptr!]
			p4	   [int-ptr!]
			cp	   [integer!]
			size   [integer!]
			unit   [integer!]
			type   [integer!]
			not?   [logic!]
			match? [logic!]
	][
		s: GET_BUFFER(rules)
		pos*: as positions! s/tail - 2

		type: TYPE_OF(input)
		either any [									;TBD: replace with ANY_STRING + TYPE_BINARY
			type = TYPE_STRING
			type = TYPE_FILE
			type = TYPE_BINARY
		][
			switch TYPE_OF(token) [
				TYPE_BITSET [
					s: 	   GET_BUFFER(input)
					unit:  GET_UNIT(s)
					phead: (as byte-ptr! s/offset) + (input/head << (unit >> 1))
					ptail: as byte-ptr! s/tail
					p: 	   phead

					bits:  as red-bitset! token
					s:	   GET_BUFFER(bits)
					pbits: as byte-ptr! s/offset
					not?:  FLAG_NOT?(s)
					size:  s/size << 3

					until [
						cp: switch unit [
							Latin1 [as-integer p/value]
							UCS-2  [(as-integer p/2) << 8 + p/1]
							UCS-4  [p4: as int-ptr! p p4/value]
						]
						either size < cp [
							match?: not?				;-- virtual bit
						][
							BS_TEST_BIT(pbits cp match?)
						]
						if match? [
							return adjust-input-index input pos* 1 ((as-integer p - phead) >> (unit >> 1))
						]
						p: p + unit
						p = ptail
					]
				]
				TYPE_STRING
				TYPE_FILE
				TYPE_BINARY [
					size: string/rs-length? as red-string! token
					if (string/rs-length? as red-string! input) < size [return no]

					s: GET_BUFFER(input)
					unit:  (GET_UNIT(s) >> 1)
					phead: as byte-ptr! s/offset
					ptail: as byte-ptr! s/tail

					until [
						if string/equal? as red-string! input as red-string! token COMP_EQUAL yes [
							return adjust-input-index input pos* size 0
						]
						input/head: input/head + 1
						phead + (input/head + size << unit) > ptail
					]
				]
				TYPE_CHAR [
					char: as red-char! token
					cp: char/value

					s: GET_BUFFER(input)
					unit: GET_UNIT(s)
					phead: (as byte-ptr! s/offset) + (input/head << (unit >> 1))
					ptail: as byte-ptr! s/tail
					p: phead

					switch unit [
						Latin1 [
							while [p < ptail][
								if p/value = as-byte cp [
									return adjust-input-index input pos* 1 (as-integer p - phead)
								]
								p: p + 1
							]
						]
						UCS-2 [
							while [p < ptail][
								if (as-integer p/2) << 8 + p/1 = cp [
									return adjust-input-index input pos* 1 ((as-integer p - phead) >> 1)
								]
								p: p + 2
							]
						]
						UCS-4 [
							p4: as int-ptr! p
							while [p4 < as int-ptr! ptail][
								if p4/value = cp [
									return adjust-input-index input pos* 1 ((as-integer p4 - phead) >> 2)
								]
								p4: p4 + 1
							]
						]
					]
				]
				default [
					print-line "*** Parse Error: invalid literal value to match on string"
				]
			]
		][
			head:  block/rs-head input
			tail:  block/rs-tail input
			value: head

			while [value < tail][
				if actions/compare value token COMP_EQUAL [
					return adjust-input-index input pos* 1 ((as-integer value - head) >> 4)
				]
				value: value + 1
			]
		]
		no
	]

	loop-bitset: func [									;-- optimized bitset matching loop
		input	[red-series!]
		bits	[red-bitset!]
		min		[integer!]
		max		[integer!]
		counter [int-ptr!]
		return: [logic!]
		/local
			s	   [series!]
			unit   [integer!]
			p	   [byte-ptr!]
			phead  [byte-ptr!]
			ptail  [byte-ptr!]
			pbits  [byte-ptr!]
			pos    [byte-ptr!]
			p4	   [int-ptr!]
			cp	   [integer!]
			cnt	   [integer!]
			size   [integer!]
			not?   [logic!]
			max?   [logic!]
			match? [logic!]
	][
		s:	   GET_BUFFER(input)
		unit:  GET_UNIT(s)
		phead: (as byte-ptr! s/offset) + (input/head << (unit >> 1))
		ptail: as byte-ptr! s/tail
		p:	   phead

		s:	   GET_BUFFER(bits)
		pbits: as byte-ptr! s/offset
		not?:  FLAG_NOT?(s)
		size:  s/size << 3

		cnt: 	0
		match?: yes
		max?:	max <> R_NONE

		until [
			cp: switch unit [
				Latin1 [as-integer p/value]
				UCS-2  [(as-integer p/2) << 8 + p/1]
				UCS-4  [p4: as int-ptr! p p4/value]
			]
			either size < cp [							;-- virtual bit
				match?: not?
			][
				BS_TEST_BIT(pbits cp match?)
			]
			if match? [
				p: p + unit
				cnt: cnt + 1
			]
			any [
				not match?
				p = ptail
				all [max? cnt >= max]
			]
		]
		input/head: input/head + ((as-integer p - phead) >> (unit >> 1))
		counter/value: cnt

		either not max? [min <= cnt][all [min <= cnt cnt <= max]]
	]

	loop-token: func [									;-- fast literal matching loop
		input	[red-series!]
		token	[red-value!]
		min		[integer!]
		max		[integer!]
		counter [int-ptr!]
		case?	[logic!]
		return: [logic!]
		/local
			len	   [integer!]
			cnt	   [integer!]
			type   [integer!]
			match? [logic!]
			end?   [logic!]
			s	   [series!]
	][
		PARSE_SET_INPUT_LENGTH(len)
		if any [zero? len len < min][return no]			;-- input too short

		cnt: 0
		match?: yes

		either any [									;TBD: replace with ANY_STRING
			type = TYPE_STRING
			type = TYPE_FILE
		][
			either TYPE_OF(token)= TYPE_BITSET [
				match?: loop-bitset input as red-bitset! token min max counter
			][
				until [										;-- ANY-STRING input matching
					match?: string/match? as red-string! input token COMP_EQUAL
					end?: all [match? advance as red-string! input token]	;-- consume matched input
					cnt: cnt + 1
					any [
						not match?
						end?
						all [max <> R_NONE cnt >= max]
					]
				]
			]
		][
			until [										;-- ANY-BLOCK input matching
				match?:	actions/compare block/rs-head input token COMP_EQUAL	;@@ sub-optimal!!
				end?: all [match? block/rs-next input]	;-- consume matched input
				cnt: cnt + 1
				any [
					not match?
					end?
					all [max <> R_NONE cnt >= max]
				]
			]
		]

		unless match? [
			cnt: cnt - 1
			match?: either max = R_NONE [min <= cnt][all [min <= cnt cnt <= max]]
		]
		counter/value: cnt
		match?
	]

	save-stack: func [
		/local
			cnt [integer!]
			p	[positions!]
	][
		cnt: block/rs-length? rules
		unless zero? cnt [
			p: as positions! ALLOC_TAIL(rules)
			p/input: series/head
			p/rule:  rules/head

			series/head: (block/rs-length? series) + 1
			rules/head:  cnt + 1
		]
	]

	restore-stack: func [
		/local
			s [series!]
			p [positions!]
	][
		if rules/head > 0 [
			s: GET_BUFFER(rules)
			s/tail: s/tail - 1
			p: as positions! s/tail
			series/head: p/input
			rules/head: p/rule
		]
	]

	process: func [
		input [red-series!]
		rule  [red-block!]
		case? [logic!]
		;strict? [logic!]
		return: [red-value!]
		/local
			new		 [red-series!]
			int		 [red-integer!]
			int2	 [red-integer!]
			blk		 [red-block!]
			sym*	 [red-symbol!]
			cmd		 [red-value!]
			tail	 [red-value!]
			value	 [red-value!]
			base	 [red-value!]
			char	 [red-char!]
			dt		 [red-datatype!]
			w		 [red-word!]
			t 		 [triple!]
			p		 [positions!]
			state	 [integer!]
			type	 [integer!]
			sym		 [integer!]
			min		 [integer!]
			max		 [integer!]
			s		 [series!]
			cnt		 [integer!]
			upper?	 [logic!]
			end?	 [logic!]
			ended?	 [logic!]
			match?	 [logic!]
			loop?	 [logic!]
			pop?	 [logic!]
			break?	 [logic!]
			rule?	 [logic!]
			collect? [logic!]
	][
		match?:	  yes
		end?:	  no
		ended?:   yes
		break?:	  no
		pop?:	  no
		rule?:	  no
		collect?: no
		value:	  null
		type:	  -1
		min:	  -1
		max:	  -1
		cnt:	  0
		state:    ST_NEXT_ACTION

		save-stack
		base: stack/push*								;-- slot on stack for COPY/SET operations (until OPTION?() is fixed)
		input: block/rs-append series as red-value! input	;-- input now points to the series stack entry

		cmd: (block/rs-head rule) - 1					;-- decrement to compensate for starting increment
		tail: block/rs-tail rule						;TBD: protect current rule block from changes

		until [
			#if debug? = yes [if verbose > 1 [print-state state]]

			switch state [
				ST_PUSH_BLOCK [
					none/rs-push rules
					PARSE_PUSH_POSITIONS
					block/rs-append rules as red-value! rule
					if all [value <> null value <> rule][
						assert TYPE_OF(value) = TYPE_BLOCK
						copy-cell value as red-value! rule
					]
					cmd: (block/rs-head rule) - 1		;-- decrement to compensate for starting increment
					tail: block/rs-tail rule			;TBD: protect current rule block from changes
					state: ST_NEXT_ACTION
				]
				ST_POP_BLOCK [
					either zero? block/rs-length? rules [
						state: ST_END
					][
						loop?: no
						ended?: cmd = tail

						s: GET_BUFFER(rules)
						copy-cell s/tail - 1 as red-value! rule
						assert TYPE_OF(rule) = TYPE_BLOCK
						p: as positions! s/tail - 2

						cmd: (block/rs-head rule) + p/rule
						tail: block/rs-tail rule
						s/tail: s/tail - 3
						value: s/tail - 1

						state: either all [
							0 < block/rs-length? rules
							TYPE_OF(value) = TYPE_INTEGER
						][
							ST_POP_RULE
						][
							either match? [ST_NEXT_ACTION][ST_FIND_ALTERN]
						]
					]
				]
				ST_PUSH_RULE [
					either any [type = R_COPY type = R_SET][
						block/rs-append rules cmd
					][
						t: as triple! ALLOC_TAIL(rules)
						t/header: TYPE_TRIPLE
						t/min:	  min
						t/max:	  max
						t/state:  1
					]
					PARSE_PUSH_POSITIONS
					int: as red-integer! ALLOC_TAIL(rules)
					int/header: TYPE_INTEGER
					int/value: type
					if cmd < tail [cmd: cmd + 1]		;-- move after the rule prologue
					value: cmd
					state: ST_MATCH_RULE
				]
				ST_POP_RULE [
					s: GET_BUFFER(rules)
					value: s/tail - 1

					either any [
						s/offset + rules/head = s/tail	;-- rules stack empty already
						TYPE_OF(value) = TYPE_BLOCK
					][
						state: either pop? [pop?: no ST_POP_BLOCK][ST_NEXT_ACTION]
					][
						pop?: yes
						p: as positions! s/tail - 2
						int: as red-integer! value
						switch int/value [
							R_WHILE
							R_NONE [					;-- iterative rules (ANY, SOME, WHILE, ...)
								t: as triple! s/tail - 3
								cnt: t/state
								either match? [
									loop?: either t/max = R_NONE [match?][cnt < t/max]
								][
									match?: any [t/min <= (cnt - 1) zero? t/min]
								]
								if any [
									break?
									not match?
									all [int/value <> R_WHILE input/head = p/input]
								][
									loop?: no
									break?: no
								]
								either any [end? not loop?][
									if all [match? cnt < t/min][match?: no]
								][
									t/state: cnt + 1
									cmd: (block/rs-head rule) + p/rule ;-- loop rule
									state: ST_NEXT_ACTION
									pop?: no
								]
							]
							R_TO
							R_THRU [
								either match? [
									if int/value = R_TO [
										input/head: p/input	;-- move input before the last match
										end?: no
									]
								][
									type: TYPE_OF(input)
									end?: either any [	;TBD: replace with ANY_STRING?
										type = TYPE_STRING
										type = TYPE_FILE
									][
										string/rs-next as red-string! input
									][
										block/rs-next input
									]
									either end? [
										w: as red-word! (block/rs-head rule) + p/rule + 1 ;-- TO/THRU argument
										match?: all [
											TYPE_OF(w) = TYPE_WORD
											words/end = symbol/resolve w/symbol
										]
									][
										p/input: input/head	;-- refresh saved input head before new iteration
										cmd: (block/rs-head rule) + p/rule ;-- loop rule
										state: ST_NEXT_ACTION
										pop?: no
									]
								]
							]
							R_COPY [
								if match? [
									w: as red-word! s/tail - 3
									new: as red-series! value
									copy-cell as red-value! input as red-value! new
									copy-cell as red-value! input base
									new/head: p/input
									actions/copy new base no null
									_context/set w as red-value! new
								]
							]
							R_SET [
								if match? [
									w: as red-word! p - 1
									type: TYPE_OF(input)
									either any [		;TBD: replace with ANY_STRING
										type = TYPE_STRING
										type = TYPE_FILE
									][
										char: as red-char! value
										char/header: TYPE_CHAR
										char/value: string/rs-abs-at as red-string! input p/input
									][
										value: block/rs-abs-at input p/input
									]
									_context/set w value
								]
							]
							R_KEEP
							R_KEEP_PAREN [
								if match? [
									;if int/value = R_KEEP_PAREN [stack/pop 1] ;-- move back to PARSE's stack frame
									blk: as red-block! stack/top - 1
									assert TYPE_OF(blk) = TYPE_BLOCK
									value: stack/top

									if int/value = R_KEEP [
										type: TYPE_OF(input)
										either any [		;TBD: replace with ANY_STRING
											type = TYPE_STRING
											type = TYPE_FILE
										][
											char: as red-char! value
											char/header: TYPE_CHAR
											char/value: string/rs-abs-at as red-string! input p/input
										][
											value: block/rs-abs-at input p/input
										]
									]
									block/rs-append blk value
								]
							]
							R_REMOVE [
								if match? [
									int/value: input/head - p/input
									input/head: p/input
									assert positive? int/value
									actions/remove input as red-value! int
								]
							]
							R_NOT [
								match?: not match?
							]
							R_COLLECT [
								unless stack/top - 2 = base [
									blk: as red-block! stack/top - 2
									assert TYPE_OF(blk) = TYPE_BLOCK
									value: stack/top - 1
									assert TYPE_OF(value) = TYPE_BLOCK
									block/rs-append blk value
									stack/pop 1
								]
							]
							R_INTO [
								s: GET_BUFFER(series)
								s/tail: s/tail - 1
								input: as red-series! s/tail - 1
								unless ended? [match?: no]
								if match? [input/head: input/head + 1]	;-- skip parsed series

								PARSE_SET_INPUT_LENGTH(cnt)
								end?: zero? cnt			;-- refresh end? flag after popping series
								s: GET_BUFFER(rules)
							]
							R_THEN [
								s/tail: s/tail - 3		;-- pop rule stack frame
								state: either match? [cmd: tail ST_NEXT_ACTION][ST_FIND_ALTERN]
								pop?: no
							]
						]
						if pop? [
							s/tail: s/tail - 3			;-- pop rule stack frame
							state:  ST_CHECK_PENDING
						]
					]
					pop?: no
				]
				ST_CHECK_PENDING [
					s: GET_BUFFER(rules)
					value: s/tail - 1

					state: either any [					;-- order of conditional expressions matters!
						zero? block/rs-length? rules
						TYPE_OF(value) <> TYPE_INTEGER
					][
						either match? [ST_NEXT_ACTION][ST_FIND_ALTERN]
					][
						ST_POP_RULE
					]
				]
				ST_DO_ACTION [
					type: TYPE_OF(value)				;-- value is used in this state instead of cmd
					switch type [						;-- allows to enter the state with cmd or :cmd (if word!)
						TYPE_WORD 	[
							if all [value <> cmd TYPE_OF(cmd) = TYPE_WORD][
								print-line "*** Parse Error: invalid word in rule"
								halt
							]
							state: ST_WORD
						]
						TYPE_BLOCK 	[
							state: ST_PUSH_BLOCK
						]
						TYPE_DATATYPE [
							dt: as red-datatype! value
							value: block/rs-head input
							match?: TYPE_OF(value) = dt/value
							state: either match? [ST_NEXT_INPUT][ST_CHECK_PENDING]
						]
						TYPE_SET_WORD [
							_context/set as red-word! value as red-value! input
							state: ST_NEXT_ACTION
						]
						TYPE_GET_WORD [
							new: as red-series! _context/get as red-word! value
							either all [
								TYPE_OF(new) = TYPE_OF(input)
								new/node = input/node
							][
								input/head: new/head
								state: ST_NEXT_ACTION
							][
								print-line "*** Parse Error: get-word refers to a different series!"
							]
						]
						TYPE_INTEGER [
							int:  as red-integer! value
							int2: as red-integer! cmd + 1
							if all [
								int2 < tail
								TYPE_OF(int2) = TYPE_WORD
							][
								int2: as red-integer! _context/get as red-word! cmd + 1
							]
							upper?: TYPE_OF(int2) = TYPE_INTEGER
							if any [
								int2 = tail
								all [upper?	int2 + 1 = tail]
								all [upper? int/value > int2/value]
							][
								print-line "*** Parse Error: invalid integer rule"
							]
							min:   int/value
							max:   either upper? [cmd: cmd + 1 int2/value][min]
							type:  R_NONE
							state: ST_PUSH_RULE

						]
						TYPE_PAREN [
							interpreter/eval as red-block! value no
							stack/pop 1
							state: ST_CHECK_PENDING
						]
						default [						;-- try to match a literal value
							state: ST_MATCH
						]
					]
				]
				ST_NEXT_INPUT [
					type: TYPE_OF(input)
					end?: either any [					;TBD: replace with ANY_STRING
						type = TYPE_STRING
						type = TYPE_FILE
					][
						string/rs-next as red-string! input
					][
						block/rs-next input
					]
					state: ST_CHECK_PENDING
				]
				ST_NEXT_ACTION [
					if cmd < tail [cmd: cmd + 1]

					state: either cmd = tail [
						ST_POP_BLOCK
					][
						value: cmd
						ST_DO_ACTION
					]
				]
				ST_MATCH [
					either end? [
						match?: no
					][
						type: TYPE_OF(input)
						end?: either any [				;TBD: replace with ANY_STRING?
							type = TYPE_STRING
							type = TYPE_FILE
						][
							match?: either TYPE_OF(value) = TYPE_BITSET [
								string/match-bitset? as red-string! input as red-bitset! value
							][
								string/match? as red-string! input value COMP_EQUAL
							]
							all [match? advance as red-string! input value]	;-- consume matched input
						][
							match?: actions/compare block/rs-head input value COMP_EQUAL
							all [match? block/rs-next input]				;-- consume matched input
						]
					]
					state: ST_CHECK_PENDING
				]
				ST_MATCH_RULE [
					either all [value = tail][
						match?: no
						state: ST_CHECK_PENDING
					][
						switch TYPE_OF(value) [
							TYPE_BLOCK	 [state: ST_PUSH_BLOCK]
							TYPE_WORD	 [state: ST_WORD rule?: all [type <> R_COLLECT type <> R_KEEP]]
							TYPE_INTEGER [state: ST_DO_ACTION]
							default [
								either min = R_NONE [
									state: either any [type = R_TO type = R_THRU][
										match?: find-token? rules input value case?
										ST_POP_RULE
									][
										ST_DO_ACTION
									]
								][
									match?: loop-token input value min max :cnt case?
									if all [not match? zero? min][match?: yes]
									s: GET_BUFFER(rules)
									s/tail: s/tail - 3		;-- pop rule stack frame
									state: ST_CHECK_PENDING
								]
								PARSE_SET_INPUT_LENGTH(cnt)
								end?: zero? cnt
							]
						]
					]
				]
				ST_FIND_ALTERN [
					s: GET_BUFFER(rules)				;-- backtrack input
					p: as positions! s/tail - 2
					input/head: p/input
					PARSE_SET_INPUT_LENGTH(cnt)
					end?: zero? cnt						;-- refresh end? flag after backtracking

					cnt: find-altern rule cmd

					state: either cnt >= 0 [
						cmd: cmd + cnt					;-- point rule head to alternative part
						match?: yes						;-- reset match? flag
						ST_NEXT_ACTION
					][
						ST_POP_BLOCK
					]
				]
				ST_WORD [
					w: as red-word! cmd
					sym: symbol/resolve w/symbol
					#if debug? = yes [
						sym*: symbol/get sym
						if verbose > 0 [print-line ["parse: " sym*/cache]]
					]
					case [
						sym = words/pipe [				;-- |
							cmd: tail
							state: ST_POP_BLOCK
						]
						sym = words/skip [				;-- SKIP
							match?: not end?
							state: ST_NEXT_INPUT
						]
						sym = words/any* [				;-- ANY
							min:   0
							max:   R_NONE
							type:  R_NONE
							state: ST_PUSH_RULE
						]
						sym = words/some [				;-- SOME
							min:   1
							max:   R_NONE
							type:  R_NONE
							state: ST_PUSH_RULE
						]
						sym = words/copy [				;-- COPY
							cmd: cmd + 1
							if any [cmd = tail TYPE_OF(cmd) <> TYPE_WORD][
								print-line "*** Parse Error: invalid COPY rule"
							]
							min:   R_NONE
							type:  R_COPY
							state: ST_PUSH_RULE
						]
						sym = words/thru [				;-- THRU
							min:   R_NONE
							type:  R_THRU
							state: ST_PUSH_RULE
						]
						sym = words/to [				;-- TO
							min:   R_NONE
							type:  R_TO
							state: ST_PUSH_RULE
						]
						sym = words/remove [			;-- REMOVE
							min:   R_NONE
							type:  R_REMOVE
							state: ST_PUSH_RULE
						]
						sym = words/break* [			;-- BREAK
							match?: yes
							break?: yes
							cmd:	cmd + 1
							pop?:	yes
							state:	ST_POP_RULE
						]
						sym = words/opt [				;-- OPT
							min:   0
							max:   1
							type:  R_NONE
							state: ST_PUSH_RULE
						]
						sym = words/keep [				;-- KEEP
							value: cmd + 1
							min:   R_NONE
							type:  either TYPE_OF(value) = TYPE_PAREN [R_KEEP_PAREN][R_KEEP]
							state: ST_PUSH_RULE
						]
						sym = words/fail [				;-- FAIL
							match?: no
							state: ST_FIND_ALTERN
						]
						sym = words/while* [			;-- WHILE
							min:   0
							max:   R_NONE
							type:  R_WHILE
							state: ST_PUSH_RULE
						]
						sym = words/into [				;-- INTO
							if TYPE_OF(input) <> TYPE_BLOCK [
								print-line "*** Parse Error: INTO can only be used on a block! value"
							]
							value: cmd + 1
							if any [
								value = tail
								TYPE_OF(value) <> TYPE_BLOCK
							][
								print-line "*** Parse Error: INTO invalid argument"
							]
							value: block/rs-head input
							type: TYPE_OF(value)
							either any [				;@@ replace by ANY_SERIES?()
								type = TYPE_BLOCK
								type = TYPE_PAREN
								type = TYPE_PATH
								type = TYPE_LIT_PATH
								type = TYPE_SET_PATH
								type = TYPE_GET_PATH
								type = TYPE_STRING
								type = TYPE_FILE
							][
								input: block/rs-append series as red-value! block/rs-head input
								min:  R_NONE
								type: R_INTO
								state: ST_PUSH_RULE
							][
								match?: no
								state: ST_CHECK_PENDING
							]
						]
						sym = words/insert [			;-- INSERT
							w: as red-word! cmd + 1
							max: as-integer all [
								(as red-value! w) < tail
								TYPE_OF(w) = TYPE_WORD
								words/only = symbol/resolve w/symbol
							]
							cmd: cmd + max + 1
							actions/insert input cmd null max = 1 null no
							state: ST_NEXT_ACTION
						]
						sym = words/end [				;-- END
							PARSE_SET_INPUT_LENGTH(cnt)
							match?: zero? cnt
							state: ST_POP_RULE
						]
						sym = words/then [				;-- THEN
							if cmd + 1 = tail [
								print-line "*** Parse Error: THEN requires an argument rule"
							]
							min:   R_NONE
							type:  R_THEN
							state: ST_PUSH_RULE
						]
						sym = words/if* [				;-- IF
							cmd: cmd + 1
							if any [cmd = tail TYPE_OF(cmd) <> TYPE_PAREN][
								print-line "*** Parse Error: IF requires a paren argument"
							]
							interpreter/eval as red-block! cmd no
							match?: logic/top-true?
							stack/pop 1
							state: ST_CHECK_PENDING
						]
						sym = words/not* [				;-- NOT
							min:   R_NONE
							type:  R_NOT
							state: ST_PUSH_RULE
						]
						sym = words/quote [				;-- QUOTE
							cmd: cmd + 1
							if cmd = tail [
								print-line "*** Parse Error: missing QUOTE argument"
							]
							value: cmd
							state: ST_MATCH
						]
						sym = words/collect [			;-- COLLECT
							collect?: yes
							block/push* 8
							min:   R_NONE
							type:  R_COLLECT
							state: ST_PUSH_RULE
						]
						sym = words/reject [			;-- REJECT
							match?: no
							break?: yes
							pop?:	yes
							state:	ST_POP_RULE
						]
						sym = words/set [				;-- SET
							cmd: cmd + 1
							if any [cmd = tail TYPE_OF(cmd) <> TYPE_WORD][
								print-line "*** Parse Error: invalid COPY rule"
							]
							min:   R_NONE
							type:  R_SET
							state: ST_PUSH_RULE
						]
						sym = words/none [				;-- NONE
							match?: yes
							state: ST_CHECK_PENDING
						]
						true [
							value: _context/get w
							state: either rule? [ST_MATCH_RULE][ST_DO_ACTION] ;-- enable fast loops for word argument
							rule?: no
						]
					]
				]
				ST_END [
					if match? [match?: cmd = tail]

					PARSE_SET_INPUT_LENGTH(cnt)
					if all [
						cnt > 0
						1 = block/rs-length? series
					][
						match?: no
					]
					state: ST_EXIT
				]
			]
			state = ST_EXIT
		]

		block/clear series
		block/clear rules
		restore-stack

		either collect? [
			base + 1
		][
			as red-value! logic/push match?
		]
	]

	init: does [
		series: block/make-in root 8
		rules:  block/make-in root 100
	]
]


fix to make stop via publish socket work again .. but still blocking the interface because takes undefined time until subscribers are connected

Red [
	Title:		"MONICA ZeroMQ control client"
	Author:		"Michael Berg-Mohnicke"
	Rights:		"Copyright (C) Leibniz Centre for Agricultural Landscape Research (ZALF)"
	License: {
		This Source Code Form is subject to the terms of the Mozilla Public
		License, v. 2.0. If a copy of the MPL was not distributed with this
		file, You can obtain one at http://mozilla.org/MPL/2.0/.
	}
	Needs: 'View
	;Needs*: {
	;	Red >= 0.4.3
	;	%ZeroMQ-binding.red
	;}
	Based-on: "ZeroMQ request/reply client example by Kaj de Vos"
	Tabs:		4
]

#include %../../../sys-libs/red/ZeroMQ-binding/ZeroMQ-binding.red

;prin ["0MQ version:" major-version]
;	prin #"."  prin minor-version
;	prin #"."  print patch-version
;prin newline

timeout-ms: 3000
use-timeouts: false
set-timeouts: function [socket][
	set-integer socket send-timeout timeout-ms
	set-integer socket receive-timeout timeout-ms
]

defaults: [
	proxy-address "localhost"
	proxy-frontend-port 5555
	proxy-backend-port 5566
	control-address "tcp://localhost:8888"
	publisher-control-address "tcp://localhost:8899"
	input-address "tcp://localhost:6666"
	output-address "tcp://localhost:7777"
	service-port 6666
]

;address: any [get-argument 1 tcp://localhost:8888]
stop-msg-template: {{"type": "finish"}}
stop-pub-msg-template: {finish{"type": "finish"}}

control-stop-msg-template: {
	{	"type": "finish"
	,	"count": <count>
	}
}

service-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"service-port": <service-port>
	}
}

proxy-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"proxy-address": "<proxy-address>"
	, 	"proxy-frontend-port": <proxy-frontend-port>
	,	"proxy-backend-port": <proxy-backend-port>
	}
}

pipeline-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"input-addresses": "<input-addresses>"
	,	"output-addresses": "<output-addresses>"
	}
}

log-error: does [  ; FIXME: should go to stderr
	;print ["system-error: " system-error]
	print form-error system-error
]

log?: false
log: function [out][
	if log? [print out]
]

send-msg: function [socket msg][
	log ["Sending request"]

	either send socket msg [
		log ["Sent message: " msg]
	][
		log-error
	]
]

receive-msg: function [socket /debug][
	data: ""

	log ["Receiving msg"]

	either receive/over socket data [
		log ["Received message: " data]
	][
		log-error
	]
	data
]

comment {
#system [
	i: 1
	;pi: declare pointer! [integer!]
	pi: :i
	#define h! [pointer! [integer!]]

	i!: alias struct! [d [integer!]]
	si: declare i!

	si/d: 2

	print ["i: " i " pi: " pi " pi as i!: " as i! pi " si: " si " si as h!: " as h! si]

	h: 0
	hs: "0xFF"
	success: parse-hex hs :h
	print ["success?: " success " hs: " hs " h: " h]

]
}

def: function ['k][
	;print k
	v: select defaults k
	either any [
		(type? v) = string!
		v = none
	] [v] [to string! v]
]

replace-multi: function [template multi][
	t: copy template
	foreach [k v] multi [replace t k v v]
	t
]

connect-to: function [address cf dcf][
	either connect socket address [
		cf/enable?: false
		dcf/enable?: true
	][
		log-error
		cf/enable?: false
		dcf/enable?: true
	]
]

disconnect-from: function [cf dcf][
	lep: get-string socket last-endpoint
	either all [
		not empty? lep
		disconnect socket lep
	][
		cf/enable?: true
		dcf/enable?: false
	][
		;log-error
		cf/enable?: true
		dcf/enable?: false
	]
]

stop: function [address count][
	either zero? stopSocket: open-socket pool request! [
		log-error
	][
		if use-timeouts [set-timeouts stopSocket]

		loop count [
			either connect stopSocket address [
				send-msg stopSocket stop-msg-template
				receive-msg stopSocket
				disconnect stopSocket get-string stopSocket last-endpoint
			][
				log-error
			]
		]
	]
	unless close-socket stopSocket [log-error]
]

stop-via-pub: function [port /delay secs][
	either zero? stopSocket: open-socket pool publish! [
		log-error
	][
		if use-timeouts [set-timeouts stopSocket]

		address: replace-multi "tcp://*:port" reduce ["port" port]

		either serve stopSocket address [

			; try sending finish messages for 60 * delay seconds
			loop 30 [
				;print "now waiting to publish finish message"
				wait any [secs 1] ;wait 2 seconds for subscribers to connect

				send-msg stopSocket stop-pub-msg-template
			]

			if not unbind stopSocket get-string stopSocket last-endpoint [log-error]
		][
			log-error
		]
	]
	unless close-socket stopSocket [log-error]
]

either zero? pool: make-pool 1 [
	log-error
][
	either zero? socket: open-socket pool request! [
		log-error
	][
		if use-timeouts [set-timeouts socket]

		view compose/deep [
			title "MONICA ZeroMQ control client"

			across
			text "Control node address:" control-address: field 150 (def control-address)
			return

			check "Use timeouts" data (use-timeouts) [
				if use-timeouts: face/data [set-timeouts socket]
			]
			con: button "connect" [connect-to control-address/text con discon]
			discon: button "disconnect" disabled [disconnect-from con discon]
			return

			type: drop-down "start-new" data ["start-new" "start-max" "stop"] select 1
			count: field "1" text "MONICA instances"
			return

			text "Publisher control address(es):" pub-control-addresses: field 150 (def publisher-control-address)
			;text "wait for" pub-send-delay: field "2" text "seconds"
			return

			below
			tp: tab-panel [
				"Pipeline" [
					across
					text "Input address(es):" input-addresses: field 150 (def input-address)
					return
					text "Output address(es):" output-addresses: field 150 (def output-address)
					return
					button "action" react [face/text: type/text face/enable?: not con/enable?] [
						;print input-addresses/text
						m: replace-multi pipeline-msg-template reduce [
							"<type>" type/text
							"<count>" to integer! count/data
							"<control-addresses>" pub-control-addresses/text
							"<input-addresses>" input-addresses/text
							"<output-addresses>" output-addresses/text
						]
						;print m
						send-msg socket m
						receive-msg socket
					]
					button "stop" [
						stop-via-pub/delay to integer! first parse pub-control-addresses/text [
							collect [some ["tcp://" thru ":" keep [to "," | thru end] opt ","]]
						] 1 ;to integer! pub-send-delay/text
					]
				]
				"Proxy" [
					across
					text "Proxy address:" proxy-address: field (def proxy-address)
					text "frontend-port:" frontend-port: field (def proxy-frontend-port)
					text "backend-port:" backend-port: field (def proxy-backend-port)
					return
					button "action" react [face/text: type/text face/enable?: not con/enable?] [
						m: replace-multi proxy-msg-template reduce [
							"<type>" type/text
							"<count>" to integer! count/data
							"<control-address>" pub-control-addresses/text
							"<proxy-address>" proxy-address/text
							"<proxy-frontend-port>" to integer! frontend-port/data
							"<proxy-backend-port>" to integer! backend-port/data
						]
						send-msg socket m
						receive-msg socket
					]
					button "stop" [
						stop proxy-address/text to integer! frontend-port/data to integer! count/data
					]
				]
				"Single-service" [
					across
					text "Service port:" service-port: field (def service-port)
					return
					button "action" react [face/text: type/text face/enable?: not con/enable?] [
						m: replace-multi service-msg-template reduce [
							"<type>" type/text
							"<count>" to integer! count/data
							"<control-address>" pub-control-addresses/text
							"<service-port>" to integer! service-port/data
						]
						send-msg socket m
						receive-msg socket
					]
					button "stop" [
						stop control-address/text to integer! service-port/data 1
					]
				]
			]
			do [
				;connect-to control-address/text control-port/text con discon
				self/actors: object [on-close: func [f e] [
					disconnect-from con discon
				]]
			]
		]
		unless close-socket socket [log-error]
	]
	unless end-pool pool [log-error]
]

Red [
	Title:		"MONICA ZeroMQ control client"
	Author:		"Michael Berg-Mohnicke"
	Rights:		"Copyright (C) Leibniz Centre for Agricultural Landscape Research (ZALF)"
	License: {
		This Source Code Form is subject to the terms of the Mozilla Public
		License, v. 2.0. If a copy of the MPL was not distributed with this
		file, You can obtain one at http://mozilla.org/MPL/2.0/.
	}
	Needs: 'View
	;Needs*: {
	;	Red >= 0.4.3
	;	%ZeroMQ-binding.red
	;}
	Based-on: "ZeroMQ request/reply client example by Kaj de Vos"
	Tabs:		4
]

#include %../../../sys-libs/red/ZeroMQ-binding/ZeroMQ-binding.red

;prin ["0MQ version:" major-version]
;	prin #"."  prin minor-version
;	prin #"."  print patch-version
;prin newline

timeout-ms: 3000
use-timeouts: false
set-timeouts: function [socket][
	set-integer socket send-timeout timeout-ms
	set-integer socket receive-timeout timeout-ms
]

defaults: [
	proxy-address "localhost"
	proxy-frontend-port 5555
	proxy-backend-port 5566
	control-address "tcp://localhost:8888"
	publisher-control-address "tcp://localhost:8899"
	input-address "tcp://localhost:6666"
	output-address "tcp://localhost:7777"
	service-port 6666
]

;address: any [get-argument 1 tcp://localhost:8888]
stop-msg-template: {{"type": "finish"}}
stop-pub-msg-template: {finish{"type": "finish"}}

control-stop-msg-template: {
	{	"type": "finish"
	,	"count": <count>
	}
}

service-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"service-port": <service-port>
	}
}

proxy-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"proxy-address": "<proxy-address>"
	, 	"proxy-frontend-port": <proxy-frontend-port>
	,	"proxy-backend-port": <proxy-backend-port>
	}
}

pipeline-msg-template: {
	{	"type": "<type>"
	,	"count": <count>
	,	"control-addresses": "<control-addresses>"
	,	"input-addresses": "<input-addresses>"
	,	"output-addresses": "<output-addresses>"
	}
}

log-error: does [  ; FIXME: should go to stderr
	;print ["system-error: " system-error]
	print form-error system-error
]

log?: false
log: function [out][
	if log? [print out]
]

send-msg: function [socket msg][
	log ["Sending request"]

	either send socket msg [
		log ["Sent message: " msg]
	][
		log-error
	]
]

receive-msg: function [socket /debug][
	data: ""

	log ["Receiving msg"]

	either receive/over socket data [
		log ["Received message: " data]
	][
		log-error
	]
	data
]

comment {
#system [
	i: 1
	;pi: declare pointer! [integer!]
	pi: :i
	#define h! [pointer! [integer!]]

	i!: alias struct! [d [integer!]]
	si: declare i!

	si/d: 2

	print ["i: " i " pi: " pi " pi as i!: " as i! pi " si: " si " si as h!: " as h! si]

	h: 0
	hs: "0xFF"
	success: parse-hex hs :h
	print ["success?: " success " hs: " hs " h: " h]

]
}

def: function ['k][
	;print k
	v: select defaults k
	either any [
		(type? v) = string!
		v = none
	] [v] [to string! v]
]

replace-multi: function [template multi][
	t: copy template
	foreach [k v] multi [replace t k v v]
	t
]

connect-to: function [address cf dcf][
	either connect socket address [
		cf/enable?: false
		dcf/enable?: true
	][
		log-error
		cf/enable?: false
		dcf/enable?: true
	]
]

disconnect-from: function [cf dcf][
	lep: get-string socket last-endpoint
	either all [
		not empty? lep
		disconnect socket lep
	][
		cf/enable?: true
		dcf/enable?: false
	][
		;log-error
		cf/enable?: true
		dcf/enable?: false
	]
]

stop: function [address count][
	either zero? stopSocket: open-socket pool request! [
		log-error
	][
		if use-timeouts [set-timeouts stopSocket]

		loop count [
			either connect stopSocket address [
				send-msg stopSocket stop-msg-template
				receive-msg stopSocket
				disconnect stopSocket get-string stopSocket last-endpoint
			][
				log-error
			]
		]
	]
	unless close-socket stopSocket [log-error]
]

stop-via-pub: function [port][
	either zero? stopSocket: open-socket pool publish! [
		log-error
	][
		if use-timeouts [set-timeouts stopSocket]

		address: replace-multi "tcp://127.0.0.1:port" reduce ["port" port]

		either serve stopSocket address [
			;print "now waiting to publish finish message"
			wait 2 ;wait 2 seconds for subscribers to connect

			send-msg stopSocket stop-pub-msg-template

			if not unbind stopSocket get-string stopSocket last-endpoint [log-error]
		][
			log-error
		]
	]
	unless close-socket stopSocket [log-error]
]

either zero? pool: make-pool 1 [
	log-error
][
	either zero? socket: open-socket pool request! [
		log-error
	][
		if use-timeouts [set-timeouts socket]

		view compose/deep [
			title: "MONICA ZeroMQ control client"

			across
			text "Control node address:" control-address: field 150 (def control-address)
			return

			check "Use timeouts" data (use-timeouts) [
				if use-timeouts: face/data [set-timeouts socket]
			]
			con: button "connect" [connect-to control-address/text con discon]
			discon: button "disconnect" disabled [disconnect-from con discon]
			return

			type: drop-down "start-new" data ["start-new" "start-max" "stop"] select 1
			count: field "1" text "MONICA instances"
			return

			text "Publisher control address(es):" pub-control-addresses: field 150 (def publisher-control-address)
			return

			below
			tp: tab-panel [
				"Pipeline" [
					across
					text "Input address(es):" input-addresses: field 150 (def input-address)
					return
					text "Output address(es):" output-addresses: field 150 (def output-address)
					return
					button "action" react [face/text: type/text face/enable?: not con/enable?] [
						;print input-addresses/text
						m: replace-multi pipeline-msg-template reduce [
							"<type>" type/text
							"<count>" to integer! count/data
							"<control-addresses>" pub-control-addresses/text
							"<input-addresses>" input-addresses/text
							"<output-addresses>" output-addresses/text
						]
						;print m
						send-msg socket m
						receive-msg socket
					]
					button "stop" [
						stop-via-pub to integer! first parse pub-control-addresses/text [
							collect [some ["tcp://" thru ":" keep [to "," | thru end] opt ","]]
						]
					]
				]
				"Proxy" [
					across
					text "Proxy address:" proxy-address: field (def proxy-address)
					text "frontend-port:" frontend-port: field (def proxy-frontend-port)
					text "backend-port:" backend-port: field (def proxy-backend-port)
					return
					button "action" react [face/text: type/text face/enable?: not con/enable?] [
						m: replace-multi proxy-msg-template reduce [
							"<type>" type/text
							"<count>" to integer! count/data
							"<control-address>" pub-control-addresses/text
							"<proxy-address>" proxy-address/text
							"<proxy-frontend-port>" to integer! frontend-port/data
							"<proxy-backend-port>" to integer! backend-port/data
						]
						send-msg socket m
						receive-msg socket
					]
					button "stop" [
						stop proxy-address/text to integer! frontend-port/data to integer! count/data
					]
				]
				"Single-service" [
					across
					text "Service port:" service-port: field (def service-port)
					return
					button "action" react [face/text: type/text face/enable?: not con/enable?] [
						m: replace-multi service-msg-template reduce [
							"<type>" type/text
							"<count>" to integer! count/data
							"<control-address>" pub-control-addresses/text
							"<service-port>" to integer! service-port/data
						]
						send-msg socket m
						receive-msg socket
					]
					button "stop" [
						stop control-address/text to integer! service-port/data 1
					]
				]
			]
			do [
				;connect-to control-address/text control-port/text con discon
				self/actors: object [on-close: func [f e] [
					disconnect-from con discon
				]]
			]
		]
		unless close-socket socket [log-error]
	]
	unless end-pool pool [log-error]
]


FIX: Minor formatting fixes

FIX: Minor formatting fixes

Red/System [
	Title:   "Red/System OS-independent runtime"
	Author:  "Nenad Rakocevic"
	File: 	 %start.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
	}
]

#include %lib-names.reds

__stack!: alias struct! [
	top		[pointer! [integer!]]
	frame	[pointer! [integer!]]
]

system: declare struct! [							;-- trimmed down temporary system definition
	stack		[__stack!]							;-- stack virtual access
]

#switch OS [
	Linux [
		#import [LIBC-file cdecl [
			libc-start: "__libc_start_main" [
				main 			[function! []]
				argc 			[integer!]
				argv 			[pointer! [integer!]]
				init 			[function! []]
				finish 			[function! []]
				loader-finish 	[function! []]
				stack-end 		[pointer! [integer!]]
			]
		]]

		system/stack/frame: as pointer! [integer!] 0
		***__argc: pop
		***__argv: system/stack/top
		system/stack/top: as pointer! [integer!] (FFFFFFF0h and as integer! ***__argv)

		libc-start :***-start ***__argc ***__argv null null null ***__argv
	]
]

Red/System [
	Title:   "Red/System OS-independent runtime"
	Author:  "Nenad Rakocevic"
	File: 	 %start.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
	}
]

#include %lib-names.reds

__stack!: alias struct! [
	top		[pointer! [integer!]]
	frame	[pointer! [integer!]]
]

system: declare struct! [							;-- trimmed down temporary system definition
	stack		[__stack!]							;-- stack virtual access
]

#switch OS [
	Linux [
		#import [LIBC-file cdecl [
			libc-start: "__libc_start_main" [
				main 			[function! []]
		        argc 			[integer!]
				argv 			[pointer! [integer!]]
				init 			[function! []]
				finish 			[function! []]
				loader-finish 	[function! []]
				stack-end 		[pointer! [integer!]]
			]
		;   _init: "__libc_csu_init" []
		;   _finish: "__libc_csu_fini" []
		]]

		system/stack/frame: as pointer! [integer!] 0
		***__argc: pop
		***__argv: system/stack/top
		system/stack/top: as pointer! [integer!] (FFFFFFF0h and as integer! ***__argv)

		libc-start :***-start ***__argc ***__argv null null null ***__argv
	]
]


FEAT: minor comments re-indenting.

FEAT: minor comments re-indenting.

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

sigaction!: alias struct! [
	handler		[integer!]					;-- Warning: compiled as union on most UNIX
	mask0		[integer!]					;-- glibc/Hurd insane inheritage...
	mask1		[integer!]
	mask2		[integer!]
	mask3		[integer!]
	mask4		[integer!]
	mask5		[integer!]
	mask6		[integer!]
	mask7		[integer!]
	mask8		[integer!]
	mask9		[integer!]
	mask10		[integer!]
	mask11		[integer!]
	mask12		[integer!]
	mask13		[integer!]
	mask14		[integer!]
	mask15		[integer!]
	mask16		[integer!]
	mask17		[integer!]
	mask18		[integer!]
	mask19		[integer!]
	mask20		[integer!]
	mask21		[integer!]
	mask22		[integer!]
	mask23		[integer!]
	mask24		[integer!]
	mask25		[integer!]
	mask26		[integer!]
	mask27		[integer!]
	mask28		[integer!]
	mask29		[integer!]
	mask30		[integer!]
	mask31		[integer!]
	flags		[integer!]
]

siginfo!: alias struct! [
	signal		[integer!]
	error		[integer!]
	code		[integer!]
	address		[integer!]					;-- this field is a C union, dependent on signal
]

#import [									;-- mandatory C bindings
	LIBC-file cdecl [
		sigaction: "sigaction" [
			signum	[integer!]
			action	[sigaction!]
			oldact	[sigaction!]
			return: [integer!]
		]
	]
]

stdin:  0
stdout: 1
stderr: 2

#if use-natives? = yes [
	prin: func [s [c-string!] return: [integer!]][
		write stdout s length? s
	]
]

;====== Catching runtime errors ======

;; sources:
;;		http://www.kernel.org/doc/man-pages/online/pages/man2/sigaction.2.html
;; 		http://fxr.watson.org/fxr/source/include/asm-generic/siginfo.h?v=linux-2.6;im=excerpts#L161

#define	SIGILL		 4						;-- Illegal instruction
#define SIGBUS		 7						;-- Bus access error
#define	SIGFPE		 8						;-- Floating point error
#define	SIGSEGV		11						;-- Segmentation violation

#switch target [
	IA-32 [
		_ucontext!: alias struct! [
			flags 		[integer!]
			link		[_ucontext!]
			ss_sp		[byte-ptr!]			;-- stack_t struct inlined
			ss_flags	[integer!]
			ss_size		[integer!]
			gs			[integer!]			;-- sigcontext struct inlined
			fs			[integer!]
			es			[integer!]
			ds			[integer!]
			edi			[integer!]
			esi			[integer!]
			ebp			[integer!]
			esp			[integer!]
			ebx			[integer!]
			edx			[integer!]
			ecx			[integer!]
			eax			[integer!]
			trapno		[integer!]
			err			[integer!]
			eip			[integer!]
			cs			[integer!]
			eflags		[integer!]
			esp_at_sig	[integer!]
			ss			[integer!]
			fpstate		[int-ptr!]
			oldmask		[integer!]
			cr2			[integer!]
			;sigmask	[...]				;-- 128 byte array ignored
		]
	]
	ARM [
		_ucontext!: alias struct! [
			flags 		[integer!]
			link		[_ucontext!]
			ss_sp		[byte-ptr!]			;-- stack_t struct inlined
			ss_flags	[integer!]
			ss_size		[integer!]
			trap_no		[integer!]
			error_code	[integer!]
			oldmask		[integer!]
			arm_r0		[integer!]
			arm_r1		[integer!]
			arm_r2		[integer!]
			arm_r3		[integer!]
			arm_r4		[integer!]
			arm_r5		[integer!]
			arm_r6		[integer!]
			arm_r7		[integer!]
			arm_r8		[integer!]
			arm_r9		[integer!]
			arm_r10		[integer!]
			arm_fp		[integer!]
			arm_ip		[integer!]
			arm_sp		[integer!]
			arm_lr		[integer!]
			arm_pc		[integer!]
			arm_cpsr	[integer!]
			fault_address [integer!]
			;sigmask	[...]				;-- 128 byte array ignored
		]
	]
]

***-on-signal: func [
	[cdecl]
	signal	[integer!]
	info	[siginfo!]
	ctx		[_ucontext!]
	/local code error
][
	error: 99								;-- default unknown error
	code: info/code

	error: switch signal [
		SIGILL [
			switch code [
				1 [17]						;-- illegal opcode
				2 [23]						;-- illegal operand
				3 [24]						;-- illegal addressing mode
				4 [25]						;-- illegal trap
				5 [15]						;-- privileged opcode
				6 [31]						;-- privileged register
				7 [26]						;-- coprocessor error
				8 [19]						;-- internal stack error
				default [99]
			]
		]
		SIGBUS [
			switch code [
				1 [2]						;-- invalid address alignment
				2 [27]						;-- non-existant physical address
				3 [28]						;-- object specific hardware error
				4 [29]						;-- hardware memory error consumed (action required)
				5 [30]						;-- hardware memory error consumed (action optional)
				default [34]
			]
		]
		SIGFPE [
			switch code [
				1 [13]						;-- integer divide by zero
				2 [14]						;-- integer overflow
				3 [7]						;-- floating point divide by zero
				4 [10]						;-- floating point overflow
				5 [12]						;-- floating point underflow
				6 [8]						;-- floating point inexact result
				7 [9]						;-- floating point invalid operation
				8 [5]						;-- subscript out of range
				default [33]
			]
		]
		SIGSEGV [
			switch code [
				1 [1]						;-- address not mapped to object
				2 [16]						;-- invalid permissions for mapped object
				default [32]
			]
		]
	]

	#switch target [
		IA-32 [***-on-quit error ctx/eip]
		ARM	  [***-on-quit error ctx/arm_pc]
	]
]

__sigaction-options: declare sigaction!

__sigaction-options/handler: 	as-integer :***-on-signal
__sigaction-options/flags: 		SA_SIGINFO ;or SA_RESTART

sigaction SIGILL  __sigaction-options as sigaction! 0
sigaction SIGBUS  __sigaction-options as sigaction! 0
sigaction SIGFPE  __sigaction-options as sigaction! 0
sigaction SIGSEGV __sigaction-options as sigaction! 0