Revised manual; added TOC.

Revised manual; added TOC.

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. Table of Contents

* Files and folders
* Site configuration
* Project builder configuration
* Default build tasks
* Changing the build command
* Handling custom build artifacts
* Build scheduling
* Deleting a project
* Build chaining & triggers
* Environment variables
* Remote builds
* Performing a clean checkout
* Troubleshooting and support

h1. Files and folders

* [cruise] is how this documentation refers the directory where CC.rb itself has been unpacked or checked out.

* CC.rb places all of its project, plugin, and configuration data in $HOME/.cruise (%USERPROFILE%\.cruise on Windows).
  This documentation refers to this directory as [cruise data].

* [cruise data]/projects/your_project/ is the directory where CC.rb will place the data for the project called "your_project".

* [cruise data]/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 data]/projects/your_project/build-123/ contains a build status file, a list of changed files,
  and other "build artifacts" created while building revision 123.

* [cruise data]/projects/your_project/cruise_config.rb contains the build configuration for your_project.

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

h1. Site configuration

p. The 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 set a number of global configuration settings.
Normally you would only need to do this to configure an SMTP server for email notices. Email is configured using Rails'
ActionMailer component and accepts its standard configuration settings.

h1. Project builder configuration

If you don't provide a Cruise configuration for your project, CC.rb will try to make some reasonable guesses about how
to build your project, particularly if it's a Ruby application. (See Default build tasks below.)

However, there are only a few configuration settings that CC.rb can guess at. Specific projects will require more advanced configuration
if you need to add email notification recipients, configure plugins, or otherwise tweak your build run. A typical project configuration
in CC.rb is about 3 to 5 lines of very simple Ruby.

When you first add a project, a configuration file called cruise_config.rb is created for you in the
[cruise data]/projects/your_project/ directory. It contains a number of comments, but two lines are important:

Project.configure do |project|
end

Every cruise_config.rb must have these two lines, and all your other configuration goes between them. It's recommended that you check
this file into version control, and if you do then changes made to the configuration will be automatically be picked up by CC.rb the
next time you check in without any additional work required.

Optionally, you can put a configuration file in both places above. CruiseControl.rb loads both files, but settings from the
cruise_config.rb in [cruise data]/projects/your_project/ override those stored in your project's root directory.
This can be useful when you want to see the effect of some configuration settings without checking them in, or have some
location-dependent settings.

p(hint). Hint: configuration examples below include lines 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, as they are not valid Ruby. If you do, ./cruise start will fail to start
         due to a syntax error.

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). Hint: Use code like above to source-control configuration of multiple CruiseControl.rb projects building the same codebase.

h1. Default build tasks

By default, CC.rb will assume that you are building a Ruby project, load your Rakefile, and look for the cruise,
test, and default (what happens when you just type rake with no arguments) tasks,
in that order, and execute the first one it finds.

Note that Rails provides you with an automatic test task when you first create your project. The behavior
for that task is documented here.

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. Changing the build command or Rake task

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: Be careful when defining additional build tasks. If two builds share the same RAILS_ENV value
         then they will operate against the same database, which means that if two builds run simultaneously there is
         a chance that they will interfere with each other. You can avoid this issue this by creating a separate environment
         and making sure that the Rake task for your build sets the RAILS_ENV value to that environment in your
         Rake task. 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. CruiseControl.rb provides support for this option through
         the triggered_by project build configuration feature; see
         Build Chaining & Triggers.

CC.rb may be written in Ruby on Rails, but you don't need to be using Ruby and Rake in order to take advantage of it.
Other build tools like "make":http://www.gnu.org/software/make/,
"Ant":http://ant.apache.org/ and "MSBuild":http://msdn2.microsoft.com/en-us/library/wea2sca5.aspx are also supported--
really, any command that can return a success or failure status code.

A custom build command can be set with the 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 invoke the specified command from the project's work directory
([cruise data]/projects/your_project/work/) and examine the exit code to determine whether the
build passed or failed.

p(hint). Hint: You cannot set both the rake_task and build_command attributes in a a given project configuration.

h1. What should I do with custom build artifacts?

Some build tasks generate custom output, like test coverage statistics, that you may want to keep and see on the build page.
CruiseControl.rb supports the integration of that output by setting the CC_BUILD_ARTFACTS environment variable
to a directory that's been set aside specifically to collect them.

If you ensure that your special task writes its output to that directory or a subdirectory of it, then the resulting build artifacts page will automatically include links to every file or subdirectory found in the build artifacts directory.

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.

p(hint). Hint: The "metric_fu":http://github.com/jscruggs/metric_fu/tree/master project collects a number of
         helpful Ruby code metrics into a single, easy-to-configure plugin and integrates well with CC.rb.

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 into the plugins directory and configuring it as follows:

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 configuration has changed, or when a
build is requested by user (by 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 data]/projects/your_project/
directory.

h1. Build chaining & triggers

CC.rb uses triggers to tell it when to build a project.  Every project is configured, by default, with a ChangeInSourceControl trigger: it builds
when (surprise) it detects a change in a project's source control.

However, you can add additional triggers or replace a 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.

h1. Environment variables

CC.rb sets some environment variables when it runs your build, and you can use them inside your build process to tweak it or its output. Currently
there are just three:
* 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.

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.
More robust support for builders on remote servers is expected in release 2.0.

h1. Performing a clean checkout for each build

CC.rb supports clean checkouts, though they are not the default behavior.  To enable them, you must use the do_clean_checkout
flag together with an optional frequency. Acceptable values are :always, :never, and :every => [duration].

  project.do_clean_checkout :every => 6.hours

h1. Troubleshooting and support

If you have an issue that you cannot fix on your own, please consider subscribing to our mailing list at cruisecontrolrb-users@rubyforge.org
and asking for help. Please note, though, that we take great pains to make CC.rb easy to hack, and we encourage you to poke around in the
source code and hack away.

Should you require commercial support, training or consulting around this or other tool, "ThoughtWorks":http://thoughtworks.com/ can
provide it to you. We also offer a commercial CI product, "Cruise":http://studios.thoughtworks.com/cruise-continuous-integration, through
ThoughtWorks Studios, our product division.

p(hint). Hint to would-be contributors: documentation patches are as important, if not more so, than code patches, and would be
         gratefully accepted.

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

* [cruise] is how this documentation refers the directory where CC.rb itself has been unpacked or checked out.

* CC.rb places all of its project, plugin, and configuration data in $HOME/.cruise (%USERPROFILE%\.cruise on Windows).
  This documentation refers to this directory as [cruise data].

* [cruise data]/projects/your_project/ is the directory where CC.rb will place the data for the project called "your_project".

* [cruise data]/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 data]/projects/your_project/build-123/ contains a build status file, a list of changed files,
  and other "build artifacts" created while building revision 123.

* [cruise data]/projects/your_project/cruise_config.rb contains the build configuration for your_project.

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

h1. Site configuration

The 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.

But 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. And yes, the configuration language of CC.rb is Ruby.

As you add a project, a configuration file is created for you in [cruise data]/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 data]/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 data]/projects/your_project/
directory, and the other in version control. CruiseControl.rb loads both files, but settings from cruise_config.rb in
[cruise data]/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 location-dependent settings.

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). 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 data]/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 data]/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.

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: issue #1053 (Routine causes Segmentation fault: 11)

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

#define _512KB				524288
#define _2MB				2097152
#define _16MB				16777216
#define nodes-per-frame		5000
#define node-frame-size		[((nodes-per-frame * 2 * size? pointer!) + size? node-frame!)]

#define series-in-use		80000000h		;-- mark a series as used (not collectable by the GC)
#define flag-ins-both		30000000h		;-- optimize for both head & tail insertions
#define flag-ins-tail		20000000h		;-- optimize for tail insertions
#define flag-ins-head		10000000h		;-- optimize for head insertions
#define flag-series-big		01000000h		;-- 1 = big, 0 = series
#define flag-series-small	00800000h		;-- series <= 16 bytes
#define flag-series-stk		00400000h		;-- values block allocated on stack
#define flag-series-nogc	00200000h		;-- protected from GC (system-critical series)
#define flag-series-fixed	00100000h		;-- series cannot be relocated (system-critical series)
#define flag-bitset-not		00080000h		;-- complement flag for bitsets

