r548: updated to trigger documentation

r548: updated to trigger documentation

h1. Manual

This is the CruiseControl.rb manual. If you can't find what you're looking for here, make sure to look at the docs
for "plugins":/documentation/plugins or just "contact us":/documentation/contact_us

h1. Files and folders

If CC.rb is unpacked into [cruise] directory , then:

* [cruise]/projects/ is the projects directory.

* [cruise]/projects/your_project/ is a directory for the project called "your_project".

* [cruise]/projects/your_project/work/ is a local copy of your_project's source code. Builder keeps it up to date
  with the source control repository and runs builds against it.

* [cruise]/projects/your_project/build-123/ contains build status file, list of changed files,
  and other "build artifacts" created while building revision 123.

* [cruise]/projects/your_project/cruise_config.rb is builder configuration for your_project.

* [cruise]/config/site_config.rb is the file where you can make centralized changes to the configuration of dashboard
  and all builders.

h1. Site configuration

CruiseControl.rb package includes a file called [cruise]/config/site_config.rb.example. By copying it to
[cruise]/config/site_config.rb, and uncommenting some lines you can change a number of parameters not related to
a specific project. In normal life, your only reason to do it would be configuring SMTP connection, for sending
email notices. See the section on "Build monitoring via email" below.

h1. Project builder configuration

When you add a project to it, CruiseControl.rb will try to do something reasonable without any configuration.

However, there are things that builder cannot know in advance. For example, who needs to receive an email notice
when the build is broken? The default answer is "nobody", and it may be good enough if you use
"CCTray":http://ccnet.sourceforge.net/CCNET/CCTray.html or have an LCD panel displaying the dashboard on the wall of
your office to monitor the build status.

What if it's not good enough? To make the builder aware of all these other things that you want it to do, you will
have to write them down in a project configuration file.

Rolling your eyes already? Hold on, this is not J2EE deployment descriptors we are talking about. No two pages of
hand-crafted angled brackets just to get started here. A typical project configuration is about 3 to 5 lines of very
simple Ruby. Yes, the configuration language of CC.rb is Ruby.

As you add a project, a configuration file is created for you in [cruise]/projects/your_project/ directory. It's named
cruise_config.rb and almost everything in it is initially commented out. In fact, you can delete it and this will not
change anything. There are two lines not commented out:

Project.configure do |project|
end

Every cruise_config.rb must have these two lines. All your other configuration goes between them.

You can move cruise_config.rb to [cruise]/projects/your_project/work/ directory. In other words, check it into
Subversion, in the root directory of your project. Storing your CruiseControl.rb configuration in your project's version control
is usually a smart thing to do.

It is also possible to have two cruise_config.rb files for a project, one in the [cruise]/projects/your_project/
directory, and the other in version control. CruiseControl.rb loads both files, but settings from cruise_config.rb in
[cruise]/projects/your_project/ override those stored in version control. This can be useful when you want to see the
effect of some configuration settings without checking them in, or have some local settings for this installation.

p(hint). Hint: configuration examples below include lines that look like '...' This represents other
         configuration statements that may be in cruise_config.rb. You are not meant to copy-paste those dots into
         your configuration file. If you do, ./cruise start will fail to start, saying something about
         syntax error (SyntaxError). Understandably, ... is not a valid Ruby expression.

Since configuration files are written in a real programming language (Ruby), you can modularize them, use
logical statements, and generally do whatever makes sense. For example, consider the following snippet:

Project.configure do |project|
  case project.name
  when 'MyProject.Quick' then project.rake_task = 'test:units'
  when 'MyProject.BigBertha' then project.rake_task = 'cruise:all_tests'
  else raise "Don't know what to build for project #{project.name.inspect}"
  end
end

p(hint). Use code like above to source-control configuration of multiple CruiseControl.rb projects building the same codebase.

h1. What will it build by default?

Unless told otherwise, CruiseControl.rb will search for "Rake":http://rake.rubyforge.org/ build file in your project. Then
it will try to execute cruise task and stop right there, if cruise task is defined in your
build.

p(hint). If you don't want to leave the question "how to build this project?" to CruiseControl's best guesses
         just define cruise task in your build explicitly.

If there is no cruise task anywhere in sight, CruiseControl.rb will try to perform standard
Rails tasks that prepare a test database by deleting everything from it and executing
"migration":http://www.rubyonrails.org/api/classes/ActiveRecord/Migration.html scripts from your_project/db/migrate.
Finally, it will run all your automated tests.

p(hint). WARNING: with Rails projects, it is important that RAILS_ENV does not default to 'production'.
         Unless you want your migration scripts and unit tests to hit your production database, of course.
         CruiseControl.reb leaves this variable unchanged when invoking 'cruise' or other custom Rake task, and sets
         it to 'test' before invoking the defaults.

h1. How can I change what the build does?

cruise may be the task for a quick build, but you may also want to run a long build with all acceptance
tests included. This can be done by assigning the project.rake_task attribute in cruise_config.rb:

Project.configure do |project|
  ...
  project.rake_task = 'Big_Bertha_build'
  ...
end

p(hint). Hint: When you have two builds for the same projects, and want to run them on the same build server, it
         actually takes more than just a different Rake task. At the very least, you want to have separate databases
         for those two builds. You can achieve this by creating a separate environment and setting RAILS_ENV to it in
         your Rakefile. Copy config/environments/test.rb to config/environments/big_bertha.rb, add a :Big_Bertha_init
         Rake task with ENV['RAILS_ENV'] = 'big_bertha' in it, and put it in the beginning of
         :Big_Bertha_build list of depenedencies.

p(hint). Hint: Ideally, you'd also want some way to chain builds so that the long build for a new checkin is only
         launched once the short build has finished succesfully. For now, you can achieve something like this with a
         custom scheduler. CruiseControl.rb team intends to provide built-in support for this scenario in some future
         version.

Or you may not want to deal with Rake at all, but build your project by "make":http://www.gnu.org/software/make/,
"Ant":http://ant.apache.org/ or "MSBuild":http://msdn2.microsoft.com/en-us/library/wea2sca5.aspx.
Yes, CC.rb can deal with non-Ruby projects! We are running "JBehave":http://jbehave.org/ build on
our "demo site":http://cruisecontrolrb.thoughtworks.com/builds/JBehave to prove the point.

A custom build command can be set in project.build_command attribute. Modify cruise_config.rb file like
this:

Project.configure do |project|
  ...
  project.build_command = 'my_build_script.sh'
  ...
end

If project.build_command is set, CC.rb will change current working directory to
[cruise]/projects/your_project/work/, invoke specified command and look at the exit code to determine whether the
build passed or failed.

p(hint). You cannot specify both rake_task and build_command attributes in cruise_config.rb.
        It doesn't make sense, anyway.

h1. What should I do with custom build artifacts?

your_project may have a special build task, producing some output that you want to keep, and see on
the build page.

p(hint). Hint: Code coverage analysis is a good example of custom build output. CruiseControl.rb's own build uses
         "rcov":http://eigenclass.org/hiki.rb. If you drill down into a recent CC.rb build on
         "http://cruisecontrolrb.thoughtworks.com":http://cruisecontrolrb.thoughtworks.com, you can see links
         to test coverage reports.

Before running the build, CC.rb sets OS variable CC_BUILD_ARTIFACTS to the directory
where the build artifacts are collected. Make sure that your special task writes its output to that directory, or a
subdirectory under that directory.

The build page includes links to every file or subdirectory found in the build artifacts directory.

h1. Build scheduling

By default, the builder polls Subversion every 10 seconds for new revisions. This can be changed by adding the
following line to cruise_config.rb:

Project.configure do |project|
  ...
  project.scheduler.polling_interval = 5.minutes
  ...
end

What if you want a scheduler with some interesting logic? Well, a default scheduler can be substituted by placing
your own scheduler implementation intpo the plugins directory and writing in cruise_config.rb something like this:

Project.configure do |project|
  ...
  project.scheduler = MyCustomScheduler.new(project)
  ...
end

After initializing everything, and loading the project (this step includes evaluation of cruise_config.rb), the
builder invokes project.scheduler.run. A builder must be able to detect when its configuraton has changed, or when a
build is requested by user (pressing the Build Now button), so a custom scheduler needs to know how to recognize that situation.

Look at [cruise]/app/models/polling_scheduler.rb to understand how a scheduler interacts with a project.

h1. Deleting a project

To remove your_project from CruiseControl.rb, kill its builder process and then delete the [cruise]/projects/your_project/
directory.

h1. Build Chaining & Triggers

CC.rb uses triggers to tell it when to build a project.  Every project by default has a ChangeInSourceControl trigger, that tells it to build when (surprise) it detects a change in a project's source control.

However, you can add additional triggers or replace that trigger entirely.  For example, you can have one project's successful build trigger another project's build with our SuccessfulBuildTrigger.

  project.triggered_by SuccessfulBuildTrigger.new(project, 'indie')

or in short hand

  project.triggered_by 'indie'

Why would you want one build to trigger another?  In this instance, maybe our project depends on indie and we want to know if a change to indie breaks our project.

These examples, *added* a SuccessfulBuildTrigger.  We could also *replace* the default trigger by writing

  project.triggered_by = [SuccessfulBuildTrigger.new(project, "fast_build")]

Why wouldn't we want our project to be triggered by a change to it's source code?  In this case, maybe we've separated our project into a fast and slow build.  We could use this to only trigger a slow build if the fast one passes.

In the future we expect to also support svn:external triggers.  However, the infrastructure is there for you to build your own.

h1. Environment Variables

CC.rb gives you some information to use inside your build.  It does this in the form of environment variables.  Currently, the list of environment variable is :
* CC_BUILD_REVISION - this is the revision number of the current build, it looks like "5" or "56236"
* CC_BUILD_LABEL - usually this is the same as CC_BUILD_REVISION, but if there is more than one build of a particular revision, it will have a ".n" after it, so it might look like "323", "323.2", "4236.20", etc.
* CC_BUILD_ARTIFACTS - this is the directory which the dashboard looks in.  Any files you copy into here will be available from the dashboard.

From within your build, CC.rb

h1. Remote Builds

CC.rb can run builds on remote servers.  This is done by sshing to the server in your build command.  For example:

  project.build_command = 'ssh user@server ./run_remotely.sh $CC_BUILD_REVISION'

run_remotely.sh might look something like:

  #/bin/bash
  svn up -r$1
  rake test:integration

Of course you will need to checkout the code on the remote server before running the first build.

Note that CC.rb will still maintain a checkout of the code on the local server, use it to check for modifications and store build results locally.

h1. Doing a Clean Checkout

CC.rb supports clean checkouts, though they are not the default.  To enable them, you must specify the subversion url in the cruise_config.rb and specify when they should happen.  It should look something like :

  project.source_control = Subversion.new(:url =>
                             'svn://rubyforge.org/var/svn/filesandbox/trunk')
  project.do_clean_checkout :every => 6.hours

you may also pass :always into do_clean_checkout, or any other time such as 2.days, 30.minutes, etc.

h1. Troubleshooting and support

Beware, at the time of this writing, CC.rb is quite young and may have some heinous bugs (although we do have several
thousand users, including some happy ones).  Good news is that CC.rb is simple (much, much
simpler than other CruiseControl incarnations). The dashboard is just a small Rails app, and the builder process is little
more than a dumb, single-threaded endless loop. No queues, relational databases, remoting, WS* web services or other such things.
Therefore, it's easy to debug. So, you are your own support hotline.  We do have some "tips":troubleshooting to help you get started, though :). Don't forget to send us patches, please!

OK, that was the pep talk. If you have an issue that you cannot fix on your own, subscribe to mail list
cruisecontrolrb-users@rubyforge.org and ask for help.

Should you require commercial support, training or consulting around this tool, "ThoughtWorks":http://thoughtworks.com/ can provide it to you.

h1. Documentation that we haven't written yet

We should write about ways to run CC.rb as a service on various platforms, write about various troubleshooting
techniques, document builder plugins etc.

p(hint). Hint to would-be contributors: documentation patches will be appreciated as highly as, if not higher than,
source patches.

h1. Manual

This is the CruiseControl.rb manual. If you can't find what you're looking for here, make sure to look at the docs
for "plugins":/documentation/plugins or just "contact us":/documentation/contact_us

h1. Files and folders

If CC.rb is unpacked into [cruise] directory , then:

* [cruise]/projects/ is the projects directory.

* [cruise]/projects/your_project/ is a directory for the project called "your_project".

* [cruise]/projects/your_project/work/ is a local copy of your_project's source code. Builder keeps it up to date
  with the source control repository and runs builds against it.

* [cruise]/projects/your_project/build-123/ contains build status file, list of changed files,
  and other "build artifacts" created while building revision 123.

* [cruise]/projects/your_project/cruise_config.rb is builder configuration for your_project.

* [cruise]/config/site_config.rb is the file where you can make centralized changes to the configuration of dashboard
  and all builders.

h1. Site configuration

CruiseControl.rb package includes a file called [cruise]/config/site_config.rb.example. By copying it to
[cruise]/config/site_config.rb, and uncommenting some lines you can change a number of parameters not related to
a specific project. In normal life, your only reason to do it would be configuring SMTP connection, for sending
email notices. See the section on "Build monitoring via email" below.

h1. Project builder configuration

When you add a project to it, CruiseControl.rb will try to do something reasonable without any configuration.

However, there are things that builder cannot know in advance. For example, who needs to receive an email notice
when the build is broken? The default answer is "nobody", and it may be good enough if you use
"CCTray":http://ccnet.sourceforge.net/CCNET/CCTray.html or have an LCD panel displaying the dashboard on the wall of
your office to monitor the build status.

What if it's not good enough? To make the builder aware of all these other things that you want it to do, you will
have to write them down in a project configuration file.

Rolling your eyes already? Hold on, this is not J2EE deployment descriptors we are talking about. No two pages of
hand-crafted angled brackets just to get started here. A typical project configuration is about 3 to 5 lines of very
simple Ruby. Yes, the configuration language of CC.rb is Ruby.

As you add a project, a configuration file is created for you in [cruise]/projects/your_project/ directory. It's named
cruise_config.rb and almost everything in it is initially commented out. In fact, you can delete it and this will not
change anything. There are two lines not commented out:

Project.configure do |project|
end

Every cruise_config.rb must have these two lines. All your other configuration goes between them.

You can move cruise_config.rb to [cruise]/projects/your_project/work/ directory. In other words, check it into
Subversion, in the root directory of your project. Storing your CruiseControl.rb configuration in your project's version control
is usually a smart thing to do.

It is also possible to have two cruise_config.rb files for a project, one in the [cruise]/projects/your_project/
directory, and the other in version control. CruiseControl.rb loads both files, but settings from cruise_config.rb in
[cruise]/projects/your_project/ override those stored in version control. This can be useful when you want to see the
effect of some configuration settings without checking them in, or have some local settings for this installation.