#define flag-arity-mask		C1FFFFFFh		;-- mask for readind routines arity field
#define flag-self-mask		FEFFFFFFh		;-- mask for setting self? flag
#define set-self-mask		01000000h		;-- mask for reading self? flag
#define body-mask			FF7FFFFFh		;-- mask for op! body node
#define body-flag			00800000h		;-- flag for op! body node
#define flag-unit-mask		FFFFFFE0h		;-- mask for reading unit field in series-buffer!
#define get-unit-mask		0000001Fh		;-- mask for setting unit field in series-buffer!
#define series-free-mask	7FFFFFFFh		;-- mark a series as used (not collectable by the GC)
#define flag-not-mask		FFF7FFFFh		;-- mask for complement flag

#define type-mask			FFFFFF00h		;-- mask for clearing type ID in cell header
#define get-type-mask		000000FFh		;-- mask for reading type ID in cell header
#define node!				int-ptr!
#define default-offset		-1				;-- for offset value in alloc-series calls

#define series!				series-buffer!

int-array!: alias struct! [ptr [int-ptr!]]

;-- cell header bits layout --
;   31:		lock							;-- lock series for active thread access only
;   30:		new-line						;-- new-line (LF) marker (before the slot)
;	29-25:	arity							;-- arity for routine! functions.
;	24:		self?							;-- self-aware context flag
;	23:		node-body						;-- op! body points to a block node (instead of native code)
;   22-8:	<reserved>
;   7-0:	datatype ID						;-- datatype number

cell!: alias struct! [
	header	[integer!]						;-- cell's header flags
	data1	[integer!]						;-- placeholders to make a 128-bit cell
	data2	[integer!]
	data3	[integer!]
]

;-- series flags --
;	31: 	used 							;-- 1 = used, 0 = free
;	30: 	type 							;-- always 0 for series-buffer!
;	29-28: 	insert-opt						;-- optimized insertions: 2 = head, 1 = tail, 0 = both
;   27:		mark							;-- mark as referenced for the GC (mark phase)
;   26:		lock							;-- lock series for active thread access only
;   25:		immutable						;-- mark as read-only
;   24:		big								;-- indicates a big series (big-frame!)
;	23:		small							;-- reserved
;	22:		stack							;-- series buffer is allocated on stack
;   21:		permanent						;-- protected from GC (system-critical series)
;   20:     fixed							;-- series cannot be relocated (system-critical series)
;	19:		complement						;-- complement flag for bitsets
;	18-3: 	<reserved>
;	4-0:	unit							;-- size in bytes of atomic element stored in buffer
											;-- 0: UTF-8, 1: Latin1/binary, 2: UCS-2, 4: UCS-4, 16: block! cell
series-buffer!: alias struct! [
	flags	[integer!]						;-- series flags
	node	[int-ptr!]						;-- point back to referring node
	size	[integer!]						;-- usable buffer size (series-buffer! struct excluded)
	offset	[cell!]							;-- series buffer offset pointer (insert at head optimization)
	tail	[cell!]							;-- series buffer tail pointer
]

series-frame!: alias struct! [				;-- series frame header
	next	[series-frame!]					;-- next frame or null
	prev	[series-frame!]					;-- previous frame or null
	heap	[series-buffer!]				;-- point to allocatable region
	tail	[byte-ptr!]						;-- point to last byte in allocatable region
]

node-frame!: alias struct! [				;-- node frame header
	next	[node-frame!]					;-- next frame or null
	prev	[node-frame!]					;-- previous frame or null
	nodes	[integer!]						;-- number of nodes
	bottom	[int-ptr!]						;-- bottom of stack (last entry, fixed)
	top		[int-ptr!]						;-- top of stack (first entry, moving)
]

big-frame!: alias struct! [					;-- big frame header (for >= 2MB series)
	flags	[integer!]						;-- bit 30: 1 (type = big)
	next	[big-frame!]					;-- next frame or null
	size	[integer!]						;-- size (up to 4GB - size? header)
	padding [integer!]						;-- make this header same size as series-buffer! header
]

memory: declare struct! [					; TBD: instanciate this structure per OS thread
	total	 [integer!]						;-- total memory size allocated (in bytes)
	n-head	 [node-frame!]					;-- head of node frames list
	n-active [node-frame!]					;-- actively used node frame
	n-tail	 [node-frame!]					;-- tail of node frames list
	s-head	 [series-frame!]				;-- head of series frames list
	s-active [series-frame!]				;-- actively used series frame
	s-tail	 [series-frame!]				;-- tail of series frames list
	s-start	 [integer!]						;-- start size for new series frame		(1)
	s-size	 [integer!]						;-- current size for new series frame	(1)
	s-max	 [integer!]						;-- max size for new series frames		(1)
	b-head	 [big-frame!]					;-- head of big frames list
]

init-mem: does [
	memory/total: 	0
	memory/s-start: _512KB
	memory/s-max: 	_2MB
	memory/s-size: 	memory/s-start
]

;; (1) Series frames size will grow from 512KB up to 2MB (arbitrary selected). This
;; range will need fine-tuning with real Red apps. This growing size, with low starting value
;; will allow small apps to not consume much memory while avoiding to penalize big apps.

;-------------------------------------------
;-- Fill a memory region with a given byte
;-------------------------------------------
fill: func [
	p	  [byte-ptr!]
	end   [byte-ptr!]
	byte  [byte!]
	/local
		p4		 [int-ptr!]
		tail	 [int-ptr!]
		cnt		 [integer!]
		byte4	 [integer!]
		aligned? [logic!]
][
	cnt: (as-integer p) and 3
	unless zero? cnt [						;-- preprocess unaligned beginning
		while [cnt > 0][p/cnt: byte cnt: cnt - 1]
		p: as byte-ptr! (as-integer p) + 4 and -4
	]

	aligned?: zero? ((as-integer end) and 3)
	tail: either aligned? [as int-ptr! end][as int-ptr! (as-integer end) and -4]
	p4: as int-ptr! p

	if p4 < tail [
		byte4: either byte = null-byte [0][
			byte4: as-integer byte
			(byte4 << 24) or (byte4 << 16) or (byte4 << 8) or byte4
		]
		while [p4 < tail][p4/value: byte4 p4: p4 + 1] ;-- zero fill target region using 32-bit accesses
	]

	unless aligned? [						;-- postprocess unaligned ending
		cnt: (as-integer end) and 3
		while [cnt > 0][end/cnt: byte cnt: cnt - 1]
	]
]

;-------------------------------------------
;-- Clear a memory region which size is a multiple of cell size
;-------------------------------------------
zerofill: func [
	p		[int-ptr!]
	end		[int-ptr!]
][
	assert p < end
	until [
		p/value: 0
		p: p + 1
		p = end
	]
]

;-------------------------------------------
;-- Allocate paged virtual memory region
;-------------------------------------------
allocate-virtual: func [
	size 	[integer!]						;-- allocated size in bytes (page size multiple)
	exec? 	[logic!]						;-- TRUE => executable region
	return: [int-ptr!]						;-- allocated memory region pointer
	/local ptr
][
	size: round-to size + 4	platform/page-size	;-- account for header (one word)
	memory/total: memory/total + size
	ptr: platform/allocate-virtual size exec?
	ptr/value: size							;-- store size in header
	ptr + 1									;-- return pointer after header
]

;-------------------------------------------
;-- Free paged virtual memory region from OS
;-------------------------------------------
free-virtual: func [
	ptr [int-ptr!]							;-- address of memory region to release
][
	ptr: ptr - 1							;-- return back to header
	memory/total: memory/total - ptr/value
	platform/free-virtual ptr
]