p(hint). Hint: configuration examples below include lines that look like '...' This represents other
         configuration statements that may be in cruise_config.rb. You are not meant to copy-paste those dots into
         your configuration file. If you do, ./cruise start will fail to start, saying something about
         syntax error (SyntaxError). Understandably, ... is not a valid Ruby expression.

Since configuration files are written in a real programming language (Ruby), you can modularize them, use
logical statements, and generally do whatever makes sense. For example, consider the following snippet:

Project.configure do |project|
  case project.name
  when 'MyProject.Quick' then project.rake_task = 'test:units'
  when 'MyProject.BigBertha' then project.rake_task = 'cruise:all_tests'
  else raise "Don't know what to build for project #{project.name.inspect}"
  end
end

p(hint). Use code like above to source-control configuration of multiple CruiseControl.rb projects building the same codebase.

h1. What will it build by default?

Unless told otherwise, CruiseControl.rb will search for "Rake":http://rake.rubyforge.org/ build file in your project. Then
it will try to execute cruise task and stop right there, if cruise task is defined in your
build.

p(hint). If you don't want to leave the question "how to build this project?" to CruiseControl's best guesses
         just define cruise task in your build explicitly.

If there is no cruise task anywhere in sight, CruiseControl.rb will try to perform standard
Rails tasks that prepare a test database by deleting everything from it and executing
"migration":http://www.rubyonrails.org/api/classes/ActiveRecord/Migration.html scripts from your_project/db/migrate.
Finally, it will run all your automated tests.

p(hint). WARNING: with Rails projects, it is important that RAILS_ENV does not default to 'production'.
         Unless you want your migration scripts and unit tests to hit your production database, of course.
         CruiseControl.reb leaves this variable unchanged when invoking 'cruise' or other custom Rake task, and sets
         it to 'test' before invoking the defaults.

h1. How can I change what the build does?

cruise may be the task for a quick build, but you may also want to run a long build with all acceptance
tests included. This can be done by assigning the project.rake_task attribute in cruise_config.rb:

Project.configure do |project|
  ...
  project.rake_task = 'Big_Bertha_build'
  ...
end

p(hint). Hint: When you have two builds for the same projects, and want to run them on the same build server, it
         actually takes more than just a different Rake task. At the very least, you want to have separate databases
         for those two builds. You can achieve this by creating a separate environment and setting RAILS_ENV to it in
         your Rakefile. Copy config/environments/test.rb to config/environments/big_bertha.rb, add a :Big_Bertha_init
         Rake task with ENV['RAILS_ENV'] = 'big_bertha' in it, and put it in the beginning of
         :Big_Bertha_build list of depenedencies.

p(hint). Hint: Ideally, you'd also want some way to chain builds so that the long build for a new checkin is only
         launched once the short build has finished succesfully. For now, you can achieve something like this with a
         custom scheduler. CruiseControl.rb team intends to provide built-in support for this scenario in some future
         version.

Or you may not want to deal with Rake at all, but build your project by "make":http://www.gnu.org/software/make/,
"Ant":http://ant.apache.org/ or "MSBuild":http://msdn2.microsoft.com/en-us/library/wea2sca5.aspx.
Yes, CC.rb can deal with non-Ruby projects! We are running "JBehave":http://jbehave.org/ build on
our "demo site":http://cruisecontrolrb.thoughtworks.com/builds/JBehave to prove the point.

A custom build command can be set in project.build_command attribute. Modify cruise_config.rb file like
this:

Project.configure do |project|
  ...
  project.build_command = 'my_build_script.sh'
  ...
end

If project.build_command is set, CC.rb will change current working directory to
[cruise]/projects/your_project/work/, invoke specified command and look at the exit code to determine whether the
build passed or failed.

p(hint). You cannot specify both rake_task and build_command attributes in cruise_config.rb.
        It doesn't make sense, anyway.

h1. What should I do with custom build artifacts?

your_project may have a special build task, producing some output that you want to keep, and see on
the build page.

p(hint). Hint: Code coverage analysis is a good example of custom build output. CruiseControl.rb's own build uses
         "rcov":http://eigenclass.org/hiki.rb. If you drill down into a recent CC.rb build on
         "http://cruisecontrolrb.thoughtworks.com":http://cruisecontrolrb.thoughtworks.com, you can see links
         to test coverage reports.

Before running the build, CC.rb sets OS variable CC_BUILD_ARTIFACTS to the directory
where the build artifacts are collected. Make sure that your special task writes its output to that directory, or a
subdirectory under that directory.

The build page includes links to every file or subdirectory found in the build artifacts directory.

h1. Build scheduling

By default, the builder polls Subversion every 10 seconds for new revisions. This can be changed by adding the
following line to cruise_config.rb:

Project.configure do |project|
  ...
  project.scheduler.polling_interval = 5.minutes
  ...
end

What if you want a scheduler with some interesting logic? Well, a default scheduler can be substituted by placing
your own scheduler implementation intpo the plugins directory and writing in cruise_config.rb something like this:

Project.configure do |project|
  ...
  project.scheduler = MyCustomScheduler.new(project)
  ...
end

After initializing everything, and loading the project (this step includes evaluation of cruise_config.rb), the
builder invokes project.scheduler.run. A builder must be able to detect when its configuraton has changed, or when a
build is requested by user (pressing the Build Now button), so a custom scheduler needs to know how to recognize that situation.

Look at [cruise]/app/models/polling_scheduler.rb to understand how a scheduler interacts with a project.

h1. Deleting a project

To remove your_project from CruiseControl.rb, kill its builder process and then delete the [cruise]/projects/your_project/
directory.

h1. Build Chaining & Triggers

CC.rb uses triggers to tell it when to build a project.  Every project by default has a ChangeInSourceControl trigger, that tells it to build when (surprise) it detects a change in a project's source control.

However, you can add additional triggers or replace that trigger entirely.  For example, you can have one project's successful build trigger another project's build with our SuccessfulBuildTrigger.

  project.triggered_by SuccessfulBuildTrigger.new(project, 'indie')

or in short hand

  project.triggered_by 'indie'

Why would you want one build to trigger another?  In this instance, maybe our project depends on indie and we want to know if a change to indie breaks our project.

In these examples, *added* a SuccessfulBuildTrigger.  We could also *replace* the default trigger by writing

  project.triggered_by = "fast_build"

Why wouldn't we want our project to be triggered by a change to it's source code?  In this case, maybe we've separated our project into a fast and slow build.  We could use this to only trigger a slow build if the fast one passes.

In the future we expect to also support svn:external triggers.  However, the infrastructure is there for you to build your own.

h1. Environment Variables

CC.rb gives you some information to use inside your build.  It does this in the form of environment variables.  Currently, the list of environment variable is :
* CC_BUILD_REVISION - this is the revision number of the current build, it looks like "5" or "56236"
* CC_BUILD_LABEL - usually this is the same as CC_BUILD_REVISION, but if there is more than one build of a particular revision, it will have a ".n" after it, so it might look like "323", "323.2", "4236.20", etc.
* CC_BUILD_ARTIFACTS - this is the directory which the dashboard looks in.  Any files you copy into here will be available from the dashboard.

From within your build, CC.rb

h1. Remote Builds

CC.rb can run builds on remote servers.  This is done by sshing to the server in your build command.  For example:

  project.build_command = 'ssh user@server ./run_remotely.sh $CC_BUILD_REVISION'

run_remotely.sh might look something like:

  #/bin/bash
  svn up -r$1
  rake test:integration

Of course you will need to checkout the code on the remote server before running the first build.

Note that CC.rb will still maintain a checkout of the code on the local server, use it to check for modifications and store build results locally.

h1. Doing a Clean Checkout

CC.rb supports clean checkouts, though they are not the default.  To enable them, you must specify the subversion url in the cruise_config.rb and specify when they should happen.  It should look something like :

  project.source_control = Subversion.new(:url =>
                             'svn://rubyforge.org/var/svn/filesandbox/trunk')
  project.do_clean_checkout :every => 6.hours

you may also pass :always into do_clean_checkout, or any other time such as 2.days, 30.minutes, etc.

h1. Troubleshooting and support

Beware, at the time of this writing, CC.rb is quite young and may have some heinous bugs (although we do have several
thousand users, including some happy ones).  Good news is that CC.rb is simple (much, much
simpler than other CruiseControl incarnations). The dashboard is just a small Rails app, and the builder process is little
more than a dumb, single-threaded endless loop. No queues, relational databases, remoting, WS* web services or other such things.
Therefore, it's easy to debug. So, you are your own support hotline.  We do have some "tips":troubleshooting to help you get started, though :). Don't forget to send us patches, please!

OK, that was the pep talk. If you have an issue that you cannot fix on your own, subscribe to mail list
cruisecontrolrb-users@rubyforge.org and ask for help.

Should you require commercial support, training or consulting around this tool, "ThoughtWorks":http://thoughtworks.com/ can provide it to you.

h1. Documentation that we haven't written yet

We should write about ways to run CC.rb as a service on various platforms, write about various troubleshooting
techniques, document builder plugins etc.

p(hint). Hint to would-be contributors: documentation patches will be appreciated as highly as, if not higher than,
source patches.


FIX: minor reformatting for consistency

FIX: minor reformatting for consistency

Red/System [
	Title:   "Red/System OS-independent runtime"
	Author:  "Nenad Rakocevic"
	File: 	 %common.reds
	Rights:  "Copyright (C) 2011 Nenad Rakocevic. All rights reserved."
	License: "BSD-3 - https://github.com/dockimbel/Red/blob/master/BSD-3-License.txt"
]

#define zero? 		  [0 =]
#define positive?	  [0 < ]				;-- space required after the lesser-than symbol
#define negative?	  [0 > ]
#define negate		  [0 -]

#define forever		  [while [true]]
#define does		  [func []]
#define unless		  [if not]

#define as-byte		  [as byte!]
#define as-logic	  [as logic!]
#define as-integer	  [as integer!]
#define as-c-string	  [as c-string!]

#define null-byte	  #"^(00)"
#define yes			  true
#define no			  false
#define on			  true
#define off			  false

#define byte-ptr!	  [pointer! [byte!]]
#define make-c-string [as c-string! allocate]

newline: 	"^/"
stdout:		-1								;-- uninitialized default value
stdin:		-1								;-- uninitialized default value
stderr:		-1								;-- uninitialized default value

system: struct [							;-- store runtime accessible system values
	reserved 	[integer!]					;-- place-holder to not have an empty structure
]

#switch OS [								;-- loading OS-specific bindings
	Windows  [#include %win32.reds]
	Syllable [#include %syllable.reds]
	#default [#include %linux.reds]
]

#either use-natives? = no [					;-- C bindings that have native counterparts
	#import [
		LIBC-file cdecl [
			allocate:	 "malloc" [
				size		[integer!]
				return:		[byte-ptr!]
			]
			free:		 "free" [
				block		[byte-ptr!]
			]
			set-memory:	 "memset" [
				target		[byte-ptr!]
				filler		[byte!]
				size		[integer!]
				return:		[byte-ptr!]
			]
			copy-memory: "memmove" [
				target		[byte-ptr!]
				source		[byte-ptr!]
				size		[integer!]
				return:		[byte-ptr!]
			]
			length?:	 "strlen" [
				command		[c-string!]
				return:		[integer!]
			]
		]
	]
][
	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!] /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" exit]
	s: "-2147483648"						;-- 11 bytes wide
	if i = -2147483648 [prin s exit]
	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
]

prin-hex: func [i [integer!] /local s c d][
	;-- 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" exit]
	s: "00000000"
	c: 8
	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
]

***-on-quit: func [							;-- global exit handler
	status [integer!]
	address [integer!]
	/local msg
][
	unless zero? status [
		prin "*** Runtime Error "
		prin-int status
		prin ": "

		if status =  1 [msg: "access violation"]
		if status =  2 [msg: "invalid alignment"]
		if status =  3 [msg: "breakpoint"]
		if status =  4 [msg: "single step"]
		if status =  5 [msg: "bounds exceeded"]
		if status =  6 [msg: "float denormal operan"]
		if status =  7 [msg: "float divide by zero"]
		if status =  8 [msg: "float inexact result"]
		if status =  9 [msg: "float invalid operation"]
		if status = 10 [msg: "float overflow"]
		if status = 11 [msg: "float stack check"]
		if status = 12 [msg: "float underflow"]
		if status = 13 [msg: "integer divide by zero"]
		if status = 14 [msg: "integer overflow"]
		if status = 15 [msg: "privileged instruction"]
		if status = 16 [msg: "invalid virtual address"]
		if status = 17 [msg: "illegal instruction"]
		if status = 18 [msg: "non-continuable exception"]
		if status = 19 [msg: "stack error or overflow"]
		if status = 20 [msg: "invalid disposition"]
		if status = 21 [msg: "guard page"]
		if status = 22 [msg: "invalid handle"]
		if status = 23 [msg: "illegal operand"]
		if status = 24 [msg: "illegal addressing mode"]
		if status = 25 [msg: "illegal trap"]
		if status = 26 [msg: "coprocessor error"]
		if status = 27 [msg: "non-existant physical address"]
		if status = 28 [msg: "object specific hardware error"]
		if status = 29 [msg: "hardware memory error consumed AR"]
		if status = 30 [msg: "hardware memory error consumed AO"]
		if status = 99 [msg: "unknown error"]

		prin msg

		unless zero? address [
			prin "^/*** at: "
			prin-hex address
			prin "h"
		]
		prin newline
	]
	quit status
]


FIX: cannot mold self on interpreter

FIX: cannot mold self on interpreter

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