;-------------------------------------------
;-- Free all frames (part of Red's global exit handler)
;-------------------------------------------
free-all: func [
	/local n-frame s-frame b-frame n-next s-next b-next
][
	n-frame: memory/n-head
	while [n-frame <> null][
		n-next: n-frame/next
		free-virtual as int-ptr! n-frame
		n-frame: n-next
	]

	s-frame: memory/s-head
	while [s-frame <> null][
		s-next: s-frame/next
		free-virtual as int-ptr! s-frame
		s-frame: s-next
	]

	b-frame: memory/b-head
	while [b-frame <> null][
		b-next: b-frame/next
		free-virtual as int-ptr! b-frame
		b-frame: b-next
	]
]

;-------------------------------------------
;-- Format the node frame stack by filling it with pointers to all nodes
;-------------------------------------------
format-node-stack: func [
	frame [node-frame!]						;-- node frame to format
	/local node ptr
][
	ptr: frame/bottom						;-- point to bottom of stack
	node: ptr + frame/nodes					;-- first free node address
	until [
		ptr/value: as-integer node			;-- store free node address on stack
		node: node + 1
		ptr: ptr + 1
		ptr > frame/top						;-- until the stack is filled up
	]
]

;-------------------------------------------
;-- Allocate a node frame buffer and initialize it
;-------------------------------------------
alloc-node-frame: func [
	size 	[integer!]						;-- nb of nodes
	return:	[node-frame!]					;-- newly initialized frame
	/local sz frame
][
	assert positive? size
	sz: size * 2 * (size? pointer!) + (size? node-frame!) ;-- total required size for a node frame
	frame: as node-frame! allocate-virtual sz no ;-- R/W only

	frame/prev:  null
	frame/next:  null
	frame/nodes: size

	frame/bottom: as int-ptr! (as byte-ptr! frame) + size? node-frame!
	frame/top: frame/bottom + size - 1		;-- point to the top element

	either null? memory/n-head [
		memory/n-head: frame				;-- first item in the list
		memory/n-tail: frame
		memory/n-active: frame
	][
		memory/n-tail/next: frame			;-- append new item at tail of the list
		frame/prev: memory/n-tail			;-- link back to previous tail
		memory/n-tail: frame				;-- now tail is the new item
	]

	format-node-stack frame					;-- prepare the node frame for use
	frame
]

;-------------------------------------------
;-- Release a node frame buffer
;-------------------------------------------
free-node-frame: func [
	frame [node-frame!]						;-- frame to release
][
	either null? frame/prev [				;-- if frame = head
		memory/n-head: frame/next			;-- head now points to next one
	][
		either null? frame/next [			;-- if frame = tail
			memory/n-tail: frame/prev		;-- tail is now at one position back
		][
			frame/prev/next: frame/next		;-- link preceding frame to next frame
			frame/next/prev: frame/prev		;-- link back next frame to preceding frame
		]
	]
	if memory/n-active = frame [
		memory/n-active: memory/n-tail		;-- reset active frame to last one @@
	]

	assert not all [						;-- ensure that list is not empty
		null? memory/n-head
		null? memory/n-tail
	]

	free-virtual as int-ptr! frame			;-- release the memory to the OS
]

;-------------------------------------------
;-- Obtain a free node from a node frame
;-------------------------------------------
alloc-node: func [
	return: [int-ptr!]						;-- return a free node pointer
	/local frame node
][
	frame: memory/n-active					;-- take node from active node frame
	node: as int-ptr! frame/top/value		;-- pop free node address from stack
	frame/top: frame/top - 1

	if frame/top = frame/bottom [
		; TBD: trigger a "light" GC pass from here and update memory/n-active
		frame: alloc-node-frame nodes-per-frame	;-- allocate a new frame
		memory/n-active: frame				;@@ to be removed once GC implemented
		node: as int-ptr! frame/top/value	;-- pop free node address from stack
		frame/top: frame/top - 1
	]
	node
]

;-------------------------------------------
;-- Release a used node
;-------------------------------------------
free-node: func [
	node [int-ptr!]							;-- node to release
	/local frame offset
][
	assert not null? node

	frame: memory/n-active
	offset: as-integer node - frame

	unless all [
		positive? offset					;-- check if node address is part of active frame
		offset < node-frame-size
	][										;@@ following code not be needed if freed only by the GC...
		frame: memory/n-head				;-- search for right frame from head of the list
		while [								; @@ could be optimized by searching backward/forward from active frame
			offset: as-integer node - frame
			not all [						;-- test if node address is part of that frame
				positive? offset
				offset < node-frame-size	; @@ check upper bound case
			]
		][
			frame: frame/next
			assert frame <> null			;-- should found the right one before the list end
		]
	]

	frame/top: frame/top + 1				;-- free node by pushing its address on stack
	frame/top/value: as-integer node

	assert frame/top < (frame/bottom + frame/nodes)	;-- top should not overflow
]

;-------------------------------------------
;-- Allocate a series frame buffer
;-------------------------------------------
alloc-series-frame: func [
	return:	[series-frame!]					;-- newly initialized frame
	/local size frame
][
	size: memory/s-size
	if size < memory/s-max [memory/s-size: size * 2]

	size: size + size? series-frame! 		;-- total required size for a series frame
	frame: as series-frame! allocate-virtual size no ;-- RW only

	either null? memory/s-head [
		memory/s-head: frame				;-- first item in the list
		memory/s-tail: frame
		memory/s-active: frame
		frame/prev:  null
	][
		memory/s-tail/next: frame			;-- append new item at tail of the list
		frame/prev: memory/s-tail			;-- link back to previous tail
		memory/s-tail: frame				;-- now tail is the new item
	]

	frame/next: null
	frame/heap: as series-buffer! (as byte-ptr! frame) + size? series-frame!
	frame/tail: (as byte-ptr! frame) + size	;-- point to last byte in frame
	frame
]

;-------------------------------------------
;-- Release a series frame buffer
;-------------------------------------------
free-series-frame: func [
	frame [series-frame!]					;-- frame to release
][
	either null? frame/prev [				;-- if frame = head
		memory/s-head: frame/next			;-- head now points to next one
	][
		either null? frame/next [			;-- if frame = tail
			memory/s-tail: frame/prev		;-- tail is now at one position back
		][
			frame/prev/next: frame/next		;-- link preceding frame to next frame
			frame/next/prev: frame/prev		;-- link back next frame to preceding frame
		]
	]
	if memory/s-active = frame [
		memory/s-active: memory/s-tail		;-- reset active frame to last one @@
	]

	assert not all [						;-- ensure that list is not empty
		null? memory/s-head
		null? memory/s-tail
	]

	free-virtual as int-ptr! frame			;-- release the memory to the OS
]

;-------------------------------------------
;-- Update moved series internal pointers
;-------------------------------------------
update-series: func [
	series	[series-buffer!]				;-- start of series region with nodes to re-sync
	offset	[integer!]
][
	until [
		;-- update the node pointer to the new series address
		series/node/value: as-integer series

		;-- update offset and tail pointers
		series/offset: as cell! (as byte-ptr! series/offset) - offset
		series/tail:   as cell! (as byte-ptr! series/tail) - offset

		;-- advance to the next series buffer
		series: as series-buffer! (as byte-ptr! series) + series/size + size? series-buffer!

		;-- exit when a freed series is met (<=> end of region)
		zero? (series/flags and series-in-use)
	]
]

;-------------------------------------------
;-- Compact a series frame by moving down in-use series buffer regions
;-------------------------------------------
#define SM1_INIT		1					;-- enter the state machine
#define SM1_GAP			2					;-- begin of contiguous region of freed buffers (hole)
#define SM1_GAP_END		3					;-- end of freed buffers region
#define SM1_USED		4					;-- begin of contiguous region of buffers in use
#define SM1_USED_END	5					;-- end of used buffers region

compact-series-frame: func [
	frame [series-frame!]					;-- series frame to compact
	/local heap series state
		free? [logic!] src [byte-ptr!] dst [byte-ptr!]
][
	series: as series-buffer! (as byte-ptr! frame) + size? series-frame! ;-- point to first series buffer
	free?: zero? (series/flags and series-in-use)  ;-- true: series is not used
	heap: frame/heap

	src: null								;-- src will point to start of buffer region to move down
	dst: null								;-- dst will point to start of free region
	state: SM1_INIT

	until [
		if all [state = SM1_INIT free?][
			dst: as byte-ptr! series		 ;-- start of gap region
			state: SM1_GAP
		]
		if all [state = SM1_GAP not free?][ ;-- search for first used series (<=> end of gap)
			state: SM1_GAP_END
		]
		if state = SM1_GAP_END [
			src: as byte-ptr! series		 ;-- start of new "alive" region
			state: SM1_USED
		]
	 	;-- point to next series buffer
		series: as series-buffer! (as byte-ptr! series) + series/size  + size? series-buffer!
		free?: zero? (series/flags and series-in-use)  ;-- true: series is not used

		if all [state = SM1_USED any [free? series >= heap]][	;-- handle both normal and "exit" states
			state: SM1_USED_END
		]
		if state = SM1_USED_END [
			assert dst < src				 ;-- regions are moved down in memory
			assert src < as byte-ptr! series ;-- src should point at least at series - series/size
			copy-memory dst	src as-integer series - src
			update-series as series-buffer! dst as-integer src - dst
			dst: dst + (as-integer series - src) ;-- points after moved region (ready for next move)
			state: SM1_GAP
		]
		series >= heap						;-- exit state machine
	]

	unless null? dst [						;-- no compaction occurred, all series were in use
		frame/heap: as series-buffer! dst	;-- set new heap after last moved region
	]
]

;-------------------------------------------
;-- Allocate a series from the active series frame, return the series
;-------------------------------------------
alloc-series-buffer: func [
	usize	[integer!]						;-- size in units
	unit	[integer!]						;-- size of atomic elements stored
	offset	[integer!]						;-- force a given offset for series buffer (in bytes)
	return: [series-buffer!]				;-- return the new series buffer
	/local series size frame sz
][
	assert positive? usize
	size: round-to usize * unit size? cell!	;-- size aligned to cell! size

	frame: memory/s-active
	sz: size + size? series-buffer!			;-- add series header size

	series: frame/heap
	if ((as byte-ptr! series) + sz) >= frame/tail [
		; TBD: trigger a GC pass from here and update memory/s-active
		if sz >= memory/s-size [				;@@ temporary checks
			memory/s-size: memory/s-max
		]
		if sz >= memory/s-max [				;@@ temporary checks
			print-line "Memory error: series too big!"
			throw RED_ERROR
		]
		frame: alloc-series-frame
		memory/s-active: frame				;@@ to be removed once GC implemented
		series: frame/heap
	]

	assert sz < _16MB						;-- max series size allowed in a series frame @@

	frame/heap: as series-buffer! (as byte-ptr! frame/heap) + sz

	series/size: size
	series/flags: unit
		or series-in-use 					;-- mark series as in-use
		and not flag-series-big				;-- set type bit to 0 (= series)

	either offset = default-offset [
		offset: size >> 1					;-- target middle of buffer
		series/flags: series/flags or flag-ins-both	;-- optimize for both head & tail insertions (default)
	][
		series/flags: series/flags or flag-ins-tail ;-- optimize for tail insertions only
	]

	series/offset: as cell! (as byte-ptr! series + 1) + offset
	series/tail: series/offset
	series
]

;-------------------------------------------
;-- Allocate a node and a series from the active series frame, return the node
;-------------------------------------------
alloc-series: func [
	size	[integer!]						;-- number of elements to store
	unit	[integer!]						;-- size of atomic elements stored
	offset	[integer!]						;-- force a given offset for series buffer
	return: [int-ptr!]						;-- return a new node pointer (pointing to the newly allocated series buffer)
	/local series node
][
;	#if debug? = yes [print-wide ["allocating series:" size unit offset lf]]

	series: alloc-series-buffer size unit offset
	node: alloc-node						;-- get a new node
	series/node: node						;-- link back series to node
	node/value: as-integer series ;(as byte-ptr! series) + size? series-buffer!
	node									;-- return the node pointer
]

;-------------------------------------------
;-- Wrapper on alloc-series for easy cells allocation
;-------------------------------------------
alloc-cells: func [
	size	[integer!]						;-- number of 16 bytes cells to preallocate
	return: [int-ptr!]						;-- return a new node pointer (pointing to the newly allocated series buffer)
][
	alloc-series size 16 0					;-- optimize by default for tail insertion
]

;-------------------------------------------
;-- Wrapper on alloc-cells for easy cells allocation with cleared buffer
;-------------------------------------------
alloc-cleared-cells: func [
	size	[integer!]						;-- number of 16 bytes cells to preallocate
	return: [int-ptr!]						;-- return a new node pointer (pointing to the newly allocated series buffer)
	/local
		node [node!]
		s	 [series!]
][
	node: alloc-series size 16 0
	s: as series! node/value
	zerofill
		as int-ptr! s/offset
		as int-ptr! ((as byte-ptr! s/offset) + s/size)
	node
]

;-------------------------------------------
;-- Wrapper on alloc-series for byte buffer allocation
;-------------------------------------------
alloc-bytes: func [
	size	[integer!]						;-- number of 16 bytes cells to preallocate
	return: [int-ptr!]						;-- return a new node pointer (pointing to the newly allocated series buffer)
][
	if zero? size [size: 16]
	alloc-series size 1 0					;-- optimize by default for tail insertion
]

;-------------------------------------------
;-- Wrapper on alloc-series for byte-filled buffer allocation
;-------------------------------------------
alloc-bytes-filled: func [
	size	[integer!]						;-- number of 16 bytes cells to preallocate
	byte	[byte!]
	return: [int-ptr!]						;-- return a new node pointer (pointing to the newly allocated series buffer)
	/local
		node [node!]
		s	 [series!]
][
	node: alloc-bytes size
	s: as series! node/value
	fill
		as byte-ptr! s/offset
		(as byte-ptr! s/offset) + s/size
		byte
	node
]

;-------------------------------------------
;-- Set series header flags
;-------------------------------------------
set-flag: func [
	node	[node!]
	flags	[integer!]
	/local series
][
	series: as series-buffer! node/value
	series/flags: (series/flags and not flags) or flags	;-- reset flags bits, then apply flags
]

;-------------------------------------------
;-- Release a series
;-------------------------------------------
free-series: func [
	frame	[series-frame!]					;-- frame containing the series (should be provided by the GC)
	node	[int-ptr!]						;-- series' node pointer
	/local series
][
	assert not null? frame
	assert not null? node
	assert not null? (as byte-ptr! node/value)

	series: as series-buffer! node/value
	assert not zero? (series/flags and not series-in-use) ;-- ensure that 'used bit is set
	series/flags: series/flags and series-free-mask		  ;-- clear 'used bit (enough to free the series)

	if frame/heap = as series-buffer! (		;-- test if series is on top of heap
		(as byte-ptr! node/value) +  series/size + size? series-buffer!
	) [
		frame/heap = series					;-- cheap collecting of last allocated series
	]
	free-node node
]

;-------------------------------------------
;-- Expand a series to a new size
;-------------------------------------------
expand-series: func [
	series  [series-buffer!]				;-- series to expand
	new-sz	[integer!]						;-- new size in bytes
	return: [series-buffer!]				;-- return new series with new size
	/local new units delta
][
	;#if debug? = yes [print-wide ["series expansion triggered for:" series new-sz lf]]

	assert not null? series
	assert any [
		zero? new-sz
		new-sz > series/size				;-- ensure requested size is bigger than current one
	]
	units: GET_UNIT(series)

	if zero? new-sz [
		new-sz: series/size * 2				;-- by default, alloc twice the old size
		if new-sz >= _2MB [
			print-line "Memory error: allocate memory > 2MB (--NOT_IMPLEMENTED--)"
			throw RED_ERROR
			;TBD: alloc big
		]
	]

	new: alloc-series-buffer new-sz / units units 0

	series/node/value: as-integer new		;-- link node to new series buffer
	delta: as-integer series/tail - series/offset

	new/flags:	series/flags
	new/node:   series/node
	new/tail:   as cell! (as byte-ptr! new/offset) + delta

	;TBD: honor flag-ins-head and flag-ins-tail when copying!
	copy-memory 							;-- copy old series in new buffer
		as byte-ptr! new/offset
		as byte-ptr! series/offset
		series/size

	assert not zero? (series/flags and not series-in-use) ;-- ensure that 'used bit is set
	series/flags: series/flags xor series-in-use		  ;-- clear 'used bit (enough to free the series)
	new
]

;-------------------------------------------
;-- Expand a series to a new size and zero-fill extra space
;-------------------------------------------
expand-series-filled: func [
	s		[series-buffer!]				;-- series to expand
	new-sz	[integer!]						;-- new size in bytes
	byte	[byte!]							;-- byte to fill the extended region with
	return: [series-buffer!]
	/local
		old [integer!]
][
	old: s/size
	s: expand-series s new-sz
	fill (as byte-ptr! s/offset) + old (as byte-ptr! s/offset) + s/size byte
	s
]
;-------------------------------------------
;-- Shrink a series to a smaller size (not needed for now)
;-------------------------------------------
;shrink-series: func [
;	series  [series-buffer!]
;	return: [series-buffer!]
;][
;
;]

;-------------------------------------------
;-- Copy a series buffer
;-------------------------------------------
copy-series: func [
	s 		[series!]
	return: [node!]
	/local
		node   [node!]
		new	   [series!]
][
	node: alloc-bytes s/size

	new: as series! node/value
	new/flags: s/flags
	new/tail: as cell! (as byte-ptr! new/offset) + (as-integer s/tail - s/offset)

	unless zero? s/size [
		copy-memory
			as byte-ptr! new/offset
			as byte-ptr! s/offset
			s/size
	]
	node
]

;-------------------------------------------
;-- Allocate a big series
;-------------------------------------------
alloc-big: func [
	size [integer!]							;-- buffer size to allocate (in bytes)
	return: [byte-ptr!]						;-- return allocated buffer pointer
	/local sz frame frm
][
	assert positive? size
	assert size >= _2MB						;-- should be bigger than a series frame

	sz: size + size? big-frame! 			;-- total required size for a big frame
	frame: as big-frame! allocate-virtual sz no ;-- R/W only

	frame/next: null
	frame/size: size

	either null? memory/b-head [
		memory/b-head: frame				;-- first item in the list
	][
		frm: memory/b-head					;-- search for tail of list (@@ might want to save it?)
		until [frm: frm/next null? frm/next]
		assert not null? frm

		frm/next: frame						;-- append new item at tail of the list
	]

	(as byte-ptr! frame) + size? big-frame!	;-- return a pointer to the requested buffer
]

;-------------------------------------------
;-- Release a big series
;-------------------------------------------
free-big: func [
	buffer	[byte-ptr!]						;-- big buffer to release
	/local frame frm
][
	assert not null? buffer

	frame: as big-frame! (buffer - size? big-frame!)  ;-- point to frame header

	either frame = memory/b-head [
		memory/b-head: null
	][
		frm: memory/b-head					;-- search for frame position in list
		while [frm/next <> frame][			;-- frm should point to one item behind frame on exit
			frm: frm/next
			assert not null? frm			;-- ensure tail of list is not passed
		]
		frm/next: frame/next				;-- remove frame from list
	]

	free-virtual as int-ptr! frame			;-- release the memory to the OS
]

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

#define _512KB				524288
#define _2MB				2097152
#define _16MB				16777216
#define nodes-per-frame		5000
#define node-frame-size		[((nodes-per-frame * 2 * size? pointer!) + size? node-frame!)]

#define series-in-use		80000000h		;-- mark a series as used (not collectable by the GC)
#define flag-ins-both		30000000h		;-- optimize for both head & tail insertions
#define flag-ins-tail		20000000h		;-- optimize for tail insertions
#define flag-ins-head		10000000h		;-- optimize for head insertions
#define flag-series-big		01000000h		;-- 1 = big, 0 = series
#define flag-series-small	00800000h		;-- series <= 16 bytes
#define flag-series-stk		00400000h		;-- values block allocated on stack
#define flag-series-nogc	00200000h		;-- protected from GC (system-critical series)
#define flag-series-fixed	00100000h		;-- series cannot be relocated (system-critical series)
#define flag-bitset-not		00080000h		;-- complement flag for bitsets

#define flag-arity-mask		C1FFFFFFh		;-- mask for readind routines arity field
#define flag-self-mask		FEFFFFFFh		;-- mask for setting self? flag
#define set-self-mask		01000000h		;-- mask for reading self? flag
#define body-mask			FF7FFFFFh		;-- mask for op! body node
#define body-flag			00800000h		;-- flag for op! body node
#define flag-unit-mask		FFFFFFE0h		;-- mask for reading unit field in series-buffer!
#define get-unit-mask		0000001Fh		;-- mask for setting unit field in series-buffer!
#define series-free-mask	7FFFFFFFh		;-- mark a series as used (not collectable by the GC)
#define flag-not-mask		FFF7FFFFh		;-- mask for complement flag

#define type-mask			FFFFFF00h		;-- mask for clearing type ID in cell header
#define get-type-mask		000000FFh		;-- mask for reading type ID in cell header
#define node!				int-ptr!
#define default-offset		-1				;-- for offset value in alloc-series calls

#define series!				series-buffer!

int-array!: alias struct! [ptr [int-ptr!]]

;-- cell header bits layout --
;   31:		lock							;-- lock series for active thread access only
;   30:		new-line						;-- new-line (LF) marker (before the slot)
;	29-25:	arity							;-- arity for routine! functions.
;	24:		self?							;-- self-aware context flag
;	23:		node-body						;-- op! body points to a block node (instead of native code)
;   22-8:	<reserved>
;   7-0:	datatype ID						;-- datatype number

cell!: alias struct! [
	header	[integer!]						;-- cell's header flags
	data1	[integer!]						;-- placeholders to make a 128-bit cell
	data2	[integer!]
	data3	[integer!]
]

;-- series flags --
;	31: 	used 							;-- 1 = used, 0 = free
;	30: 	type 							;-- always 0 for series-buffer!
;	29-28: 	insert-opt						;-- optimized insertions: 2 = head, 1 = tail, 0 = both
;   27:		mark							;-- mark as referenced for the GC (mark phase)
;   26:		lock							;-- lock series for active thread access only
;   25:		immutable						;-- mark as read-only
;   24:		big								;-- indicates a big series (big-frame!)
;	23:		small							;-- reserved
;	22:		stack							;-- series buffer is allocated on stack
;   21:		permanent						;-- protected from GC (system-critical series)
;   20:     fixed							;-- series cannot be relocated (system-critical series)
;	19:		complement						;-- complement flag for bitsets
;	18-3: 	<reserved>
;	4-0:	unit							;-- size in bytes of atomic element stored in buffer
											;-- 0: UTF-8, 1: Latin1/binary, 2: UCS-2, 4: UCS-4, 16: block! cell
series-buffer!: alias struct! [
	flags	[integer!]						;-- series flags
	node	[int-ptr!]						;-- point back to referring node
	size	[integer!]						;-- usable buffer size (series-buffer! struct excluded)
	offset	[cell!]							;-- series buffer offset pointer (insert at head optimization)
	tail	[cell!]							;-- series buffer tail pointer
]

series-frame!: alias struct! [				;-- series frame header
	next	[series-frame!]					;-- next frame or null
	prev	[series-frame!]					;-- previous frame or null
	heap	[series-buffer!]				;-- point to allocatable region
	tail	[byte-ptr!]						;-- point to last byte in allocatable region
]

node-frame!: alias struct! [				;-- node frame header
	next	[node-frame!]					;-- next frame or null
	prev	[node-frame!]					;-- previous frame or null
	nodes	[integer!]						;-- number of nodes
	bottom	[int-ptr!]						;-- bottom of stack (last entry, fixed)
	top		[int-ptr!]						;-- top of stack (first entry, moving)
]

big-frame!: alias struct! [					;-- big frame header (for >= 2MB series)
	flags	[integer!]						;-- bit 30: 1 (type = big)
	next	[big-frame!]					;-- next frame or null
	size	[integer!]						;-- size (up to 4GB - size? header)
	padding [integer!]						;-- make this header same size as series-buffer! header
]

memory: declare struct! [					; TBD: instanciate this structure per OS thread
	total	 [integer!]						;-- total memory size allocated (in bytes)
	n-head	 [node-frame!]					;-- head of node frames list
	n-active [node-frame!]					;-- actively used node frame
	n-tail	 [node-frame!]					;-- tail of node frames list
	s-head	 [series-frame!]				;-- head of series frames list
	s-active [series-frame!]				;-- actively used series frame
	s-tail	 [series-frame!]				;-- tail of series frames list
	s-start	 [integer!]						;-- start size for new series frame		(1)
	s-size	 [integer!]						;-- current size for new series frame	(1)
	s-max	 [integer!]						;-- max size for new series frames		(1)
	b-head	 [big-frame!]					;-- head of big frames list
]

init-mem: does [
	memory/total: 	0
	memory/s-start: _512KB
	memory/s-max: 	_2MB
	memory/s-size: 	memory/s-start
]

;; (1) Series frames size will grow from 512KB up to 2MB (arbitrary selected). This
;; range will need fine-tuning with real Red apps. This growing size, with low starting value
;; will allow small apps to not consume much memory while avoiding to penalize big apps.

;-------------------------------------------
;-- Fill a memory region with a given byte
;-------------------------------------------
fill: func [
	p	  [byte-ptr!]
	end   [byte-ptr!]
	byte  [byte!]
	/local
		p4		 [int-ptr!]
		tail	 [int-ptr!]
		cnt		 [integer!]
		byte4	 [integer!]
		aligned? [logic!]
][
	cnt: (as-integer p) and 3
	unless zero? cnt [						;-- preprocess unaligned beginning
		while [cnt > 0][p/cnt: byte cnt: cnt - 1]
		p: as byte-ptr! (as-integer p) + 4 and -4
	]

	aligned?: zero? ((as-integer end) and 3)
	tail: either aligned? [as int-ptr! end][as int-ptr! (as-integer end) and -4]
	p4: as int-ptr! p

	if p4 < tail [
		byte4: either byte = null-byte [0][
			byte4: as-integer byte
			(byte4 << 24) or (byte4 << 16) or (byte4 << 8) or byte4
		]
		while [p4 < tail][p4/value: byte4 p4: p4 + 1] ;-- zero fill target region using 32-bit accesses
	]

	unless aligned? [						;-- postprocess unaligned ending
		cnt: (as-integer end) and 3
		while [cnt > 0][end/cnt: byte cnt: cnt - 1]
	]
]

;-------------------------------------------
;-- Clear a memory region which size is a multiple of cell size
;-------------------------------------------
zerofill: func [
	p		[int-ptr!]
	end		[int-ptr!]
][
	assert p < end
	until [
		p/value: 0
		p: p + 1
		p = end
	]
]

;-------------------------------------------
;-- Allocate paged virtual memory region
;-------------------------------------------
allocate-virtual: func [
	size 	[integer!]						;-- allocated size in bytes (page size multiple)
	exec? 	[logic!]						;-- TRUE => executable region
	return: [int-ptr!]						;-- allocated memory region pointer
	/local ptr
][
	size: round-to size + 4	platform/page-size	;-- account for header (one word)
	memory/total: memory/total + size
	ptr: platform/allocate-virtual size exec?
	ptr/value: size							;-- store size in header
	ptr + 1									;-- return pointer after header
]

;-------------------------------------------
;-- Free paged virtual memory region from OS
;-------------------------------------------
free-virtual: func [
	ptr [int-ptr!]							;-- address of memory region to release
][
	ptr: ptr - 1							;-- return back to header
	memory/total: memory/total - ptr/value
	platform/free-virtual ptr
]

;-------------------------------------------
;-- Free all frames (part of Red's global exit handler)
;-------------------------------------------
free-all: func [
	/local n-frame s-frame b-frame n-next s-next b-next
][
	n-frame: memory/n-head
	while [n-frame <> null][
		n-next: n-frame/next
		free-virtual as int-ptr! n-frame
		n-frame: n-next
	]

	s-frame: memory/s-head
	while [s-frame <> null][
		s-next: s-frame/next
		free-virtual as int-ptr! s-frame
		s-frame: s-next
	]

	b-frame: memory/b-head
	while [b-frame <> null][
		b-next: b-frame/next
		free-virtual as int-ptr! b-frame
		b-frame: b-next
	]
]

;-------------------------------------------
;-- Format the node frame stack by filling it with pointers to all nodes
;-------------------------------------------
format-node-stack: func [
	frame [node-frame!]						;-- node frame to format
	/local node ptr
][
	ptr: frame/bottom						;-- point to bottom of stack
	node: ptr + frame/nodes					;-- first free node address
	until [
		ptr/value: as-integer node			;-- store free node address on stack
		node: node + 1
		ptr: ptr + 1
		ptr > frame/top						;-- until the stack is filled up
	]
]

;-------------------------------------------
;-- Allocate a node frame buffer and initialize it
;-------------------------------------------
alloc-node-frame: func [
	size 	[integer!]						;-- nb of nodes
	return:	[node-frame!]					;-- newly initialized frame
	/local sz frame
][
	assert positive? size
	sz: size * 2 * (size? pointer!) + (size? node-frame!) ;-- total required size for a node frame
	frame: as node-frame! allocate-virtual sz no ;-- R/W only

	frame/prev:  null
	frame/next:  null
	frame/nodes: size

	frame/bottom: as int-ptr! (as byte-ptr! frame) + size? node-frame!
	frame/top: frame/bottom + size - 1		;-- point to the top element

	either null? memory/n-head [
		memory/n-head: frame				;-- first item in the list
		memory/n-tail: frame
		memory/n-active: frame
	][
		memory/n-tail/next: frame			;-- append new item at tail of the list
		frame/prev: memory/n-tail			;-- link back to previous tail
		memory/n-tail: frame				;-- now tail is the new item
	]

	format-node-stack frame					;-- prepare the node frame for use
	frame
]

;-------------------------------------------
;-- Release a node frame buffer
;-------------------------------------------
free-node-frame: func [
	frame [node-frame!]						;-- frame to release
][
	either null? frame/prev [				;-- if frame = head
		memory/n-head: frame/next			;-- head now points to next one
	][
		either null? frame/next [			;-- if frame = tail
			memory/n-tail: frame/prev		;-- tail is now at one position back
		][
			frame/prev/next: frame/next		;-- link preceding frame to next frame
			frame/next/prev: frame/prev		;-- link back next frame to preceding frame
		]
	]
	if memory/n-active = frame [
		memory/n-active: memory/n-tail		;-- reset active frame to last one @@
	]

	assert not all [						;-- ensure that list is not empty
		null? memory/n-head
		null? memory/n-tail
	]

	free-virtual as int-ptr! frame			;-- release the memory to the OS
]

;-------------------------------------------
;-- Obtain a free node from a node frame
;-------------------------------------------
alloc-node: func [
	return: [int-ptr!]						;-- return a free node pointer
	/local frame node
][
	frame: memory/n-active					;-- take node from active node frame
	node: as int-ptr! frame/top/value		;-- pop free node address from stack
	frame/top: frame/top - 1

	if frame/top = frame/bottom [
		; TBD: trigger a "light" GC pass from here and update memory/n-active
		frame: alloc-node-frame nodes-per-frame	;-- allocate a new frame
		memory/n-active: frame				;@@ to be removed once GC implemented
		node: as int-ptr! frame/top/value	;-- pop free node address from stack
		frame/top: frame/top - 1
	]
	node
]

;-------------------------------------------
;-- Release a used node
;-------------------------------------------
free-node: func [
	node [int-ptr!]							;-- node to release
	/local frame offset
][
	assert not null? node

	frame: memory/n-active
	offset: as-integer node - frame

	unless all [
		positive? offset					;-- check if node address is part of active frame
		offset < node-frame-size
	][										;@@ following code not be needed if freed only by the GC...
		frame: memory/n-head				;-- search for right frame from head of the list
		while [								; @@ could be optimized by searching backward/forward from active frame
			offset: as-integer node - frame
			not all [						;-- test if node address is part of that frame
				positive? offset
				offset < node-frame-size	; @@ check upper bound case
			]
		][
			frame: frame/next
			assert frame <> null			;-- should found the right one before the list end
		]
	]

	frame/top: frame/top + 1				;-- free node by pushing its address on stack
	frame/top/value: as-integer node

	assert frame/top < (frame/bottom + frame/nodes)	;-- top should not overflow
]

;-------------------------------------------
;-- Allocate a series frame buffer
;-------------------------------------------
alloc-series-frame: func [
	return:	[series-frame!]					;-- newly initialized frame
	/local size frame
][
	size: memory/s-size
	if size < memory/s-max [memory/s-size: size * 2]

	size: size + size? series-frame! 		;-- total required size for a series frame
	frame: as series-frame! allocate-virtual size no ;-- RW only

	either null? memory/s-head [
		memory/s-head: frame				;-- first item in the list
		memory/s-tail: frame
		memory/s-active: frame
		frame/prev:  null
	][
		memory/s-tail/next: frame			;-- append new item at tail of the list
		frame/prev: memory/s-tail			;-- link back to previous tail
		memory/s-tail: frame				;-- now tail is the new item
	]

	frame/next: null
	frame/heap: as series-buffer! (as byte-ptr! frame) + size? series-frame!
	frame/tail: (as byte-ptr! frame) + size	;-- point to last byte in frame
	frame
]

;-------------------------------------------
;-- Release a series frame buffer
;-------------------------------------------
free-series-frame: func [
	frame [series-frame!]					;-- frame to release
][
	either null? frame/prev [				;-- if frame = head
		memory/s-head: frame/next			;-- head now points to next one
	][
		either null? frame/next [			;-- if frame = tail
			memory/s-tail: frame/prev		;-- tail is now at one position back
		][
			frame/prev/next: frame/next		;-- link preceding frame to next frame
			frame/next/prev: frame/prev		;-- link back next frame to preceding frame
		]
	]
	if memory/s-active = frame [
		memory/s-active: memory/s-tail		;-- reset active frame to last one @@
	]

	assert not all [						;-- ensure that list is not empty
		null? memory/s-head
		null? memory/s-tail
	]

	free-virtual as int-ptr! frame			;-- release the memory to the OS
]

;-------------------------------------------
;-- Update moved series internal pointers
;-------------------------------------------
update-series: func [
	series	[series-buffer!]				;-- start of series region with nodes to re-sync
	offset	[integer!]
][
	until [
		;-- update the node pointer to the new series address
		series/node/value: as-integer series

		;-- update offset and tail pointers
		series/offset: as cell! (as byte-ptr! series/offset) - offset
		series/tail:   as cell! (as byte-ptr! series/tail) - offset

		;-- advance to the next series buffer
		series: as series-buffer! (as byte-ptr! series) + series/size + size? series-buffer!

		;-- exit when a freed series is met (<=> end of region)
		zero? (series/flags and series-in-use)
	]
]

;-------------------------------------------
;-- Compact a series frame by moving down in-use series buffer regions
;-------------------------------------------
#define SM1_INIT		1					;-- enter the state machine
#define SM1_GAP			2					;-- begin of contiguous region of freed buffers (hole)
#define SM1_GAP_END		3					;-- end of freed buffers region
#define SM1_USED		4					;-- begin of contiguous region of buffers in use
#define SM1_USED_END	5					;-- end of used buffers region

compact-series-frame: func [
	frame [series-frame!]					;-- series frame to compact
	/local heap series state
		free? [logic!] src [byte-ptr!] dst [byte-ptr!]
][
	series: as series-buffer! (as byte-ptr! frame) + size? series-frame! ;-- point to first series buffer
	free?: zero? (series/flags and series-in-use)  ;-- true: series is not used
	heap: frame/heap

	src: null								;-- src will point to start of buffer region to move down
	dst: null								;-- dst will point to start of free region
	state: SM1_INIT

	until [
		if all [state = SM1_INIT free?][
			dst: as byte-ptr! series		 ;-- start of gap region
			state: SM1_GAP
		]
		if all [state = SM1_GAP not free?][ ;-- search for first used series (<=> end of gap)
			state: SM1_GAP_END
		]
		if state = SM1_GAP_END [
			src: as byte-ptr! series		 ;-- start of new "alive" region
			state: SM1_USED
		]
	 	;-- point to next series buffer
		series: as series-buffer! (as byte-ptr! series) + series/size  + size? series-buffer!
		free?: zero? (series/flags and series-in-use)  ;-- true: series is not used

		if all [state = SM1_USED any [free? series >= heap]][	;-- handle both normal and "exit" states
			state: SM1_USED_END
		]
		if state = SM1_USED_END [
			assert dst < src				 ;-- regions are moved down in memory
			assert src < as byte-ptr! series ;-- src should point at least at series - series/size
			copy-memory dst	src as-integer series - src
			update-series as series-buffer! dst as-integer src - dst
			dst: dst + (as-integer series - src) ;-- points after moved region (ready for next move)
			state: SM1_GAP
		]
		series >= heap						;-- exit state machine
	]

	unless null? dst [						;-- no compaction occurred, all series were in use
		frame/heap: as series-buffer! dst	;-- set new heap after last moved region
	]
]

;-------------------------------------------
;-- Allocate a series from the active series frame, return the series
;-------------------------------------------
alloc-series-buffer: func [
	usize	[integer!]						;-- size in units
	unit	[integer!]						;-- size of atomic elements stored
	offset	[integer!]						;-- force a given offset for series buffer (in bytes)
	return: [series-buffer!]				;-- return the new series buffer
	/local series size frame sz
][
	assert positive? usize
	size: round-to usize * unit size? cell!	;-- size aligned to cell! size

	frame: memory/s-active
	sz: size + size? series-buffer!			;-- add series header size

	series: frame/heap
	if ((as byte-ptr! series) + sz) >= frame/tail [
		; TBD: trigger a GC pass from here and update memory/s-active
		if sz >= memory/s-size [				;@@ temporary checks
			memory/s-size: memory/s-max
		]
		if sz >= memory/s-max [				;@@ temporary checks
			print-line "Memory error: series too big!"
			--NOT_IMPLEMENTED--
		]
		frame: alloc-series-frame
		memory/s-active: frame				;@@ to be removed once GC implemented
		series: frame/heap
	]

	assert sz < _16MB						;-- max series size allowed in a series frame @@

	frame/heap: as series-buffer! (as byte-ptr! frame/heap) + sz

	series/size: size
	series/flags: unit
		or series-in-use 					;-- mark series as in-use
		and not flag-series-big				;-- set type bit to 0 (= series)

	either offset = default-offset [
		offset: size >> 1					;-- target middle of buffer
		series/flags: series/flags or flag-ins-both	;-- optimize for both head & tail insertions (default)
	][
		series/flags: series/flags or flag-ins-tail ;-- optimize for tail insertions only
	]

	series/offset: as cell! (as byte-ptr! series + 1) + offset
	series/tail: series/offset
	series
]

;-------------------------------------------
;-- Allocate a node and a series from the active series frame, return the node
;-------------------------------------------
alloc-series: func [
	size	[integer!]						;-- number of elements to store
	unit	[integer!]						;-- size of atomic elements stored
	offset	[integer!]						;-- force a given offset for series buffer
	return: [int-ptr!]						;-- return a new node pointer (pointing to the newly allocated series buffer)
	/local series node
][
;	#if debug? = yes [print-wide ["allocating series:" size unit offset lf]]

	series: alloc-series-buffer size unit offset
	node: alloc-node						;-- get a new node
	series/node: node						;-- link back series to node
	node/value: as-integer series ;(as byte-ptr! series) + size? series-buffer!
	node									;-- return the node pointer
]

;-------------------------------------------
;-- Wrapper on alloc-series for easy cells allocation
;-------------------------------------------
alloc-cells: func [
	size	[integer!]						;-- number of 16 bytes cells to preallocate
	return: [int-ptr!]						;-- return a new node pointer (pointing to the newly allocated series buffer)
][
	alloc-series size 16 0					;-- optimize by default for tail insertion
]

;-------------------------------------------
;-- Wrapper on alloc-cells for easy cells allocation with cleared buffer
;-------------------------------------------
alloc-cleared-cells: func [
	size	[integer!]						;-- number of 16 bytes cells to preallocate
	return: [int-ptr!]						;-- return a new node pointer (pointing to the newly allocated series buffer)
	/local
		node [node!]
		s	 [series!]
][
	node: alloc-series size 16 0
	s: as series! node/value
	zerofill
		as int-ptr! s/offset
		as int-ptr! ((as byte-ptr! s/offset) + s/size)
	node
]

;-------------------------------------------
;-- Wrapper on alloc-series for byte buffer allocation
;-------------------------------------------
alloc-bytes: func [
	size	[integer!]						;-- number of 16 bytes cells to preallocate
	return: [int-ptr!]						;-- return a new node pointer (pointing to the newly allocated series buffer)
][
	if zero? size [size: 16]
	alloc-series size 1 0					;-- optimize by default for tail insertion
]

;-------------------------------------------
;-- Wrapper on alloc-series for byte-filled buffer allocation
;-------------------------------------------
alloc-bytes-filled: func [
	size	[integer!]						;-- number of 16 bytes cells to preallocate
	byte	[byte!]
	return: [int-ptr!]						;-- return a new node pointer (pointing to the newly allocated series buffer)
	/local
		node [node!]
		s	 [series!]
][
	node: alloc-bytes size
	s: as series! node/value
	fill
		as byte-ptr! s/offset
		(as byte-ptr! s/offset) + s/size
		byte
	node
]

;-------------------------------------------
;-- Set series header flags
;-------------------------------------------
set-flag: func [
	node	[node!]
	flags	[integer!]
	/local series
][
	series: as series-buffer! node/value
	series/flags: (series/flags and not flags) or flags	;-- reset flags bits, then apply flags
]

;-------------------------------------------
;-- Release a series
;-------------------------------------------
free-series: func [
	frame	[series-frame!]					;-- frame containing the series (should be provided by the GC)
	node	[int-ptr!]						;-- series' node pointer
	/local series
][
	assert not null? frame
	assert not null? node
	assert not null? (as byte-ptr! node/value)

	series: as series-buffer! node/value
	assert not zero? (series/flags and not series-in-use) ;-- ensure that 'used bit is set
	series/flags: series/flags and series-free-mask		  ;-- clear 'used bit (enough to free the series)

	if frame/heap = as series-buffer! (		;-- test if series is on top of heap
		(as byte-ptr! node/value) +  series/size + size? series-buffer!
	) [
		frame/heap = series					;-- cheap collecting of last allocated series
	]
	free-node node
]

;-------------------------------------------
;-- Expand a series to a new size
;-------------------------------------------
expand-series: func [
	series  [series-buffer!]				;-- series to expand
	new-sz	[integer!]						;-- new size in bytes
	return: [series-buffer!]				;-- return new series with new size
	/local new units delta
][
	;#if debug? = yes [print-wide ["series expansion triggered for:" series new-sz lf]]

	assert not null? series
	assert any [
		zero? new-sz
		new-sz > series/size				;-- ensure requested size is bigger than current one
	]
	units: GET_UNIT(series)

	if zero? new-sz [
		new-sz: series/size * 2				;-- by default, alloc twice the old size
		if new-sz >= _2MB [
			--NOT_IMPLEMENTED--
			;TBD: alloc big
		]
	]

	new: alloc-series-buffer new-sz / units units 0

	series/node/value: as-integer new		;-- link node to new series buffer
	delta: as-integer series/tail - series/offset

	new/flags:	series/flags
	new/node:   series/node
	new/tail:   as cell! (as byte-ptr! new/offset) + delta

	;TBD: honor flag-ins-head and flag-ins-tail when copying!
	copy-memory 							;-- copy old series in new buffer
		as byte-ptr! new/offset
		as byte-ptr! series/offset
		series/size

	assert not zero? (series/flags and not series-in-use) ;-- ensure that 'used bit is set
	series/flags: series/flags xor series-in-use		  ;-- clear 'used bit (enough to free the series)
	new
]

;-------------------------------------------
;-- Expand a series to a new size and zero-fill extra space
;-------------------------------------------
expand-series-filled: func [
	s		[series-buffer!]				;-- series to expand
	new-sz	[integer!]						;-- new size in bytes
	byte	[byte!]							;-- byte to fill the extended region with
	return: [series-buffer!]
	/local
		old [integer!]
][
	old: s/size
	s: expand-series s new-sz
	fill (as byte-ptr! s/offset) + old (as byte-ptr! s/offset) + s/size byte
	s
]
;-------------------------------------------
;-- Shrink a series to a smaller size (not needed for now)
;-------------------------------------------
;shrink-series: func [
;	series  [series-buffer!]
;	return: [series-buffer!]
;][
;
;]

;-------------------------------------------
;-- Copy a series buffer
;-------------------------------------------
copy-series: func [
	s 		[series!]
	return: [node!]
	/local
		node   [node!]
		new	   [series!]
][
	node: alloc-bytes s/size

	new: as series! node/value
	new/flags: s/flags
	new/tail: as cell! (as byte-ptr! new/offset) + (as-integer s/tail - s/offset)

	unless zero? s/size [
		copy-memory
			as byte-ptr! new/offset
			as byte-ptr! s/offset
			s/size
	]
	node
]

;-------------------------------------------
;-- Allocate a big series
;-------------------------------------------
alloc-big: func [
	size [integer!]							;-- buffer size to allocate (in bytes)
	return: [byte-ptr!]						;-- return allocated buffer pointer
	/local sz frame frm
][
	assert positive? size
	assert size >= _2MB						;-- should be bigger than a series frame

	sz: size + size? big-frame! 			;-- total required size for a big frame
	frame: as big-frame! allocate-virtual sz no ;-- R/W only

	frame/next: null
	frame/size: size

	either null? memory/b-head [
		memory/b-head: frame				;-- first item in the list
	][
		frm: memory/b-head					;-- search for tail of list (@@ might want to save it?)
		until [frm: frm/next null? frm/next]
		assert not null? frm

		frm/next: frame						;-- append new item at tail of the list
	]

	(as byte-ptr! frame) + size? big-frame!	;-- return a pointer to the requested buffer
]

;-------------------------------------------
;-- Release a big series
;-------------------------------------------
free-big: func [
	buffer	[byte-ptr!]						;-- big buffer to release
	/local frame frm
][
	assert not null? buffer

	frame: as big-frame! (buffer - size? big-frame!)  ;-- point to frame header

	either frame = memory/b-head [
		memory/b-head: null
	][
		frm: memory/b-head					;-- search for frame position in list
		while [frm/next <> frame][			;-- frm should point to one item behind frame on exit
			frm: frm/next
			assert not null? frm			;-- ensure tail of list is not passed
		]
		frm/next: frame/next				;-- remove frame from list
	]

	free-virtual as int-ptr! frame			;-- release the memory to the OS
]