_context: context [
	verbose: 0

	find-word: func [
		ctx		[red-context!]
		sym		[integer!]
		case?	[logic!]
		return:	[integer!]								;-- value > 0: success, value = -1: failure
		/local
			series	[series!]
			list	[red-word!]
			end		[red-word!]
	][
		series: as series! ctx/symbols/value
		list:   as red-word! series/offset
		end:    as red-word! series/tail

		either case? [
			sym: symbol/resolve sym
			while [list < end][
				if sym = symbol/resolve list/symbol [
					return (as-integer list - as red-word! series/offset) >> 4	;@@ log2(size? cell!) hardcoded
				]
				list: list + 1
			]
		][
			while [list < end][
				if sym = list/symbol [
					return (as-integer list - as red-word! series/offset) >> 4	;@@ log2(size? cell!) hardcoded
				]
				list: list + 1
			]
		]
		-1												;-- search failed
	]

	get-global: func [
		symbol  [integer!]
		return:	[red-value!]
		/local
			ctx	   [red-context!]
			values [series!]
			index  [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/get-global"]]

		ctx: TO_CTX(global-ctx)
		values: as series! ctx/values/value
		index: find-word ctx symbol yes
		assert index <> -1
		values/offset + index
	]

	add-global: func [
		symbol	[integer!]
		return: [red-word!]
		/local
			ctx	  [red-context!]
			word  [red-word!]
			value [cell!]
			s  	  [series!]
			id	  [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/add-global"]]

		ctx: TO_CTX(global-ctx)
		id: find-word ctx symbol no
		s: as series! ctx/symbols/value

		if id <> -1 [return as red-word! s/offset + id]	;-- word already defined in global context

		s: as series! ctx/symbols/value
		id: (as-integer s/tail - s/offset) >> 4			;-- index is zero-base
		word: as red-word! alloc-tail s

		word/header: TYPE_WORD							;-- implicit reset of all header flags
		word/ctx: 	 global-ctx
		word/symbol: symbol
		word/index:  id

		value: alloc-tail as series! ctx/values/value
		value/header: TYPE_UNSET
		word
	]

	add-with: func [
		ctx		[red-context!]
		word	[red-word!]
		value	[red-value!]
		return: [red-value!]
		/local
			w	[red-word!]
			s  	[series!]
			id	[integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/add-with"]]

		id: find-word ctx word/symbol yes
		if id <> -1 [return null]

		s: as series! ctx/symbols/value
		id: (as-integer s/tail - s/offset) >> 4			;-- index is zero-base
		w: as red-word! alloc-tail s
		copy-cell as cell! word as cell! w
		w/ctx: ctx/self
		w/index: id

		s: as series! ctx/symbols/value					;-- refreshing pointer after alloc-tail
		copy-cell value alloc-tail as series! ctx/values/value
	]

	add: func [
		ctx		[red-context!]
		word 	[red-word!]
		return:	[integer!]
		/local
			sym	  [cell!]
			value [cell!]
			s  	  [series!]
			id	  [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/add"]]

		id: find-word ctx word/symbol yes
		if id <> -1 [return id]

		s: as series! ctx/symbols/value
		id: (as-integer s/tail - s/offset) >> 4			;-- index is zero-base

		sym: alloc-tail s
		copy-cell as cell! word sym
		sym/header: TYPE_WORD							;-- force word! type
		word: as red-word! sym
		word/index: id

		unless ON_STACK?(ctx) [
			value: alloc-tail as series! ctx/values/value
			value/header: TYPE_UNSET
		]
		id
	]

	set-integer: func [
		word 	[red-word!]
		value	[integer!]
		return:	[integer!]
		/local
			node	[node!]
			int 	[red-integer!]
			values	[series!]
			ctx		[red-context!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/set-integer"]]

		node: word/ctx
		ctx: TO_CTX(node)

		if word/index = -1 [
			word/index: find-word ctx word/symbol no
		]
		int: as red-integer! either ON_STACK?(ctx) [
			(as red-value! ctx/values) + word/index
		][
			values: as series! ctx/values/value
			values/offset + word/index
		]
		int/header: TYPE_INTEGER
		int/value: value
		value
	]

	set-in: func [
		word 		[red-word!]
		value		[red-value!]
		ctx			[red-context!]
		return:		[red-value!]
		/local
			values	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/set-in"]]

		if word/index = -1 [
			word/index: find-word ctx word/symbol no
			if word/index = -1 [add ctx word]
		]
		either ON_STACK?(ctx) [
			copy-cell value (as red-value! ctx/values) + word/index
		][
			values: as series! ctx/values/value
			copy-cell value values/offset + word/index
		]
	]

	set: func [
		word	[red-word!]
		value	[red-value!]
		return:	[red-value!]
		/local
			node [node!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/set"]]

		node: word/ctx
		set-in word value TO_CTX(node)
	]

	get-in: func [
		word	   [red-word!]
		ctx	   	   [red-context!]
		return:	   [red-value!]
		/local
			values [series!]
			sym	   [red-symbol!]
			s	   [series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/get-in"]]

		if all [
			ctx/header and flag-self-mask = 0			;-- test if context handles SELF
			word/index = -1
			word/symbol = words/self
		][
			s: as series! word/ctx/value
			return s/offset								;-- return original object value
		]
		if any [										;-- ensure word is properly bound to a context
			null? ctx
			word/index = -1
		][
			fire [TO_ERROR(script no-value) word]
		]
		if null? ctx/values [
			fire [TO_ERROR(script not-in-context) word]
		]
		either ON_STACK?(ctx) [
			(as red-value! ctx/values) + word/index
		][
			values: as series! ctx/values/value
			values/offset + word/index
		]
	]

	get: func [
		word	[red-word!]
		return:	[red-value!]
		/local
			node [node!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/get"]]

		node: word/ctx
		get-in word TO_CTX(node)
	]

	clone: func [
		node	[node!]
		return:	[node!]
		/local
			sym		[red-word!]
			ctx		[red-context!]
			new		[node!]
			src		[series!]
			dst		[series!]
			slots	[integer!]
	][
		ctx: TO_CTX(node)
		src: as series! ctx/symbols/value
		slots: (as-integer (src/tail - src/offset)) >> 4

		new: create
			slots
			ctx/header and flag-series-stk <> 0
			ctx/header and flag-self-mask  <> 0

		ctx: TO_CTX(new)
		dst: as series! ctx/symbols/value
		dst/tail: dst/offset + slots
		sym: as red-word! dst/offset

		copy-memory
			as byte-ptr! sym
			as byte-ptr! src/offset
			slots << 4

		while [slots > 0][
			sym/ctx: new
			sym: sym + 1
			slots: slots - 1
		]
		new
	]

	create: func [
		slots		[integer!]							;-- max number of words in the context
		stack?		[logic!]							;-- TRUE: alloc values on stack, FALSE: alloc them from heap
		self?		[logic!]
		return:		[node!]
		/local
			cell 	[red-context!]
			node	[node!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/create"]]

		if zero? slots [slots: 1]
		node: alloc-cells 1
		cell: as red-context! alloc-tail as series! node/value
		cell/header: TYPE_CONTEXT						;-- implicit reset of all header flags
		cell/symbols: alloc-series slots 16 0			;-- force offset at head of buffer
		cell/self: node

		if self? [cell/header: cell/header or flag-self-mask]

		either stack? [
			cell/header: TYPE_CONTEXT or flag-series-stk
			cell/values: null							;-- will be set to stack frame dynamically
		][
			cell/values: alloc-cleared-cells slots
		]
		node
	]

	make: func [
		spec	[red-block!]
		stack?	[logic!]
		self?	[logic!]
		return:	[node!]
		/local
			new		[node!]
			symbols	[node!]
			ctx		[red-context!]
			cell	[red-value!]
			slot	[red-word!]
			s		[series!]
			type	[integer!]
			i		[integer!]
	][
		new: create block/rs-length? spec stack? self?
		ctx: TO_CTX(new)
		symbols: ctx/symbols

		s: GET_BUFFER(spec)
		cell: s/offset
		i: 0

		while [cell < s/tail][
			type: TYPE_OF(cell)
			if any [									;TBD: use typeset/any-word?
				type = TYPE_WORD
				type = TYPE_GET_WORD
				type = TYPE_LIT_WORD
				type = TYPE_REFINEMENT
			][											;-- add new word to context
				slot: as red-word! alloc-tail as series! symbols/value
				copy-cell cell as red-value! slot
				slot/header: TYPE_WORD
				slot/ctx: new
				slot/index: i
				i: i + 1
			]
			cell: cell + 1
		]
		new
	]

	bind-word: func [
		ctx		[red-context!]
		word	[red-word!]
		return:	[integer!]
		/local
			idx [integer!]
	][
		idx: find-word ctx word/symbol yes
		if idx >= 0 [
			word/ctx: ctx/self
			word/index: idx
		]
		idx
	]

	bind: func [
		body	[red-block!]
		ctx		[red-context!]
		obj		[node!]									;-- required by SELF
		self?	[logic!]
		return: [red-block!]
		/local
			value [red-value!]
			end	  [red-value!]
			w	  [red-word!]
			type  [integer!]
	][
		value: block/rs-head body
		end:   block/rs-tail body

		while [value < end][
			switch TYPE_OF(value) [
				TYPE_WORD
				TYPE_GET_WORD
				TYPE_SET_WORD
				TYPE_LIT_WORD
				TYPE_REFINEMENT [
					w: as red-word! value
					either all [						;-- special processing of SELF word
						self?
						TYPE_OF(value) = TYPE_WORD
						w/symbol = words/self
					][
						w/ctx: obj						;-- make SELF refer to the original object
						w/index: -1						;-- make it fail if resolved out of context
					][
						bind-word ctx w
					]
				]
				TYPE_BLOCK 								;@@ replace with TYPE_ANY_BLOCK
				TYPE_PAREN
				TYPE_PATH
				TYPE_LIT_PATH
				TYPE_SET_PATH
				TYPE_GET_PATH	[
					bind as red-block! value ctx obj self?
				]
				default [0]
			]
			value: value + 1
		]
		body
	]

	set-context-each: func [
		s	 [series!]
		node [node!]
		/local
			p	 [red-word!]
			tail [red-word!]
	][
		p:	  as red-word! s/offset
		tail: as red-word! s/tail

		while [p < tail][
			p/ctx: node
			p: p + 1
		]
	]

	collect-set-words: func [
		ctx	 	[red-context!]
		spec 	[red-block!]
		return: [logic!]
		/local
			cell [red-value!]
			tail [red-value!]
			base [red-value!]
			word [red-word!]
			s	 [series!]
	][
		s: GET_BUFFER(spec)
		cell: s/offset
		tail: s/tail

		s: as series! ctx/symbols/value
		base: s/tail - s/offset

		while [cell < tail][
			if TYPE_OF(cell) = TYPE_SET_WORD [
				add ctx as red-word! cell
			]
			cell: cell + 1
		]
		s/tail - s/offset > base						;-- TRUE: new words added
	]

	;-- Actions --

	init: does [
		datatype/register [
			TYPE_CONTEXT
			TYPE_VALUE
			"context!"
			;-- General actions --
			null			;make
			null			;random
			null			;reflect
			null			;to
			null			;form
			null			;mold
			null			;eval-path
			null			;set-path
			null			;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
			null			;at
			null			;back
			null			;change
			null			;clear
			null			;copy
			null			;find
			null			;head
			null			;head?
			null			;index?
			null			;insert
			null			;length?
			null			;next
			null			;pick
			null			;poke
			null			;remove
			null			;reverse
			null			;select
			null			;sort
			null			;skip
			null			;swap
			null			;tail
			null			;tail?
			null			;take
			null			;trim
			;-- I/O actions --
			null			;create
			null			;close
			null			;delete
			null			;modify
			null			;open
			null			;open?
			null			;query
			null			;read
			null			;rename
			null			;update
			null			;write
		]
	]
]

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

_context: context [
	verbose: 0

	find-word: func [
		ctx		[red-context!]
		sym		[integer!]
		case?	[logic!]
		return:	[integer!]								;-- value > 0: success, value = -1: failure
		/local
			series	[series!]
			list	[red-word!]
			end		[red-word!]
	][
		series: as series! ctx/symbols/value
		list:   as red-word! series/offset
		end:    as red-word! series/tail

		either case? [
			sym: symbol/resolve sym
			while [list < end][
				if sym = symbol/resolve list/symbol [
					return (as-integer list - as red-word! series/offset) >> 4	;@@ log2(size? cell!) hardcoded
				]
				list: list + 1
			]
		][
			while [list < end][
				if sym = list/symbol [
					return (as-integer list - as red-word! series/offset) >> 4	;@@ log2(size? cell!) hardcoded
				]
				list: list + 1
			]
		]
		-1												;-- search failed
	]

	get-global: func [
		symbol  [integer!]
		return:	[red-value!]
		/local
			ctx	   [red-context!]
			values [series!]
			index  [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/get-global"]]

		ctx: TO_CTX(global-ctx)
		values: as series! ctx/values/value
		index: find-word ctx symbol yes
		assert index <> -1
		values/offset + index
	]

	add-global: func [
		symbol	[integer!]
		return: [red-word!]
		/local
			ctx	  [red-context!]
			word  [red-word!]
			value [cell!]
			s  	  [series!]
			id	  [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/add-global"]]

		ctx: TO_CTX(global-ctx)
		id: find-word ctx symbol no
		s: as series! ctx/symbols/value

		if id <> -1 [return as red-word! s/offset + id]	;-- word already defined in global context

		s: as series! ctx/symbols/value
		id: (as-integer s/tail - s/offset) >> 4			;-- index is zero-base
		word: as red-word! alloc-tail s

		word/header: TYPE_WORD							;-- implicit reset of all header flags
		word/ctx: 	 global-ctx
		word/symbol: symbol
		word/index:  id

		value: alloc-tail as series! ctx/values/value
		value/header: TYPE_UNSET
		word
	]

	add-with: func [
		ctx		[red-context!]
		word	[red-word!]
		value	[red-value!]
		return: [red-value!]
		/local
			w	[red-word!]
			s  	[series!]
			id	[integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/add-with"]]

		id: find-word ctx word/symbol yes
		if id <> -1 [return null]

		s: as series! ctx/symbols/value
		id: (as-integer s/tail - s/offset) >> 4			;-- index is zero-base
		w: as red-word! alloc-tail s
		copy-cell as cell! word as cell! w
		w/ctx: ctx/self
		w/index: id

		s: as series! ctx/symbols/value					;-- refreshing pointer after alloc-tail
		copy-cell value alloc-tail as series! ctx/values/value
	]

	add: func [
		ctx		[red-context!]
		word 	[red-word!]
		return:	[integer!]
		/local
			sym	  [cell!]
			value [cell!]
			s  	  [series!]
			id	  [integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/add"]]

		id: find-word ctx word/symbol yes
		if id <> -1 [return id]

		s: as series! ctx/symbols/value
		id: (as-integer s/tail - s/offset) >> 4			;-- index is zero-base

		sym: alloc-tail s
		copy-cell as cell! word sym
		sym/header: TYPE_WORD							;-- force word! type
		word: as red-word! sym
		word/index: id

		unless ON_STACK?(ctx) [
			value: alloc-tail as series! ctx/values/value
			value/header: TYPE_UNSET
		]
		id
	]

	set-integer: func [
		word 	[red-word!]
		value	[integer!]
		return:	[integer!]
		/local
			node	[node!]
			int 	[red-integer!]
			values	[series!]
			ctx		[red-context!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/set-integer"]]

		node: word/ctx
		ctx: TO_CTX(node)

		if word/index = -1 [
			word/index: find-word ctx word/symbol no
		]
		int: as red-integer! either ON_STACK?(ctx) [
			(as red-value! ctx/values) + word/index
		][
			values: as series! ctx/values/value
			values/offset + word/index
		]
		int/header: TYPE_INTEGER
		int/value: value
		value
	]

	set-in: func [
		word 		[red-word!]
		value		[red-value!]
		ctx			[red-context!]
		return:		[red-value!]
		/local
			values	[series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/set-in"]]

		if word/index = -1 [
			word/index: find-word ctx word/symbol no
			if word/index = -1 [add ctx word]
		]
		either ON_STACK?(ctx) [
			copy-cell value (as red-value! ctx/values) + word/index
		][
			values: as series! ctx/values/value
			copy-cell value values/offset + word/index
		]
	]

	set: func [
		word	[red-word!]
		value	[red-value!]
		return:	[red-value!]
		/local
			node [node!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/set"]]

		node: word/ctx
		set-in word value TO_CTX(node)
	]

	get-in: func [
		word	   [red-word!]
		ctx	   	   [red-context!]
		return:	   [red-value!]
		/local
			values [series!]
			sym	   [red-symbol!]
			s	   [series!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/get-with"]]

		if all [
			ctx/header and flag-self-mask <> 0			;-- test if context handles SELF
			word/index = -1
			word/symbol = words/self
		][
			s: as series! word/ctx/value
			return s/offset								;-- return original object value
		]
		if any [										;-- ensure word is properly bound to a context
			null? ctx
			word/index = -1
		][
			fire [TO_ERROR(script no-value) word]
		]
		if null? ctx/values [
			fire [TO_ERROR(script not-in-context) word]
		]
		either ON_STACK?(ctx) [
			(as red-value! ctx/values) + word/index
		][
			values: as series! ctx/values/value
			values/offset + word/index
		]
	]

	get: func [
		word	[red-word!]
		return:	[red-value!]
		/local
			node [node!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/get"]]

		node: word/ctx
		get-in word TO_CTX(node)
	]

	clone: func [
		node	[node!]
		return:	[node!]
		/local
			sym		[red-word!]
			ctx		[red-context!]
			new		[node!]
			src		[series!]
			dst		[series!]
			slots	[integer!]
	][
		ctx: TO_CTX(node)
		src: as series! ctx/symbols/value
		slots: (as-integer (src/tail - src/offset)) >> 4

		new: create
			slots
			ctx/header and flag-series-stk <> 0
			ctx/header and flag-self-mask  <> 0

		ctx: TO_CTX(new)
		dst: as series! ctx/symbols/value
		dst/tail: dst/offset + slots
		sym: as red-word! dst/offset

		copy-memory
			as byte-ptr! sym
			as byte-ptr! src/offset
			slots << 4

		while [slots > 0][
			sym/ctx: new
			sym: sym + 1
			slots: slots - 1
		]
		new
	]

	create: func [
		slots		[integer!]							;-- max number of words in the context
		stack?		[logic!]							;-- TRUE: alloc values on stack, FALSE: alloc them from heap
		self?		[logic!]
		return:		[node!]
		/local
			cell 	[red-context!]
			node	[node!]
	][
		#if debug? = yes [if verbose > 0 [print-line "_context/create"]]

		if zero? slots [slots: 1]
		node: alloc-cells 1
		cell: as red-context! alloc-tail as series! node/value
		cell/header: TYPE_CONTEXT						;-- implicit reset of all header flags
		cell/symbols: alloc-series slots 16 0			;-- force offset at head of buffer
		cell/self: node

		if self? [cell/header: cell/header or flag-self-mask]

		either stack? [
			cell/header: TYPE_CONTEXT or flag-series-stk
			cell/values: null							;-- will be set to stack frame dynamically
		][
			cell/values: alloc-cleared-cells slots
		]
		node
	]

	make: func [
		spec	[red-block!]
		stack?	[logic!]
		self?	[logic!]
		return:	[node!]
		/local
			new		[node!]
			symbols	[node!]
			ctx		[red-context!]
			cell	[red-value!]
			slot	[red-word!]
			s		[series!]
			type	[integer!]
			i		[integer!]
	][
		new: create block/rs-length? spec stack? self?
		ctx: TO_CTX(new)
		symbols: ctx/symbols

		s: GET_BUFFER(spec)
		cell: s/offset
		i: 0

		while [cell < s/tail][
			type: TYPE_OF(cell)
			if any [									;TBD: use typeset/any-word?
				type = TYPE_WORD
				type = TYPE_GET_WORD
				type = TYPE_LIT_WORD
				type = TYPE_REFINEMENT
			][											;-- add new word to context
				slot: as red-word! alloc-tail as series! symbols/value
				copy-cell cell as red-value! slot
				slot/header: TYPE_WORD
				slot/ctx: new
				slot/index: i
				i: i + 1
			]
			cell: cell + 1
		]
		new
	]

	bind-word: func [
		ctx		[red-context!]
		word	[red-word!]
		return:	[integer!]
		/local
			idx [integer!]
	][
		idx: find-word ctx word/symbol yes
		if idx >= 0 [
			word/ctx: ctx/self
			word/index: idx
		]
		idx
	]

	bind: func [
		body	[red-block!]
		ctx		[red-context!]
		obj		[node!]									;-- required by SELF
		self?	[logic!]
		return: [red-block!]
		/local
			value [red-value!]
			end	  [red-value!]
			w	  [red-word!]
			type  [integer!]
	][
		value: block/rs-head body
		end:   block/rs-tail body

		while [value < end][
			switch TYPE_OF(value) [
				TYPE_WORD
				TYPE_GET_WORD
				TYPE_SET_WORD
				TYPE_LIT_WORD
				TYPE_REFINEMENT [
					w: as red-word! value
					either all [						;-- special processing of SELF word
						self?
						TYPE_OF(value) = TYPE_WORD
						w/symbol = words/self
					][
						w/ctx: obj						;-- make SELF refer to the original object
						w/index: -1						;-- make it fail if resolved out of context
					][
						bind-word ctx w
					]
				]
				TYPE_BLOCK 								;@@ replace with TYPE_ANY_BLOCK
				TYPE_PAREN
				TYPE_PATH
				TYPE_LIT_PATH
				TYPE_SET_PATH
				TYPE_GET_PATH	[
					bind as red-block! value ctx obj self?
				]
				default [0]
			]
			value: value + 1
		]
		body
	]

	set-context-each: func [
		s	 [series!]
		node [node!]
		/local
			p	 [red-word!]
			tail [red-word!]
	][
		p:	  as red-word! s/offset
		tail: as red-word! s/tail

		while [p < tail][
			p/ctx: node
			p: p + 1
		]
	]

	collect-set-words: func [
		ctx	 	[red-context!]
		spec 	[red-block!]
		return: [logic!]
		/local
			cell [red-value!]
			tail [red-value!]
			base [red-value!]
			word [red-word!]
			s	 [series!]
	][
		s: GET_BUFFER(spec)
		cell: s/offset
		tail: s/tail

		s: as series! ctx/symbols/value
		base: s/tail - s/offset

		while [cell < tail][
			if TYPE_OF(cell) = TYPE_SET_WORD [
				add ctx as red-word! cell
			]
			cell: cell + 1
		]
		s/tail - s/offset > base						;-- TRUE: new words added
	]

	;-- Actions --

	init: does [
		datatype/register [
			TYPE_CONTEXT
			TYPE_VALUE
			"context!"
			;-- General actions --
			null			;make
			null			;random
			null			;reflect
			null			;to
			null			;form
			null			;mold
			null			;eval-path
			null			;set-path
			null			;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
			null			;at
			null			;back
			null			;change
			null			;clear
			null			;copy
			null			;find
			null			;head
			null			;head?
			null			;index?
			null			;insert
			null			;length?
			null			;next
			null			;pick
			null			;poke
			null			;remove
			null			;reverse
			null			;select
			null			;sort
			null			;skip
			null			;swap
			null			;tail
			null			;tail?
			null			;take
			null			;trim
			;-- I/O actions --
			null			;create
			null			;close
			null			;delete
			null			;modify
			null			;open
			null			;open?
			null			;query
			null			;read
			null			;rename
			null			;update
			null			;write
		]
	]
]


FIX: now EQUAL? will return false when right operand is not a compatible type.

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

integer: context [
	verbose: 0

	get: func [										;-- unboxing integer value
		value		[red-value!]
		return: 	[integer!]
		/local
			cell	[red-integer!]
	][
		assert TYPE_OF(value) = TYPE_INTEGER
		cell: as red-integer! value
		cell/value
	]

	form-signed: func [								;@@ replace with sprintf() call?
		s [c-string!]
		i [integer!]
		return: [c-string!]
		/local
			c [integer!]
			n [logic!]
	][
		if zero? i [
			s/1: #"0"
			s/2: null-byte
			return s
		]
		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]
		s/12: null-byte
		s + c
	]

	do-math: func [
		type	  [integer!]
		return:	  [red-integer!]
		/local
			left  [red-integer!]
			right [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/add"]]

		left: as red-integer! stack/arguments
		right: left + 1

		assert any [									;@@ replace by typeset check when possible
			TYPE_OF(left) = TYPE_INTEGER
			TYPE_OF(left) = TYPE_CHAR
		]
		assert any [
			TYPE_OF(right) = TYPE_INTEGER
			TYPE_OF(right) = TYPE_CHAR
		]

		left/value: switch type [
			OP_ADD [left/value + right/value]
			OP_SUB [left/value - right/value]
			OP_MUL [left/value * right/value]
			OP_DIV [left/value / right/value]
		]
		left
	]

	push: func [
		value [integer!]
		/local
			cell  [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/push"]]

		cell: as red-integer! stack/push
		cell/header: TYPE_INTEGER
		cell/value: value
	]

	;-- Actions --

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

		arg: as red-integer! stack/arguments
		value: arg/value

		str: as red-string! arg + 1
		assert TYPE_OF(str) = TYPE_STRING

		series: GET_BUFFER(str)
		series/offset: as cell! form-signed as c-string! series/offset value
		series/tail: as cell! (as byte-ptr! series/tail) + 13
		part											;@@ implement full support for /part
	]

	compare: func [
		value1    [red-integer!]						;-- first operand
		value2    [red-integer!]						;-- second operand
		op	      [integer!]							;-- type of comparison
		return:   [logic!]
		/local
			char  [red-char!]
			type  [integer!]
			left  [integer!]
			right [integer!]
			res	  [logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/compare"]]

		type: TYPE_OF(value2)
		left: value1/value

		switch type [
			TYPE_INTEGER [
				right: value2/value
			]
			TYPE_CHAR [
				char: as red-char! value2				;@@ could be optimized as integer! and char!
				right: char/value						;@@ structures are overlapping exactly
			]
			default [									;@@ Throw error! when ready
				either op = COMP_EQUAL [
					return false
				][
					print-line ["Error: cannot compare integer! with type #" type]
					halt
				]
			]
		]
		switch op [
			COMP_EQUAL 			[res: left = right]
			COMP_STRICT_EQUAL	[res: all [type = TYPE_INTEGER left = right]]
			COMP_LESSER			[res: left <  right]
			COMP_LESSER_EQUAL	[res: left <= right]
			COMP_GREATER		[res: left >  right]
			COMP_GREATER_EQUAL	[res: left >= right]
		]
		res
	]

	add: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/add"]]
		as red-value! do-math OP_ADD
	]

	divide: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/divide"]]
		as red-value! do-math OP_DIV
	]

	multiply: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/multiply"]]
		as red-value! do-math OP_MUL
	]

	subtract: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/subtract"]]
		as red-value! do-math OP_SUB
	]

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

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

integer: context [
	verbose: 0

	get: func [										;-- unboxing integer value
		value		[red-value!]
		return: 	[integer!]
		/local
			cell	[red-integer!]
	][
		assert TYPE_OF(value) = TYPE_INTEGER
		cell: as red-integer! value
		cell/value
	]

	form-signed: func [								;@@ replace with sprintf() call?
		s [c-string!]
		i [integer!]
		return: [c-string!]
		/local
			c [integer!]
			n [logic!]
	][
		if zero? i [
			s/1: #"0"
			s/2: null-byte
			return s
		]
		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]
		s/12: null-byte
		s + c
	]

	do-math: func [
		type	  [integer!]
		return:	  [red-integer!]
		/local
			left  [red-integer!]
			right [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/add"]]

		left: as red-integer! stack/arguments
		right: left + 1

		assert any [									;@@ replace by typeset check when possible
			TYPE_OF(left) = TYPE_INTEGER
			TYPE_OF(left) = TYPE_CHAR
		]
		assert any [
			TYPE_OF(right) = TYPE_INTEGER
			TYPE_OF(right) = TYPE_CHAR
		]

		left/value: switch type [
			OP_ADD [left/value + right/value]
			OP_SUB [left/value - right/value]
			OP_MUL [left/value * right/value]
			OP_DIV [left/value / right/value]
		]
		left
	]

	push: func [
		value [integer!]
		/local
			cell  [red-integer!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/push"]]

		cell: as red-integer! stack/push
		cell/header: TYPE_INTEGER
		cell/value: value
	]

	;-- Actions --

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

		arg: as red-integer! stack/arguments
		value: arg/value

		str: as red-string! arg + 1
		assert TYPE_OF(str) = TYPE_STRING

		series: GET_BUFFER(str)
		series/offset: as cell! form-signed as c-string! series/offset value
		series/tail: as cell! (as byte-ptr! series/tail) + 13
		part											;@@ implement full support for /part
	]

	compare: func [
		value1    [red-integer!]						;-- first operand
		value2    [red-integer!]						;-- second operand
		op	      [integer!]							;-- type of comparison
		return:   [logic!]
		/local
			char  [red-char!]
			type  [integer!]
			left  [integer!]
			right [integer!]
			res	  [logic!]
	][
		#if debug? = yes [if verbose > 0 [print-line "integer/compare"]]

		type: TYPE_OF(value2)
		left: value1/value

		switch type [
			TYPE_INTEGER [
				right: value2/value
			]
			TYPE_CHAR [
				char: as red-char! value2				;@@ could be optimized as integer! and char!
				right: char/value						;@@ structures are overlapping exactly
			]
			default [									;@@ Throw error! when ready
				print-line ["Error: cannot compare integer! with type #" type]
				halt
			]
		]
		switch op [
			COMP_EQUAL 			[res: left = right]
			COMP_STRICT_EQUAL	[res: all [type = TYPE_INTEGER left = right]]
			COMP_LESSER			[res: left <  right]
			COMP_LESSER_EQUAL	[res: left <= right]
			COMP_GREATER		[res: left >  right]
			COMP_GREATER_EQUAL	[res: left >= right]
		]
		res
	]

	add: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/add"]]
		as red-value! do-math OP_ADD
	]

	divide: func [return: [red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/divide"]]
		as red-value! do-math OP_DIV
	]

	multiply: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/multiply"]]
		as red-value! do-math OP_MUL
	]

	subtract: func [return:	[red-value!]][
		#if debug? = yes [if verbose > 0 [print-line "integer/subtract"]]
		as red-value! do-math OP_SUB
	]

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