Add exception handler fix

* tests/base.scm: add two tests for issue #556

The two tests are adapted from issue #556 (originally from r7rs).
The tests currently fail because errors and raised objects are
treated in the same way.

* Use different tags for raised objects and raised errors

The behaviour for raising an error (error message irritants) and
objects (raise object) are different in r7rs. So tag error objects
differently, and adjust the raised object handling to handle
the raised object instead of a list containing the raised object.

This should resolve issue #556.

* runtime: use the correct string length for comparison

Fix for the pull request adressing issue #556.

* runtime: distinguish exceptions and errors in default handler

* repl: use error-object? to decide whether an error or an exception was raised

This makes error messages a bit more informative.  Also, if error objects become
a distinct type, then the repl implementation will continue to be correct. The
(deleted) second cond clause seemed to be bit redundant - I am not sure what the
original intent was.

* tests/base.scm: revert accidental deletion of else clause

* Display exceptions as errors for consistency

.github/workflows/c-api-docs.yml

@@ -0,0 +1,27 @@
+name: C API Docs
+
+#on: [create]
+on: [push]
+
+jobs:
+  build:
+
+    runs-on: ubuntu-latest
+    
+    strategy:    
+      matrix:
+        arch: [64]
+    
+    steps:
+    - uses: actions/checkout@v1
+    - name: Install doxygen
+      run: sudo apt-get install doxygen
+    - name: make doc
+      run: make doc && tar -cf html.tar html && bzip2 html.tar
+            
+    - name: upload deb
+      if: matrix.arch == '64'
+      uses: actions/upload-artifact@v4
+      with:
+        name: cyclone-scheme docs
+        path: html.tar.bz2

.github/workflows/c-runtime-unit-tests.yml

@@ -0,0 +1,27 @@
+name: C Runtime Unit Tests
+
+#on: [create]
+on: [push]
+
+jobs:
+  build:
+
+    runs-on: ubuntu-latest
+    
+    strategy:    
+      matrix:
+        arch: [64]
+    
+    steps:
+    # Install dependencies
+    - name: Install libck
+      run: sudo apt-get install libck-dev    
+    #- name: Install Cyclone
+    #  run: |
+    #    wget https://github.com/cyclone-scheme/binary-releases/raw/master/ubuntu-18.04-lts/cyclone-scheme_0.30.0_amd64.deb 
+    #    sudo apt install ./cyclone-scheme_0.30.0_amd64.deb
+    - uses: actions/checkout@v1
+
+    # Execute runtime library unit tests
+    - name: make test-lib
+      run: make libcyclone.a && make test-lib && ./test-lib

.github/workflows/ci.yml

@@ -0,0 +1,22 @@
+name: Ubuntu Linux Build
+
+on: [push]
+
+jobs:
+  build:
+
+    runs-on: ubuntu-latest
+    
+    strategy:    
+      matrix:
+        arch: [32, 64]
+    
+    steps:
+    - uses: actions/checkout@v1
+    - name: Install deps
+      run: sudo apt-get install indent
+    - name: Install ck
+      run: sudo apt-get install libck-dev
+    - name: make runtime
+      run: make libcyclone.a
+            

.github/workflows/formatting.yml

@@ -0,0 +1,21 @@
+name: Code Formatting
+
+on: [push]
+
+jobs:
+  build:
+
+    runs-on: ubuntu-latest
+    
+    strategy:    
+      matrix:
+        arch: [64]
+    
+    steps:
+    - uses: actions/checkout@v1
+    - name: Install deps
+      run: sudo apt-get install -y indent
+    - name: formatting
+      run: |
+        make test-format 
+            

Architecture.md

@@ -0,0 +1,71 @@
+** This document is incomplete and a work in progress **
+
+# High level design
+
+Cyclone has a similar architecture to other modern compilers:
+
+<img src="docs/images/compiler.png" alt="flowchart of cyclone compiler">
+
+First, an input file containing Scheme code is received on the command line and loaded into an abstract syntax tree (AST) by Cyclone's parser. From there a series of source-to-source transformations are performed on the AST to expand macros, perform optimizations, and make the code easier to compile to C. These intermediate representations (IR) can be printed out in a readable format to aid debugging. The final AST is then output as a `.c` file and the C compiler is invoked to create the final executable or object file.
+
+Programs are linked with the necessary Scheme libraries and the Cyclone runtime library to create an executable:
+
+<img src="docs/images/runtime.png" alt="Diagram of files linked into a compiled executable">
+
+For more high-level overview of the project a good place to start is [Writing the Cyclone Scheme Compiler](docs/Writing-the-Cyclone-Scheme-Compiler-Revised-2017.md).
+
+# Code Map
+
+This section provides an overview of the code and module layout used by Cyclone. The [API Documentation](docs/API.md) provides more details on individual modules within these directories as well as code-level API documentation.
+
+## `scheme/`
+
+Code for the built-in Scheme standard libraries lives at the top level of this directory. In general all of the code here is written to conform to the Scheme R7RS specification.
+
+## `scheme/cyclone`
+
+Scheme code for the Cyclone compiler itself lives here as a set of libraries.
+
+There are front-end programs at the top-level of the Cyclone repository that use these libraries:
+
+- `cyclone.scm` for the compiler
+- `icyc.scm` for the interpreter
+
+## `srfi/`
+
+Implementations of various Scheme SRFI's that are distributed directly with Cyclone.
+
+In general the recommended way to distribute SRFI's is to use the Winds package manager. At this point there would need to be a very good reason to include a new SRFI here in the main Cyclone repository.
+
+## `runtime.c`
+
+Most of the code for the C runtime lives here including primitives and the minor GC.
+
+Code here is often written in a continuation passing style because Cheney on the MTA is used as the minor garbage collecting mechanism.
+
+TODO: for example
+
+## `gc.c`
+
+Module for the major garbage collector.
+
+For comprehensive design documentation on the major collector see the [Garbage Collector](Garbage-Collector-Revised-2022.md) documentation.
+
+## `mstreams.c`
+
+Code for in-memory streams. Some of this is platform-specific.
+
+# Setting up a Development Environment
+
+See the [Development Guide](docs/Development.md).
+
+This includes instructions on building and debugging the compiler.
+
+# Building
+
+
+# Debugging
+
+TBD: compiler flags, compilation settings, what else?
+TODO: just include in dev guide
+

CHANGELOG.md

@@ -1,5 +1,197 @@
 # Changelog
 
+## 0.37.0 - TBD
+
+Bug Fixes
+
+- Yorick Hardy fixed the runtime to return the appropriate types of objects to exception handlers.
+- Yorick Hardy modified the runtime to allow `thread-terminate!` to take a thread object as an argument, per SRFI 18.
+- @nmeum fixed `open_memstream`/`fmemopen` feature detection with GCC >= 14.
+- Fixed a bug in `apply` where an error may be raised when processing quoted sub-expressions. For example the following would throw an error: `(apply cons '(5 (1 2)))`. Thanks to @srgx for the bug report!
+- Fixed a beta expansion optimization bug where code such as the following would cause the compiler to hang. Thanks to Yorick Hardy for the bug report:
+
+      (define (compile-forever x) x (compile-forever x))
+
+- Added a fix from Yorick Hardy to define `*ai-v4mapped*` to zero on platforms where `AI_V4MAPPED` is undefined.
+- Updated `sqrt` to properly handle complex results given non-complex input. EG: `(sqrt -1) ==> 1i`. And updated the parser to properly handle `+i` and `-i`. Thanks to Christopher Hebert for the bug reports!
+- Updated `cond-expand` to raise an error if no clauses match, instead of returning `#t`.
+
+## 0.36.0 - February 14, 2024
+
+Features
+
+- Enhanced the reader to parse rationals and store them as inexact numbers.
+- Add a stub for `(rationalize x y)` to `(scheme base)`.
+
+Bug Fixes
+
+- Yorick Hardy provided a fix to `round` so that Cyclone will round to even when x is halfway between two integers, as required by R7RS.
+- Updated various numeric functions to properly handle numeric type conversions, including `quotient`, `remainder`, `numerator`, `denominator`, `truncate`, `truncate-quotient`, and `/`.
+- Fix `exact` to properly handle complex numbers, including raising an error when passed `nan` or `inf` double values.
+- Ensure the runtime properly differentiates between `+inf.0` and `-inf.0`. Thanks to jpellegrini for the bug report.
+- jpellegrini reported that Cyclone returns `#f` when comparing complex numbers using operators other than `=`. Instead it is better to raise an error in these situations.
+- lassik and jpellegrini reported that `abs` was incorrectly returning the real part of a complex number argument. Modified `abs` to properly handle complex numbers.
+- jpellegrini fixed `(srfi 143)` so that the following are constants instead of procedures: `fx-width`, `fx-greatest`, and `fx-least`.
+- Raise an error if `odd?` or `even?` is passed a decimal number. Thanks to jpellegrini for the bug report.
+- Fix `read-line` to read entire lines that consist of more than 1022 bytes. Previously the function would only return partial data up to this limit. Thanks to Robby Zambito for the bug report.
+- `(include "body.scm")` inside a file `path/to/lib.sld` will look for `path/to/body.scm`, then fallback to the legacy behavior, and look for `$(pwd)/body.scm`.
+- Pass append and prepend directories when compiling dependent libraries of a program. This prevents issues where the directories are not made available to any `include` directives within such libraries.
+- Updated the reader to throw an error if a number cannot be parsed, rather than returning `#f`.
+
+## 0.35.0 - August 25, 2022
+
+Features
+
+- Arthur Maciel added `make-opaque` to `(cyclone foreign)`.
+- Add `memory-streams` to the list of symbols that `(features)` can return, indicating that the current installation supports in-memory streams.
+
+Bug Fixes
+
+- Prevent an error when evaluating a `begin` expression that contains both a macro definition and an application of that macro. For example:
+
+      begin (define-syntax foo (syntax-rules () ((foo) 123))) (foo))
+
+- Fix a regression where `c-compiler-options` was not recognized as a top level form by programs.
+- Enforce a maximum recursion depth when printing an object via `display` or `write`, and when comparing objects via `equal?`. This prevents segmentation faults when working with circular data structures.
+- Added proper implementations of `assv` and `memv`. Both were previously implemented in terms of `assq` and `memq`, respectively.
+
+## 0.34.0 - January 2, 2022
+
+Features
+
+- Separate include/library search directory options from "normal" compiler/linker options and place options passed via the `-COPT`/`-CLNK` command-line flags in-between. This allows overwriting the default search paths, since contrary to all other options, the search paths must be prepend for an `-I`/`-L` option to take precedence over an existing one.
+
+Bug Fixes
+
+- Prevent segmentation faults in the runtime when setting a global variable to itself.
+- Do not throw an error when exporting a primitive that is not defined in the current module, as built-ins are always available in any context.
+
+## 0.33.0 - September 24, 2021
+
+Features
+
+- Allow easier macro debugging from the REPL by using `expand`. Passing a single expression as an argument will return the expanded expression:
+
+      cyclone> (expand '(when #t (+ 1 2 3)))
+      (if #t ((lambda () (+ 1 2 3))) )
+
+- During compilation the compiler will now call itself as a subprocess to perform Scheme-to-C compilation. This allows Cyclone to free all of those resources before calling the C compiler to generate a binary, resulting in more efficient compilation.
+
+Bug Fixes
+
+- Do not inline calls to `system` as it could result in multiple calls of the same command.
+
+## 0.32.0 - August 16, 2021
+
+Features
+
+- Initiate major garbage collections faster after allocating a huge object (larger than 500K). This allows the system to reclaim the memory faster and keep overall memory usage low for certain workloads.
+- Cyclone will no longer memoize pure functions by default.
+- Added build option `CYC_PTHREAD_SET_STACK_SIZE` to allow Cyclone to specify a thread stack size rather than using the OS default. EG:
+
+      make CYC_PTHREAD_SET_STACK_SIZE=1 libcyclone.a
+
+Bug Fixes
+
+- @nmeum fixed `(scheme repl)` to flush the output port prior to writing the prompt, guaranteeing the prompt is written at the correct time. 
+- Fixed `fxbit-set?` to properly handle negative values of `i`.
+- Avoid unnecessary renaming of identifiers when the interpreter performs macro expansion.
+- When allocating a large vector we now guarantee all vector elements are initialized before the major collector can trace those elements. This avoids the potential for a race condition which could lead to a segmentation fault.
+- Ensure atomic objects are properly traced by the major garbage collector.
+
+## 0.31.0 - July 27, 2021
+
+### Bug Fixes
+
+#### Compiler
+
+- Properly handle vectors literals at the top level of compiled code. Previously this could lead to segmentation faults (!!) at runtime.
+- Fixed an off-by-one error unpacking arguments when calling a primitive as the continuation after a garbage collection.
+
+#### Base Library
+
+- Fixed `read-line` to prevent data loss when used in conjunction with other I/O functions (such as `read-char`) to read data from the same port. This was because the previous version of `read-line` used a different internal buffer than our other I/O functions.
+- Fixed a bug in `make-list` that consumed all available memory when passing a negative list length.
+- Allow a record type to contain fields that are not initialized by the constructor.
+- Built out `numerator` and `denominator` with code conforming to R7RS.
+
+#### SRFI 18 - Multithreading Library
+
+- Updated `thread-start!` to return the given thread object, per SRFI 18.
+- `thread-join!` now returns the result of the thread it was waiting on, per SRFI 18.
+
+#### C Compiler Warnings
+
+- Eliminate clang compiler warnings referencing `EOF` when building the runtime.
+- Updated runtime so the C compiler will no longer generate warnings regarding the string comparisons in `Cyc_st_add`. Previously this could result in these warnings being spammed to the console when compiling code using Cyclone.
+- Properly escape question marks within strings in generated C code to avoid trigraphs.
+- Avoid an "unused variable" warning from the C compiler when compiling certain recursive functions.
+
+## 0.30.0 - July 2, 2021
+
+Features
+
+- Support semantic versioning of winds packages.
+
+## 0.29.0 - June 15, 2021
+
+Features
+
+- Improve performance of runtime by more efficiently unboxing known fixnums. 
+- Improve performance of compiled code slightly by using more efficient closure calls when possible.
+- Add support for R7RS `#d` decimal specifier for numbers.
+- Added `char-ready?` to `(scheme base)`
+
+Bug Fixes
+
+- Avoid generating C code containing unused variables. In addition to generating better code this also prevents the C compiler from raising associated warnings.
+
+## 0.28.0 - April 8, 2021
+
+Features
+
+- Updated the compiler and runtime to allow a (practically) unlimited number of function arguments. 
+
+  Although the calling conventions of our generated C code and runtime functions were changed, there is no impact to application developers. Existing code will continue to work without requiring modifications. This includes code using our FFI, though it may be necessary to update `define-c` definitions if there are unused parameters in order to prevent warnings from the C compiler. For example by refactoring to use the new calling conventions: 
+      
+      (define-c read-error
+        "(void *data, object _, int argc, object *args)"
+        " object port = args[1];
+          object filename = args[2];
+          object msg = args[3];
+          ...
+
+  No changes are a required if `(cyclone foreign)` is used to integrate with C.
+
+- Provided alternative library names for each of the SRFI libraries. Generally these names follow the recommendations from R7RS Large - for example `(scheme list)` as a friendlier alternative to `(srfi 1)`. Where such a name does not exist we provide a name with the `(cyclone)` prefix:
+
+  Library Name                            | SRFI Number | Description | External Documentation
+  --------------------------------------- | ----------- | ----------- | ----------------------
+  [`scheme list`](api/srfi/1.md)          | [`srfi 1`](api/srfi/1.md)     | List library | [Link](http://srfi.schemers.org/srfi-1/srfi-1.html)
+  [`cyclone and-let*`](api/srfi/2.md)     | [`srfi 2`](api/srfi/2.md)     | `AND-LET*`: an `AND` with local bindings, a guarded `LET*` special form | [Link](http://srfi.schemers.org/srfi-2/srfi-2.html)
+   N/A                                    | [`srfi 8`](api/srfi/8.md)     | Binding to multiple values - Included as part of `scheme base`. | [Link](http://srfi.schemers.org/srfi-8/srfi-8.html)
+  [`cyclone threads`](api/srfi/18.md)     | [`srfi 18`](api/srfi/18.md)   | Multithreading support | [Link](http://srfi.schemers.org/srfi-18/srfi-18.html)
+  [`cyclone random`](api/srfi/27.md)      | [`srfi 27`](api/srfi/27.md)   | Sources of random bits | [Link](http://srfi.schemers.org/srfi-27/srfi-27.html)
+  [`cyclone format`](api/srfi/28.md)      | [`srfi 28`](api/srfi/28.md)   | Basic format strings | [Link](http://srfi.schemers.org/srfi-28/srfi-28.html)
+  [`cyclone integer-bits`](api/srfi/60.md)| [`srfi 60`](api/srfi/60.md)   | Integers as bits | [Link](http://srfi.schemers.org/srfi-60/srfi-60.html)
+  [`scheme hash-table`](api/srfi/69.md)   | [`srfi 69`](api/srfi/69.md)   | Basic hash tables | [Link](http://srfi.schemers.org/srfi-69/srfi-69.html)
+  [`cyclone socket`](api/srfi/106.md)     | [`srfi 106`](api/srfi/106.md) | Basic socket interface | [Link](http://srfi.schemers.org/srfi-106/srfi-106.html)
+  [`scheme box`](api/srfi/111.md)         | [`srfi 111`](api/srfi/111.md) | Boxes | [Link](http://srfi.schemers.org/srfi-111/srfi-111.html)
+  [`scheme set`](api/srfi/113.md)         | [`srfi 113`](api/srfi/113.md) | Sets and bags | [Link](http://srfi.schemers.org/srfi-113/srfi-113.html)
+  [`scheme list-queue`](api/srfi/117.md)  | [`srfi 117`](api/srfi/117.md) | Mutable queues | [Link](http://srfi.schemers.org/srfi-117/srfi-117.html)
+  [`scheme generator`](api/srfi/121.md)   | [`srfi 121`](api/srfi/121.md) | Generators | [Link](http://srfi.schemers.org/srfi-121/srfi-121.html)
+  [`scheme comparator`](api/srfi/128.md)  | [`srfi 128`](api/srfi/128.md) | Comparators | [Link](http://srfi.schemers.org/srfi-128/srfi-128.html)
+  [`scheme sort`](api/srfi/132.md)        | [`srfi 132`](api/srfi/132.md) | Sort libraries | [Link](http://srfi.schemers.org/srfi-132/srfi-132.html)
+  [`scheme vector`](api/srfi/133.md)      | [`srfi 133`](api/srfi/133.md) | Vector library (R7RS-compatible) | [Link](http://srfi.schemers.org/srfi-133/srfi-133.html)
+  [`cyclone fixnum`](api/srfi/143.md)     | [`srfi 143`](api/srfi/143.md) | Fixnums | [Link](http://srfi.schemers.org/srfi-143/srfi-143.html)
+
+- We are modifying version numbers going forward to use explicit three digit semantic versioning `major.minor.bugfix`.
+
+Bug Fixes
+
+- Arthur Maciel replaced high resolution code in the runtime to use `clock_gettime` instead of `gettimeofday`.
+- Fixed the REPL to no longer automatically exit if an expression evaluates to EOF. However, the REPL will exit as a special case if the EOF character is entered directly, for example via CTRL-D on Linux. 
+
 ## 0.27 - March 5, 2021
 
 Features

Dockerfile

@@ -4,7 +4,7 @@ MAINTAINER justin.ethier@gmail.com
 
 ARG DEBIAN_FRONTEND=noninteractive
 
-ENV CYCLONE_VERSION v0.27
+ENV CYCLONE_VERSION v0.36.0
 RUN apt update -y
 RUN apt install -y build-essential git rsync texinfo libtommath-dev libck-dev make gcc
 

Doxyfile

@@ -38,7 +38,7 @@ PROJECT_NAME           = "Cyclone Scheme"
 # could be handy for archiving the generated documentation or if some version
 # control system is used.
 
-PROJECT_NUMBER         = 0.20
+PROJECT_NUMBER         = 0.28.0
 
 # Using the PROJECT_BRIEF tag one can provide an optional one line description
 # for a project that appears at the top of each page and should give viewer a

Makefile

@@ -5,9 +5,14 @@
 include Makefile.config
 
 # Commands
-CYCLONE = cyclone -A .
+#
+# Set up Cyclone here to build the compiler itself using a system-installed
+# compiler (EG: from bootstrap or an earlier cyclone version). Everything
+# else can then be built using our local binary.
+CYCLONE_SYSTEM = cyclone -I . -CLNK '-L.'
+CYCLONE_LOCAL = ./cyclone -I . -I libs -COPT '-Iinclude' -CLNK '-L.'
 CCOMP = $(CC) $(CFLAGS)
-INDENT_CMD = indent -linux -l80 -i2 -nut
+FORMAT_CMD = indent -linux -l80 -i2 -nut
 
 # Libraries
 CYC_RT_LIB = libcyclone.a
@@ -30,6 +35,10 @@ SLDFILES = $(wildcard $(SCHEME_DIR)/*.sld) \
 COBJECTS = $(SLDFILES:.sld=.o)
 HEADERS = $(HEADER_DIR)/runtime.h $(HEADER_DIR)/types.h
 TEST_SRC = $(TEST_DIR)/unit-tests.scm \
+					 $(TEST_DIR)/base.scm \
+					 $(TEST_DIR)/test.scm \
+					 $(TEST_DIR)/threading.scm \
+					 $(TEST_DIR)/c-compiler-options.scm \
 					 $(TEST_DIR)/test-shared-queue.scm \
 					 $(TEST_DIR)/macro-hygiene.scm \
 					 $(TEST_DIR)/match-tests.scm \
@@ -45,6 +54,7 @@ TESTS = $(basename $(TEST_SRC))
 all : cyclone icyc libs
 
 test : libs $(TESTS)
+	icyc -p "(cond-expand (linux (begin (define-syntax foo (syntax-rules () ((foo) 123))) (foo))))"
 
 example :
 	cd $(EXAMPLE_DIR) ; $(MAKE)
@@ -120,12 +130,31 @@ uninstall :
 tags :
 	ctags -R *
 
-indent : gc.c runtime.c ffi.c mstreams.c $(HEADER_DIR)/*.h
+format : gc.c runtime.c ffi.c hashset.c mstreams.c ck-polyfill.c ck-polyfill.h $(HEADER_DIR)/*.h
-	$(INDENT_CMD) gc.c
+	$(FORMAT_CMD) $(HEADER_DIR)/hashset.h
-	$(INDENT_CMD) runtime.c
+	$(FORMAT_CMD) $(HEADER_DIR)/runtime.h
-	$(INDENT_CMD) ffi.c
+	$(FORMAT_CMD) $(HEADER_DIR)/runtime-main.h
-	$(INDENT_CMD) mstreams.c
+	$(FORMAT_CMD) $(HEADER_DIR)/types.h
-	$(INDENT_CMD) $(HEADER_DIR)/*.h
+	$(FORMAT_CMD) ck-polyfill.c
+	$(FORMAT_CMD) ck-polyfill.h
+	$(FORMAT_CMD) ffi.c
+	$(FORMAT_CMD) gc.c
+	$(FORMAT_CMD) hashset.c
+	$(FORMAT_CMD) mstreams.c
+	$(FORMAT_CMD) runtime.c
+
+test-format :
+	./scripts/check-c-formatting.sh $(HEADER_DIR)/hashset.h
+	./scripts/check-c-formatting.sh $(HEADER_DIR)/runtime.h
+	./scripts/check-c-formatting.sh $(HEADER_DIR)/runtime-main.h
+	./scripts/check-c-formatting.sh $(HEADER_DIR)/types.h
+#	./scripts/check-c-formatting.sh ffi.c
+#	./scripts/check-c-formatting.sh gc.c
+	./scripts/check-c-formatting.sh hashset.c
+#	./scripts/check-c-formatting.sh mstreams.c
+#	./scripts/check-c-formatting.sh runtime.c
+#	./scripts/check-c-formatting.sh ck-polyfill.c
+#	./scripts/check-c-formatting.sh ck-polyfill.h
 
 # This is a test directive used to test changes to a SLD file
 # EG: make sld SLDPATH=scheme/cyclone SLD=macros
@@ -138,17 +167,20 @@ debug :
 doc :
 	doxygen Doxyfile
 
+api-doc :
+	./scripts/generate-doc-index.sh && mv api-index.scm docs/api/
+
 # Helper rules (of interest to people hacking on this makefile)
 
-.PHONY: clean full bench bootstrap tags indent debug test doc
+.PHONY: clean full bench bootstrap tags format test-format debug test doc api-doc
 
-$(TESTS) : %: %.scm
+$(TESTS) : %: %.scm cyclone libs
-	$(CYCLONE) -I . $<
+	$(CYCLONE_LOCAL) -I . $<
 	./$@
 	rm -rf $@
 
-$(EXAMPLES) : %: %.scm
+$(EXAMPLES) : %: %.scm cyclone libs
-	$(CYCLONE) $<
+	$(CYCLONE_LOCAL) $<
 
 game-of-life :
 	cd $(EXAMPLE_DIR)/game-of-life ; $(MAKE)
@@ -158,18 +190,14 @@ hello-library/hello :
 
 libs : $(COBJECTS)
 
-$(COBJECTS) : %.o: %.sld
+$(COBJECTS) : %.o: %.sld cyclone
-	$(CYCLONE) $<
+	$(CYCLONE_LOCAL) $<
 
 cyclone : cyclone.scm $(CYC_RT_LIB) $(CYC_BN_LIB)
-	$(CYCLONE) cyclone.scm
+	$(CYCLONE_SYSTEM) cyclone.scm
 
-icyc : icyc.scm $(CYC_RT_LIB) $(CYC_BN_LIB)
+icyc : icyc.scm $(CYC_RT_LIB) $(CYC_BN_LIB) cyclone libs
-	$(CYCLONE) $<
+	$(CYCLONE_LOCAL) $<
-
-dispatch.c : generate-c.scm
-	$(CYCLONE) $<
-	./generate-c
 
 $(CYC_RT_LIB) : $(CFILES) $(HEADERS) $(CYC_BN_LIB)
 
@@ -179,9 +207,6 @@ $(CYC_BN_LIB) : $(CYC_BN_LIB_SUBDIR)/*.c
 hashset.o : hashset.c $(HEADERS)
 	$(CCOMP) -c $< -o $@
 
-dispatch.o : dispatch.c $(HEADERS)
-	$(CCOMP) -c $< -o $@
-
 gc.o : gc.c $(HEADERS)
 	$(CCOMP) -std=gnu99 -c $< -o $@
 
@@ -194,8 +219,15 @@ mstreams.o : mstreams.c $(HEADERS)
 					-DCYC_HAVE_FMEMOPEN=$(CYC_PLATFORM_HAS_FMEMOPEN) \
 					$< -o $@
 
+ifdef CYC_PTHREAD_SET_STACK_SIZE
+  DEF_PTHREAD_SET_STACK_SIZE=-DCYC_PTHREAD_SET_STACK_SIZE=$(CYC_PTHREAD_SET_STACK_SIZE)
+else
+  DEF_PTHREAD_SET_STACK_SIZE=
+endif
+
 runtime.o : runtime.c $(HEADERS)
 	$(CCOMP) -c \
+					$(DEF_PTHREAD_SET_STACK_SIZE) \
 					-DCYC_INSTALL_DIR=\"$(PREFIX)\" \
 					-DCYC_INSTALL_LIB=\"$(LIBDIR)\" \
 					-DCYC_INSTALL_BIN=\"$(BINDIR)\" \
@@ -208,7 +240,7 @@ runtime.o : runtime.c $(HEADERS)
 					-DCYC_PLATFORM=\"$(PLATFORM)\" \
 					$< -o $@
 
-libcyclone.a : runtime.o gc.o dispatch.o ffi.o mstreams.o hashset.o
+libcyclone.a : runtime.o gc.o ffi.o mstreams.o hashset.o
 	$(CREATE_LIBRARY_COMMAND) $(CREATE_LIBRARY_FLAGS) $@ $&
 	$(RANLIB_COMMAND)
 # Instructions from: http://www.adp-gmbh.ch/cpp/gcc/create_lib.html
@@ -245,7 +277,6 @@ bootstrap : icyc libs
 	cp mstreams.c $(BOOTSTRAP_DIR)
 	cp hashset.c $(BOOTSTRAP_DIR)
 	cp gc.c $(BOOTSTRAP_DIR)
-	cp dispatch.c $(BOOTSTRAP_DIR)
 	cp scheme/base.c $(BOOTSTRAP_DIR)/scheme
 	cp scheme/case-lambda.c $(BOOTSTRAP_DIR)/scheme
 	cp scheme/cxr.c $(BOOTSTRAP_DIR)/scheme
@@ -264,7 +295,9 @@ bootstrap : icyc libs
 	cp scheme/cyclone/common.c $(BOOTSTRAP_DIR)/scheme/cyclone
 	cp icyc.scm $(BOOTSTRAP_DIR)
 	cp icyc.c $(BOOTSTRAP_DIR)
-	cp tests/unit-tests.scm $(BOOTSTRAP_DIR)
+	cp tests/unit-tests.scm $(BOOTSTRAP_DIR)/tests
+	cp tests/base.scm $(BOOTSTRAP_DIR)/tests
+	cp tests/threading.scm $(BOOTSTRAP_DIR)/tests
 	cp scheme/cyclone/ast.c $(BOOTSTRAP_DIR)/scheme/cyclone
 	cp scheme/cyclone/cps-optimizations.c $(BOOTSTRAP_DIR)/scheme/cyclone
 	cp scheme/cyclone/cps-opt-local-var-redux.scm $(BOOTSTRAP_DIR)/scheme/cyclone
@@ -322,3 +355,7 @@ install-bin : cyclone icyc
 	$(MKDIR) $(DESTDIR)$(BINDIR)
 	$(INSTALL) -m0755 cyclone $(DESTDIR)$(BINDIR)/
 	$(INSTALL) -m0755 icyc $(DESTDIR)$(BINDIR)/
+
+# TODO: is this linking in local lcyclone or the system one????
+test-lib: test-lib.c
+	$(CCOMP) -g test-lib.c -o test-lib -L . $(LIBS)

Makefile.config

@@ -13,6 +13,11 @@ CYC_PROFILING ?=
 CYC_GCC_OPT_FLAGS ?= -O2
 #CYC_GCC_OPT_FLAGS ?= -g
 
+# Change this to 1 to use a custom stack size for threads.
+# Required on platforms such as Alpine Linux that use a 
+# very small stack by default.
+CYC_PTHREAD_SET_STACK_SIZE ?=
+
 OS = $(shell uname)
 CC ?= cc
 
@@ -23,24 +28,21 @@ LIBS += -ldl
 endif
 
 # Compiler options
-CFLAGS       ?= $(CYC_PROFILING) $(CYC_GCC_OPT_FLAGS) -fPIC -Wall -Wno-shift-negative-value -Wno-unused-command-line-argument -Iinclude
+CFLAGS       += $(CYC_PROFILING) $(CYC_GCC_OPT_FLAGS) -fPIC -Wall -Wno-shift-negative-value -Wno-unused-command-line-argument -Iinclude
-BASE_CFLAGS  ?= $(CYC_PROFILING) $(CYC_GCC_OPT_FLAGS) -fPIC -Wall -Wno-shift-negative-value -Wno-unused-command-line-argument -I$(PREFIX)/include
+BASE_CFLAGS  ?= $(CYC_PROFILING) $(CYC_GCC_OPT_FLAGS) -fPIC -Wall -Wno-shift-negative-value -Wno-unused-command-line-argument
 # Used by Cyclone to compile programs, no need for PIC there
-BASE_PROG_CFLAGS  ?= $(CYC_PROFILING) $(CYC_GCC_OPT_FLAGS) -Wall -I$(PREFIX)/include
+BASE_PROG_CFLAGS   ?= $(CYC_PROFILING) $(CYC_GCC_OPT_FLAGS) -Wall
-ifeq ($(OS),Darwin)
+COMP_CFLAGS        ?= $(BASE_CFLAGS)
-COMP_CFLAGS  ?= $(BASE_CFLAGS) -L$(PREFIX)/lib
+COMP_LIBDIRS       ?= -L$(PREFIX)/lib
+COMP_INCDIRS       ?= -I$(PREFIX)/include
 COMP_PROG_CFLAGS   ?= $(BASE_PROG_CFLAGS)
-else
-COMP_CFLAGS  ?= $(BASE_CFLAGS) -L$(PREFIX)/lib
-COMP_PROG_CFLAGS  ?= $(BASE_PROG_CFLAGS)
-endif
 
 # Use these lines instead for debugging or profiling
 #CFLAGS = -g -Wall
 #CFLAGS = -g -pg -Wall
 
 # Linker options
-LDFLAGS ?= -L. $(CYC_PROFILING)
+LDFLAGS += -L. $(CYC_PROFILING)
 LIBRARY_OUTPUT_FILE = libcyclone.a
 ifeq ($(OS),Darwin)
 LDFLAGS     += -Wl,-undefined -Wl,dynamic_lookup
@@ -57,15 +59,15 @@ endif
 # concurrencykit was installed via Ports, it won't be picked up without explicitly looking
 # for it here
 ifeq ($(OS),FreeBSD)
-LDFLAGS += -L/usr/local/lib
+COMP_LIBDIRS += -L/usr/local/lib
-CFLAGS  += -I/usr/local/include
+COMP_INCDIRS += -I/usr/local/include
 endif
 
 
 # Commands "baked into" cyclone for invoking the C compiler
-CC_PROG ?= "$(CC) ~src-file~ $(COMP_PROG_CFLAGS) -c -o ~exec-file~.o"
+CC_PROG ?= "$(CC) ~src-file~ $(COMP_PROG_CFLAGS) ~cc-extra~ $(COMP_INCDIRS) -c -o ~exec-file~.o"
-CC_EXEC ?= "$(CC) ~exec-file~.o ~obj-files~ $(LIBS) $(COMP_CFLAGS) -o ~exec-file~"
+CC_EXEC ?= "$(CC) ~exec-file~.o ~obj-files~ $(LIBS) $(COMP_CFLAGS) ~ld-extra~ $(COMP_LIBDIRS) -o ~exec-file~"
-CC_LIB  ?= "$(CC) ~src-file~ $(COMP_CFLAGS) -c -o ~exec-file~.o"
+CC_LIB  ?= "$(CC) ~src-file~ $(COMP_CFLAGS) ~cc-extra~ $(COMP_INCDIRS) -c -o ~exec-file~.o"
 CC_SO   ?= "$(CC) -shared $(LDFLAGS) -o ~exec-file~.so ~exec-file~.o"
 
 AR        ?= ar
@@ -89,8 +91,9 @@ DESTDIR   ?=
 
 # Automatically detect platform-specific flags, instead of using autoconf
 #CYC_PLATFORM_HAS_MEMSTREAM ?= 1
-CYC_PLATFORM_HAS_MEMSTREAM := $(shell echo "main(){char *buf; int len; open_memstream(&buf, &len);}" | $(CC) -xc - >/dev/null 2>/dev/null && echo 1 || echo 0)
+HASH := \# # Needed for compatibility with GNU Make < 4.3 <https://lists.gnu.org/archive/html/info-gnu/2020-01/msg00004.html>
-CYC_PLATFORM_HAS_FMEMOPEN := $(shell echo "main(){char *buf; fmemopen(&buf, 0, \"r\");}" | $(CC) -xc - >/dev/null 2>/dev/null && echo 1 || echo 0)
+CYC_PLATFORM_HAS_MEMSTREAM := $(shell printf "$(HASH)include <stdio.h>\n%s\n" "int main(void){char *buf; size_t len; open_memstream(&buf, &len); return 0;}" | $(CC) -xc - >/dev/null 2>/dev/null && echo 1 || echo 0)
+CYC_PLATFORM_HAS_FMEMOPEN := $(shell printf "$(HASH)include <stdio.h>\n%s\n" "int main(void){char *buf; fmemopen(&buf, 0, \"r\"); return 0;}" | $(CC) -xc - >/dev/null 2>/dev/null && echo 1 || echo 0)
 
 # code from chibi's makefile to detect platform
 ifndef PLATFORM

Makefile.config.raspberry-pi-2

@@ -20,14 +20,14 @@ CREATE_LIBRARY_COMMAND = $(AR)
 CREATE_LIBRARY_FLAGS = rcs
 
 # Compiler options
-CFLAGS       ?= -O2 -fPIC -Wall -march=armv6k -Iinclude
+CFLAGS       += -O2 -fPIC -Wall -march=armv6k -Iinclude
 COMP_CFLAGS  ?= -O2 -fPIC -Wall -march=armv6k -I$(PREFIX)/include -L$(PREFIX)/lib
 # Use these lines instead for debugging or profiling
 #CFLAGS = -g -Wall
 #CFLAGS = -g -pg -Wall
 
 # Linker options
-LDFLAGS ?= -L.
+LDFLAGS += -L.
 ifeq ($(OS),Darwin)
 LDFLAGS     += -Wl,-export_dynamic -Wl,-undefined -Wl,dynamic_lookup
 COMP_CFLAGS += -Wl,-export_dynamic

README.md

@@ -1,7 +1,5 @@
 ![Cyclone Scheme](docs/images/cyclone-logo-04-header.png "Cyclone Scheme")
 
-[![Travis CI](https://travis-ci.org/justinethier/cyclone.svg?branch=master)](https://travis-ci.org/justinethier/cyclone)
-
 [![Github CI - Linux](https://github.com/justinethier/cyclone-bootstrap/workflows/Ubuntu%20Linux%20Build/badge.svg)](https://github.com/justinethier/cyclone-bootstrap)
 
 [![Github CI - MacOS](https://github.com/justinethier/cyclone-bootstrap/workflows/MacOS%20Build/badge.svg)](https://github.com/justinethier/cyclone-bootstrap)
@@ -33,9 +31,15 @@ Cyclone Scheme is a brand-new compiler that allows real-world application develo
 - Support for Linux, Windows, FreeBSD, and Mac platforms. 
 - Known to run on x86-64, x86, and Arm (Raspberry Pi) architectures.
 
+# Try in your Browser
+
+You can [run the Cyclone interpreter](https://cyclone-scheme.netlify.app/terminal.html) right in your browser. No installation required.
+
 # Installation
 
-There are several options available for installing Cyclone:
+For the full user experience - compiling files, installing packages, running native code, etc - it is necessary to install a copy of Cyclone.
+
+There are several installation options available:
 
 ## Docker 
 ![Docker](docs/images/docker-thumb.png "Docker")
@@ -63,6 +67,11 @@ Arch Linux users can install using the [AUR](https://aur.archlinux.org/packages/
     cd cyclone-scheme
     makepkg -si
 
+## Gentoo Linux
+![Gentoo Linux](docs/images/gentoo-linux-logo.png "Gentoo Linux")
+
+Cyclone is available from the [official Gentoo package repository](https://packages.gentoo.org/packages/dev-scheme/cyclone).
+
 ## Build from Source
 ![Build from Source](docs/images/build-thumb.png "Build from Source")
 
@@ -141,9 +150,7 @@ Cyclone provides several example programs, including:
 
 - There is a [Development Guide](docs/Development.md) with instructions for common tasks when hacking on the compiler itself.
 
-- Cyclone's [Garbage Collector](docs/Garbage-Collector.md) is documented at a high-level. This document includes details on extending Cheney on the MTA to support multiple stacks and fusing that approach with a tri-color marking collector.
+- Cyclone's [Garbage Collector](docs/Garbage-Collector-Revised-2022.md) is documented at a high-level. This document includes details on extending Cheney on the MTA to support multiple stacks and fusing that approach with a tri-color marking collector.
-
-- The garbage collector was subsequently enhanced to support [Lazy Sweeping](https://github.com/justinethier/cyclone/blob/master/docs/Garbage-Collection-Using-Lazy-Sweeping.md) which improves performance for a wide range of applications.
 
 # License
 

ck-polyfill.c

@@ -28,7 +28,8 @@ void ck_polyfill_init()
 
 // CK Hashset section
 bool ck_hs_init(ck_hs_t * hs, unsigned int mode, ck_hs_hash_cb_t * hash_func,
-    ck_hs_compare_cb_t *cmp, struct ck_malloc *alloc, unsigned long capacity, unsigned long seed)
+                ck_hs_compare_cb_t * cmp, struct ck_malloc *alloc,
+                unsigned long capacity, unsigned long seed)
 {
   (*hs).hs = simple_hashset_create();
   if (pthread_mutex_init(&((*hs).lock), NULL) != 0) {
@@ -58,15 +59,18 @@ void *ck_hs_get(ck_hs_t *_hs, unsigned long hash, const void *key)
 bool ck_hs_put(ck_hs_t * _hs, unsigned long hash, const void *key)
 {
   bool result = false;
-  int rv;
+  int rv, index;
   simple_hashset_t hs = (*_hs).hs;
 
   pthread_mutex_lock(&((*_hs).lock));
 
+  //index = simple_hashset_is_member(hs, (symbol_type *)key);
+  //if (index == 0) {
   rv = simple_hashset_add(hs, (symbol_type *) key);
   if (rv >= 0) {
     result = true;
   }
+  //}
 
   pthread_mutex_unlock(&((*_hs).lock));
   return result;
@@ -98,8 +102,7 @@ ck_array_init(ck_array_t *array, unsigned int mode,
 //      This function returns 1 if the pointer already exists in the array.  It
 //      returns 0 if the put operation succeeded. It returns -1 on error due to
 //      internal memory allocation failures.
-int
+int ck_array_put_unique(ck_array_t * array, void *pointer)
-ck_array_put_unique(ck_array_t *array, void *pointer)
 {
   pthread_mutex_lock(&(array->lock));
   hashset_add(array->hs, pointer);
@@ -118,8 +121,8 @@ ck_array_put_unique(ck_array_t *array, void *pointer)
 //      This function returns true if the remove operation succeeded. It will
 //      return false otherwise due to internal allocation failures or because the
 //      value did not exist.
-bool
+bool ck_array_remove(ck_array_t * array, void *pointer)
-ck_array_remove(ck_array_t *array, void *pointer){
+{
   pthread_mutex_lock(&(array->lock));
   hashset_remove(array->hs, pointer);
   pthread_mutex_unlock(&(array->lock));
@@ -135,12 +138,12 @@ ck_array_remove(ck_array_t *array, void *pointer){
 // RETURN VALUES
 //      This function returns true if the commit operation succeeded. It will
 //      return false otherwise, and pending operations will not be applied.
-bool ck_array_commit(ck_array_t *array) {
+bool ck_array_commit(ck_array_t * array)
+{
   // Nothing to do in this polyfill
   return true;
 }
 
-
 // TODO: global pthread mutex lock for this? obviously not ideal but the
 // whole purpose of this module is a minimal interface for compatibility
 // not speed
@@ -182,8 +185,7 @@ bool ck_pr_cas_8(uint8_t *target, uint8_t old_value, uint8_t new_value)
   return result;
 }
 
-void
+void ck_pr_add_ptr(void *target, uintptr_t delta)
-ck_pr_add_ptr(void *target, uintptr_t delta)
 {
   pthread_mutex_lock(&glock);
   size_t value = (size_t)target;
@@ -194,24 +196,21 @@ ck_pr_add_ptr(void *target, uintptr_t delta)
   pthread_mutex_unlock(&glock);
 }
 
-void
+void ck_pr_add_int(int *target, int delta)
-ck_pr_add_int(int *target, int delta)
 {
   pthread_mutex_lock(&glock);
   (*target) += delta;
   pthread_mutex_unlock(&glock);
 }
 
-void
+void ck_pr_add_8(uint8_t * target, uint8_t delta)
-ck_pr_add_8(uint8_t *target, uint8_t delta)
 {
   pthread_mutex_lock(&glock);
   (*target) += delta;
   pthread_mutex_unlock(&glock);
 }
 
-void *
+void *ck_pr_load_ptr(const void *target)
-ck_pr_load_ptr(const void *target)
 {
   void *result;
   pthread_mutex_lock(&glock);
@@ -220,8 +219,7 @@ ck_pr_load_ptr(const void *target)
   return result;
 }
 
-int
+int ck_pr_load_int(const int *target)
-ck_pr_load_int(const int *target)
 {
   int result;
   pthread_mutex_lock(&glock);
@@ -230,8 +228,7 @@ ck_pr_load_int(const int *target)
   return result;
 }
 
-uint8_t
+uint8_t ck_pr_load_8(const uint8_t * target)
-ck_pr_load_8(const uint8_t *target)
 {
   uint8_t result;
   pthread_mutex_lock(&glock);
@@ -247,23 +244,27 @@ void ck_pr_store_ptr(void *target, void *value)
   pthread_mutex_unlock(&glock);
 }
 
-
 // Simple hashset
 
 static const size_t prime_1 = 73;
 static const size_t prime_2 = 5009;
 
-size_t hash_function(const char* p, size_t len)
+size_t hash_function(const char *str, size_t len)
 {
-    size_t hash = 0;
+  unsigned long hash = 5381;
-    for (; *p; ++p)
+  int c;
-        hash ^= *p + 0x9e3779b9 + (hash << 6) + (hash >> 2);
+
+  while (c = *str++) {
+    hash = ((hash << 5) + hash) + c;    /* hash * 33 + c */
+  }
+
   return hash;
 }
 
 simple_hashset_t simple_hashset_create()
 {
-    simple_hashset_t set = (simple_hashset_t)calloc(1, sizeof(struct simple_hashset_st));
+  simple_hashset_t set =
+      (simple_hashset_t) calloc(1, sizeof(struct simple_hashset_st));
 
   if (set == NULL) {
     return NULL;
@@ -273,7 +274,10 @@ simple_hashset_t simple_hashset_create()
   set->nbits = 3;
   set->capacity = (size_t)(1 << set->nbits);
   set->mask = set->capacity - 1;
-    set->items = (struct simple_hashset_item_st*)calloc(set->capacity, sizeof(struct simple_hashset_item_st));
+  set->items =
+      (struct simple_hashset_item_st *)calloc(set->capacity,
+                                              sizeof(struct
+                                                     simple_hashset_item_st));
   if (set->items == NULL) {
     simple_hashset_destroy(set);
     return NULL;
@@ -296,7 +300,8 @@ void simple_hashset_set_hash_function(simple_hashset_t set, hash_func_t func)
   set->hash_func = func;
 }
 
-static int simple_hashset_add_member(simple_hashset_t set, symbol_type* key, size_t hash)
+static int simple_hashset_add_member(simple_hashset_t set, symbol_type * key,
+                                     size_t hash)
 {
   size_t index;
 
@@ -309,8 +314,7 @@ static int simple_hashset_add_member(simple_hashset_t set, symbol_type* key, siz
   while (set->items[index].hash != 0 && set->items[index].hash != 1) {
     if (set->items[index].hash == hash) {
       return 0;
-        }
+    } else {
-        else {
       /* search free slot */
       index = set->mask & (index + prime_2);
     }
@@ -331,19 +335,22 @@ static void set_maybe_rehash(simple_hashset_t set)
   struct simple_hashset_item_st *old_items;
   size_t old_capacity, index;
 
-
   if (set->nitems + set->n_deleted_items >= (double)set->capacity * 0.85) {
     old_items = set->items;
     old_capacity = set->capacity;
     ++set->nbits;
     set->capacity = (size_t)(1 << set->nbits);
     set->mask = set->capacity - 1;
-        set->items = (struct simple_hashset_item_st*)calloc(set->capacity, sizeof(struct simple_hashset_item_st));
+    set->items =
+        (struct simple_hashset_item_st *)calloc(set->capacity,
+                                                sizeof(struct
+                                                       simple_hashset_item_st));
     set->nitems = 0;
     set->n_deleted_items = 0;
     //assert(set->items);
     for (index = 0; index < old_capacity; ++index) {
-            simple_hashset_add_member(set, old_items[index].item, old_items[index].hash);
+      simple_hashset_add_member(set, old_items[index].item,
+                                old_items[index].hash);
     }
     free(old_items);
   }
@@ -373,5 +380,3 @@ int simple_hashset_is_member(simple_hashset_t set, symbol_type* key)
   }
   return 0;
 }
-
-

ck-polyfill.h

@@ -38,7 +38,6 @@ struct ck_malloc {
 //    struct simple_hashset_st;
 typedef struct simple_hashset_st *simple_hashset_t;
 
-
 struct hashmap_st;
 typedef struct hashmap_st *hashmap_t;
 
@@ -101,7 +100,8 @@ typedef bool ck_hs_compare_cb_t(const void *, const void *);
 #define CK_HS_HASH(hs, hs_hash, value) 0
 
 bool ck_hs_init(ck_hs_t *, unsigned int, ck_hs_hash_cb_t *,
-    ck_hs_compare_cb_t *, struct ck_malloc *, unsigned long, unsigned long);     
+                ck_hs_compare_cb_t *, struct ck_malloc *, unsigned long,
+                unsigned long);
 
 void *ck_hs_get(ck_hs_t *, unsigned long, const void *);
 bool ck_hs_put(ck_hs_t *, unsigned long, const void *);
@@ -166,8 +166,7 @@ ck_array_init(ck_array_t *array, unsigned int mode,
 //      This function returns 1 if the pointer already exists in the array.  It
 //      returns 0 if the put operation succeeded. It returns -1 on error due to
 //      internal memory allocation failures.
-int
+int ck_array_put_unique(ck_array_t * array, void *pointer);
-ck_array_put_unique(ck_array_t *array, void *pointer);
 
 // DESCRIPTION
 //      The ck_array_remove(3) function will attempt to remove the value of
@@ -180,9 +179,7 @@ ck_array_put_unique(ck_array_t *array, void *pointer);
 //      This function returns true if the remove operation succeeded. It will
 //      return false otherwise due to internal allocation failures or because the
 //      value did not exist.
-bool
+bool ck_array_remove(ck_array_t * array, void *pointer);
-ck_array_remove(ck_array_t *array, void *pointer);
-
 
 // DESCRIPTION
 //      The ck_array_commit(3) function will commit any pending put or remove
@@ -193,9 +190,7 @@ ck_array_remove(ck_array_t *array, void *pointer);
 // RETURN VALUES
 //      This function returns true if the commit operation succeeded. It will
 //      return false otherwise, and pending operations will not be applied.
-bool
+bool ck_array_commit(ck_array_t * array);
-ck_array_commit(ck_array_t *array);
-
 
   // TODO:
 
@@ -213,33 +208,23 @@ ck_array_commit(ck_array_t *array);
 
 ///////////////////////////////////////////////////////////////////////////////
 // CK PR section
-bool
+bool ck_pr_cas_ptr(void *target, void *old_value, void *new_value);
-ck_pr_cas_ptr(void *target, void *old_value, void *new_value);
 
-bool
+bool ck_pr_cas_int(int *target, int old_value, int new_value);
-ck_pr_cas_int(int *target, int old_value, int new_value);
 
-bool
+bool ck_pr_cas_8(uint8_t * target, uint8_t old_value, uint8_t new_value);
-ck_pr_cas_8(uint8_t *target, uint8_t old_value, uint8_t new_value);
 
+void ck_pr_add_ptr(void *target, uintptr_t delta);
 
-void
+void ck_pr_add_int(int *target, int delta);
-ck_pr_add_ptr(void *target, uintptr_t delta);
 
-void
+void ck_pr_add_8(uint8_t * target, uint8_t delta);
-ck_pr_add_int(int *target, int delta);
 
-void
+void *ck_pr_load_ptr(const void *target);
-ck_pr_add_8(uint8_t *target, uint8_t delta);
 
-void *
+int ck_pr_load_int(const int *target);
-ck_pr_load_ptr(const void *target);
 
-int
+uint8_t ck_pr_load_8(const uint8_t * target);
-ck_pr_load_int(const int *target);
-
-uint8_t
-ck_pr_load_8(const uint8_t *target);
 
 void ck_pr_store_ptr(void *target, void *value);
 #endif                          /* CYCLONE_CK_POLYFILL_H */

cyclone.scm

@@ -21,11 +21,12 @@
         (scheme cyclone primitives)
         (scheme cyclone transforms)
         (scheme cyclone cps-optimizations)
-        (scheme cyclone libraries))
+        (scheme cyclone libraries)
+        (srfi 18))
 
 (define *fe:batch-compile* #t) ;; Batch compilation. TODO: default to false or true??
 (define *optimization-level* 2) ;; Default level
-(define *optimize:memoize-pure-functions* #t) ;; Memoize pure funcs by default
+(define *optimize:memoize-pure-functions* #f) ;; Memoize pure function
 (define *optimize:beta-expand-threshold* #f) ;; BE threshold or #f to use default
 (define *optimize:inline-unsafe* #f) ;; Inline primitives even if generated code may be unsafe
 (define *cgen:track-call-history* #t)
@@ -79,6 +80,11 @@
     Cyc_check_str(data, filename);
     double_value(&box) = Cyc_file_last_modified_time(string_str(filename));
     return_closcall1(data, k, &box); ")
+
+(define-c calling-program
+  "(void *data, int argc, closure _, object k)"
+  " make_utf8_string(data, s, _cyc_argv[0]);
+    return_closcall1(data, k, &s); ")
 ;; END batch compilation
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -287,7 +293,10 @@
         (for-each 
           (lambda (lib-dep)
             (when (recompile? lib-dep append-dirs prepend-dirs)
-              (let ((result (system (string-append "cyclone " 
+              (let ((result (system (string-append 
+                                      (calling-program) " " 
+                                      (dirs->args "-A" append-dirs) " "
+                                      (dirs->args "-I" prepend-dirs) " "
                                       (lib:import->filename lib-dep ".sld" append-dirs prepend-dirs)))))
                 (when (> result 0)
                   (error "Unable to compile library" lib-dep)))))
@@ -340,7 +349,8 @@
               (cond
                 ((eq? e 'call/cc) #f) ;; Special case
                 ((and (not module-global?)
-                      (not imported-var?))
+                      (not imported-var?)
+                      (not (prim? e)))
                  (error "Identifier is exported but not defined" e))
                 (else
                   ;; Pass throughs are not defined in this module,
@@ -715,9 +725,7 @@
     in-prog))
 
 ;; Compile and emit:
-(define (run-compiler args cc? cc-prog cc-exec cc-lib cc-so 
+(define (run-compiler args append-dirs prepend-dirs change-cc-opts!)
-                      cc-opts cc-prog-linker-opts cc-prog-linker-objs 
-                      append-dirs prepend-dirs)
   (let* ((in-file (car args))
          (expander (base-expander))
          (in-prog-raw (read-file in-file))
@@ -730,7 +738,7 @@
               in-prog-raw)
             (else
               ;; Account for any cond-expand declarations in the library
-              (list (lib:cond-expand (car in-prog-raw) expander)))))
+              (list (lib:cond-expand in-file (car in-prog-raw) expander)))))
           ;; expand in-prog, if a library, using lib:cond-expand.
           ;; TODO: will also need to do below in lib:get-all-import-deps, after reading each library
          (program:imports/code (if program? (import-reduction in-prog expander) '()))
@@ -739,6 +747,20 @@
                     (not (null? (car program:imports/code))))
              (lib:get-all-import-deps (car program:imports/code) append-dirs prepend-dirs expander)
             '()))
+        ;; Read C compiler options
+         (cc-opts
+          (cond
+            (program? 
+              (let ((opts (program-c-compiler-opts! in-prog)))
+                (when (not (null? opts))
+                  (change-cc-opts! opts))
+                (string-join ;; Check current program for options
+                  opts
+                  " ")))
+            (else
+              (string-join 
+                (lib:c-compiler-options (car in-prog)) 
+                " "))))
          ;; Read all linker options from dependent libs
          (c-linker-options
            (let ((lib-options (lib:get-all-c-linker-options lib-deps append-dirs prepend-dirs expander)))
@@ -748,17 +770,6 @@
                    " "
                    lib-options)
                  lib-options)))
-         ;; Only read C compiler options from module being compiled
-         (cc-opts*
-          (cond
-            (program? 
-              (string-join ;; Check current program for options
-                (program-c-compiler-opts! in-prog)
-                " "))
-            (else
-              (string-join 
-                (lib:c-compiler-options (car in-prog)) 
-                " "))))
          (exec-file (basename in-file))
          (src-file (string-append exec-file ".c"))
          (meta-file (string-append exec-file ".meta"))
@@ -797,13 +808,85 @@
                      lib-deps)
                    in-file 
                    append-dirs 
-                   prepend-dirs)))))
+                   prepend-dirs))))))
-         (result (create-c-file in-prog)))
+    (create-c-file in-prog)
+    (cond
+     (program?
+      ;; Use .meta file to store information for C compiler phase
+      (save-program-metadata meta-file lib-deps c-linker-options))
+     (else
+      ;; Emit .meta file
+      (with-output-to-file
+        meta-file
+        (lambda ()
+          (display ";; This file was automatically generated by the Cyclone Scheme compiler")
+          (newline)
+          (write (macro:get-defined-macros))))))))
 
+(define (save-program-metadata filename lib-deps c-linker-options)
+  (with-output-to-file
+    filename
+    (lambda ()
+      (display ";; This file was automatically generated by the Cyclone Scheme compiler")
+      (newline)
+      (write `(lib-deps . ,lib-deps))
+      (newline)
+      (write `(c-linker-options . ,c-linker-options)))))
+
+(define (load-program-metadata filename)
+  (let ((data (call-with-input-file filename  read-all)))
+    (delete-file filename)
+    data))
+
+(define (get-meta meta symbol default)
+  (if (assoc symbol meta)
+      (cdr (assoc symbol meta))
+      default))
+
+(define (run-external-compiler 
+           args append-dirs prepend-dirs
+           cc? cc-prog cc-exec cc-lib cc-so 
+           cc-opts cc-prog-linker-opts cc-prog-linker-objs)
+  (let* ((in-file (car args))
+         (expander (base-expander))
+         (in-prog-raw (read-file in-file))
+         (program? (not (library? (car in-prog-raw))))
+         (in-prog
+          (cond
+            (program? 
+              (Cyc-add-feature! 'program) ;; Load special feature
+              ;; TODO: what about top-level cond-expands in the program?
+              in-prog-raw)
+            (else
+              ;; Account for any cond-expand declarations in the library
+              (list (lib:cond-expand in-file (car in-prog-raw) expander)))))
+         ;; Only read C compiler options from module being compiled
+         (cc-opts*
+          (cond
+            (program? 
+              (string-join ;; Check current program for options
+                (program-c-compiler-opts! in-prog)
+                " "))
+            (else
+              (string-join 
+                (lib:c-compiler-options (car in-prog)) 
+                " "))))
+         (exec-file (basename in-file))
+         (src-file (string-append exec-file ".c"))
+         (meta-file (string-append exec-file ".meta"))
+         (get-comp-env 
+           (lambda (sym str)
+             (if (> (string-length str) 0)
+                 str
+                 (Cyc-compilation-environment sym)))) 
+        )
     ;; Compile the generated C file
     (cond
       (program?
-        (letrec ((objs-str 
+        (letrec ((metadata (load-program-metadata meta-file))
+                 (c-linker-options (get-meta metadata 'c-linker-options '()))
+                 (lib-deps (get-meta metadata 'lib-deps '()))
+                 (objs-str 
                   (string-append
                     cc-prog-linker-objs
                     (apply
@@ -814,29 +897,29 @@
                         lib-deps))))
                  (comp-prog-cmd 
                    (string-append
+                     (string-replace-all 
                        (string-replace-all 
                          (string-replace-all 
                            ;(Cyc-compilation-environment 'cc-prog) 
                            (get-comp-env 'cc-prog cc-prog)
                            "~src-file~" src-file)
+                         "~cc-extra~" cc-opts)
                        "~exec-file~" exec-file)
                      " "
-                     cc-opts
-                     " "
                      cc-opts*))
                  (comp-objs-cmd 
                   (string-append
                    (string-replace-all
+                     (string-replace-all
                        (string-replace-all
                          (string-replace-all
                            ;(Cyc-compilation-environment 'cc-exec)
                            (get-comp-env 'cc-exec cc-exec)
                            "~exec-file~" exec-file)
+                         "~ld-extra~" cc-prog-linker-opts)
                        "~obj-files~" objs-str)
                      "~exec-file~" exec-file)
                    " "
-                   cc-prog-linker-opts
-                   " "
                    c-linker-options
                    )))
           ;(write `(DEBUG all imports ,lib-deps objs ,objs-str))
@@ -851,24 +934,17 @@
               (display comp-objs-cmd)
               (newline)))))
       (else
-        ;; Emit .meta file
-        (with-output-to-file
-          meta-file
-          (lambda ()
-            (display ";; This file was automatically generated by the Cyclone Scheme compiler")
-            (newline)
-            (write (macro:get-defined-macros))))
         ;; Compile library
         (let ((comp-lib-cmd
                (string-append
+                (string-replace-all 
                   (string-replace-all 
                     (string-replace-all 
                       (get-comp-env 'cc-lib cc-lib)
                       "~src-file~" src-file)
+                    "~cc-extra~" cc-opts)
                   "~exec-file~" exec-file)
                 " "
-                cc-opts
-                " "
                 cc-opts*))
               (comp-so-cmd
                (string-append
@@ -912,6 +988,17 @@
       (list #f)
       args)))
 
+;; Convert a list of directories to a string of arguments.
+;; EG: (dirs->args "-I" '("dir-1" "dir-2")) =>
+;;     " -I dir-1 -I dir-2 "
+(define (dirs->args prefix dirs)
+  (apply 
+    string-append
+    (map
+      (lambda (dir)
+        (string-append " " prefix " " dir " "))
+      dirs)))
+
 ;; Handle command line arguments
 (let* ((args (command-line-arguments))
        (non-opts 
@@ -924,6 +1011,8 @@
                 ;               (equal? #\- (string-ref arg 0)))))
                 ;   args))
        (compile? #t)
+       (run-scm-compiler? (member "-run-scm-compiler" args))
+       (no-compiler-subprocess (member "-no-compiler-subprocess" args))
        (cc-prog (apply string-append (collect-opt-values args "-CP")))
        (cc-exec (apply string-append (collect-opt-values args "-CE")))
        (cc-lib  (apply string-append (collect-opt-values args "-CL")))
@@ -1067,7 +1156,34 @@ Debug options:
             (cdr err))
           (newline)
           (exit 1)))
-      (run-compiler non-opts compile? cc-prog cc-exec cc-lib cc-so 
+      (cond
-                    cc-opts cc-linker-opts cc-linker-extra-objects 
+        (run-scm-compiler? 
-                    append-dirs prepend-dirs)))))
+          ;; Compile Scheme code into a C file
+          (run-compiler non-opts append-dirs prepend-dirs
+            (lambda (opts) 
+              (set! cc-opts opts))))
+        (else
+          ;; Generate the C file
+          (cond
+           (no-compiler-subprocess
+            ;; Special case, we can generate .C file within this process
+            (run-compiler non-opts append-dirs prepend-dirs
+              (lambda (opts) (set! cc-opts opts)))
+
+            )
+           (else
+            ;; Normal path is to run another instance of cyclone to generate
+            ;; the .C file. This lets us immediately free those resources once
+            ;; the Scheme compilation is done.
+            (when (not (zero? (system
+                                (string-append 
+                                  (calling-program) " -run-scm-compiler "
+                                  (string-join args " ")))))
+              (exit 1))))
+          ;; Call the C compiler
+          (run-external-compiler
+            non-opts append-dirs prepend-dirs
+            compile? cc-prog cc-exec cc-lib cc-so 
+            cc-opts cc-linker-opts cc-linker-extra-objects)))
+      ))))
 

docs/C-Calling-Conventions.md

@@ -58,7 +58,7 @@ Where:
  * `data` is state data for the current thread
  * `argc` indicates how many arguments were sent by the caller. Generally only applicable for variadic functions.
  * `closure` is the caller's closure. Note this is ignored for global functions as closures are never applicable to them.
- * `k` is the continuation to call into next.
+ * `k` is the continuation to call into next. Note this is not necessarily present; it is often placed here as a result of the compiler's CPS conversion phase.
 
 In addition zero or more objects may be listed after that as well as an ellipsis `...` for variadic functions. For example:
 
@@ -79,7 +79,7 @@ Note our `define-c` FFI requires the user to specify the same calling convention
 
 We want a signature similar to this:
 
-    static void __lambda(void *data, object closure, object k, int argc, object *args) ;
+    static void __lambda(void *data, object closure, int argc, object *args) ;
 
 That way we can pack all the extra arguments into `args` and call all functions using a single standard interface. 
 
@@ -151,15 +151,22 @@ TODO: Are there any complications in referencing vars from `args` rather than di
 
 ## Changes to the FFI
 
-`define-c` needs to use the new signature.
+`define-c` needs to use the new signature. **TBD if there is an efficient way to do this without also requiring a migration of existing `define-c` forms. It would be great if existing code would continue to work, thus not making this a breaking change. Perhaps the compiler can detect the old signature and generate scaffolding accordingly.**
 
 `(cyclone foreign)` will need to be modified to generate `define-c` forms that are compatible with the new signatures.
 
 # Development Plan
 
-- Modify compiler to generate code using the new calling conventions
+- Modify compiler (scheme/cyclone/cgen.sld) to generate code using the new calling conventions. Test as best we can that C code is generated properly.
+- Branch off of master at this point?? At some point we will want to do this to prevent a nasty merge of cargs development back into master.
 - Add necessary header definitions
-- Modify runtime / primitives to use calling convention
+- Modify runtime / primitives to use calling convention. Ensure runtime compiles with these changes in place.
-- Modify FFI and define-c definitions
+- Modify FFI and define-c definitions in scheme files
 - Bring up the compiler in stages. Will need to use the current version of Cyclone to generate a version with the new function signatures.
 
+
+## TODO
+
+- ~~ There are 'unused variable' warnings for variables that are in analysis DB but in reality are optimized out in subsequent phases prior to C generation. It may be necessary to add a special pass over the closure code to determine if variables are really used, and store the results in a new hashtable/cache.~~
+- Limits - will need to enforce a limit at some point to prevent segfaults due to actually running out of memory due to passing to many parameters. Will need to figure out what that limit might be and how to enforce that. Perhaps at 15,000 or more args????
+- Need to either remove `inline_function_type` or have a special compilation mode/flag so that we do not use it for compilers that are too strict to use it.

docs/Garbage-Collector-Revised-2022.md

@@ -0,0 +1,639 @@
+[<img src="images/cyclone-logo-04-header.png" alt="cyclone-scheme">](http://github.com/justinethier/cyclone)
+
+# Garbage Collector
+
+- [Introduction](#introduction)
+- [Minor Collection](#minor-collection)
+  - [Cheney on the MTA](#cheney-on-the-mta)
+  - [Our Implementation](#our-implementation)
+  - [Write Barriers](#write-barriers)
+- [Major Collection](#major-collection)
+  - [Lazy Sweeping](#lazy-sweeping)
+  - [Object Marking](#object-marking)
+  - [Handshakes](#handshakes)
+  - [Collection Cycle](#collection-cycle)
+  - [Mutator Functions](#mutator-functions)
+  - [Collector Functions](#collector-functions)
+  - [Cooperation by the Collector](#cooperation-by-the-collector)
+  - [Running the Collector](#running-the-collector)
+  - [Performance Measurements](#performance-measurements)
+- [Conclusion](#conclusion)
+- [Further Reading](#further-reading)
+- [Appendix](#appendix)
+  - [Terms](#terms)
+  - [Code](#code)
+  - [Data Structures](#data-structures)
+    - [Heap](#heap)
+    - [Thread Data](#thread-data)
+    - [Object Header](#object-header)
+    - [Mark Buffers](#mark-buffers)
+
+# Introduction
+
+This article provides a high-level overview of Cyclone's garbage collector, including recent work on lazy sweeping and automatic relocation of shared objects. This overview would be a good starting point for understanding the corresponding code in Cyclone's runtime and may also be of interest to anyone wanting to implement - or just peek under the hood of - a modern, real-world collector.
+
+The collector has the following requirements:
+
+- Efficiently free allocated memory.
+- Allow the language implementation to support tail calls and continuations.
+- Allow the language to support native multithreading.
+
+Cyclone uses generational garbage collection (GC) to automatically free allocated memory using two types of collection. In practice, most allocations consist of short-lived objects such as temporary variables. Minor GC is done frequently to clean up most of these short-lived objects. A major collection runs less often to free longer-lived objects that are no longer being used by the application.
+
+Cheney on the MTA, a technique introduced by Henry Baker, is used to implement the minor collector. Objects are allocated directly on the stack using `alloca` so allocations are very fast, do not cause fragmentation, and do not require a special pass to free unused objects. 
+
+A concurrent mark-sweep collector is used to manage heap memory and perform major collections without [stopping the world](https://en.wikipedia.org/wiki/Tracing_garbage_collection#Stop-the-world_vs._incremental_vs._concurrent).
+
+For more background there are introductory articles on garbage collection in the [further reading](#further-reading) section that discuss underlying concepts.
+
+# Minor Collection
+
+## Cheney on the MTA
+
+A runtime based on Henry Baker's paper [CONS Should Not CONS Its Arguments, Part II: Cheney on the M.T.A.](research-papers/CheneyMTA.pdf) was used as it allows for fast code that meets all of the fundamental requirements for a Scheme runtime: tail calls, garbage collection, and continuations.
+
+Baker explains how it works:
+
+> We propose to compile Scheme by converting it into continuation-passing style (CPS), and then compile the resulting lambda expressions into individual C functions. Arguments are passed as normal C arguments, and function calls are normal C calls. Continuation closures and closure environments are passed as extra C arguments. Such a Scheme never executes a C return, so the stack will grow and grow ... eventually, the C "stack" will overflow the space assigned to it, and we must perform garbage collection. 
+
+Cheney on the M.T.A. uses a copying garbage collector. By using static roots and the current continuation closure, the GC is able to copy objects from the stack to a pre-allocated heap without having to know the format of C stack frames. To quote Baker:
+
+> the entire C "stack" is effectively the youngest generation in a generational garbage collector!
+
+After GC is finished, the C stack pointer is reset using [`longjmp`](http://man7.org/linux/man-pages/man3/longjmp.3.html) and the GC calls its continuation. 
+
+Here is a snippet demonstrating how C functions may be written using Baker's approach:
+
+    object Cyc_make_vector(object cont, object len, object fill) {
+      object v = NULL;
+      int i;
+      Cyc_check_int(len);
+
+      // Memory for vector can be allocated directly on the stack
+      v = alloca(sizeof(vector_type));
+
+      // Populate vector object
+      ((vector)v)->tag = vector_tag;
+      ... 
+
+      // Check if GC is needed, then call into continuation with the new vector
+      return_closcall1(cont, v);
+    }
+
+[CHICKEN](http://www.call-cc.org/) was the first Scheme compiler to use Baker's approach.
+
+## Our Implementation
+
+Minor GC is always performed for a single mutator thread. Each thread uses local stack storage for its own objects so there is no need for minor GC to synchronize with other mutator threads.
+
+As described in Baker's paper, Cyclone converts the original program to continuation passing style (CPS) and compiles it as a series of C functions that never return. At runtime each mutator periodically checks to see if its stack has exceeded a certain size. When this happens a minor GC is started and all live stack objects are copied to the heap.
+
+The following root objects are used as a starting point to find all live objects:
+
+- The current continuation
+- Arguments to the current continuation
+- Mutations contained in the write barrier
+- Closures from the exception stack
+- Global variables
+
+The collection algorithm itself operates as follows:
+
+- Move any root objects on the stack to the heap. 
+- For each object moved: 
+  - Replace the stack object with a forwarding pointer. The forwarding pointer ensures all references to a stack object refer to the same heap object, and allows minor GC to handle cycles.
+  - Record each moved object in a buffer to serve as the Cheney to-space.
+- Loop over the to-space buffer and check each object moved to the heap. Move any child objects that are still on the stack. This loop continues until all live objects are moved.
+- [Cooperate](#cooperate) with the major GC's collection thread.
+- Perform a `longjmp` to reset the stack and call into the current continuation.
+
+Any objects left on the stack after `longjmp` are considered garbage. There is no need to clean them up because the stack will just re-use the memory as it grows.
+
+## Write Barriers
+
+### Heap Object References
+
+Baker's paper does not mention one important detail. A heap object can be modified to contain a reference to a stack object. For example, by using a `set-car!` to change the head of a list.
+
+This is problematic since stack references are no longer valid after a minor GC and the GC does not check heap objects. We account for these mutations by using a write barrier to maintain a list of each modified object. During GC these modified objects are treated as roots to avoid dangling references.
+
+The write barrier must be called by each primitive in the runtime that modifies object pointers - `set-car!`, `set-cdr!`, `vector-set!`, etc. Fortunately there are only a handful of these functions.
+
+### Relocating Shared Objects
+
+Cyclone must guarantee the objects located on each mutator thread's stack are only used by that thread. 
+
+This requirement is critical as any existing references to a stack object will become invalid when that object is moved to the heap by minor GC. Without the proper safety measures in place this would lead to the potential for memory safety issues - segmentation faults, undefined behavior, etc.
+
+Thus Cyclone ensures memory safety by automatically relocating objects to the heap before they can be accessed by more than one thread. Each write barrier checks to see if a heap variable is being changed to point to a variable on the stack. When such a change is detected Cyclone will move only that object to the heap if possible. However for objects with many children - such as a list or vector - it may be necessary for Cyclone to trigger a minor collection in order to ensure all objects are relocated to the heap before they can be accessed by multiple threads. 
+
+The following function does the heavy lifting:
+
+    object transport_stack_value(gc_thread_data *data, object var, object value, int *run_gc) 
+    {
+      char tmp;
+      int inttmp, *heap_grown = &inttmp;
+      gc_heap_root *heap = data->heap;
+    
+      // Nothing needs to be done unless we are mutating
+      // a heap variable to point to a stack var.
+      if (!gc_is_stack_obj(&tmp, data, var) && gc_is_stack_obj(&tmp, data, value)) {
+        // Must move `value` to the heap to allow use by other threads
+        switch(type_of(value)) {
+          case string_tag:
+          case bytevector_tag:
+            if (immutable(value)) {
+              // Safe to transport now
+              object hp = gc_alloc(heap, gc_allocated_bytes(value, NULL, NULL), value, data, heap_grown);
+              return hp;
+            }
+            // Need to GC if obj is mutable, EG: a string could be mutated so we can't
+            // have multiple copies of the object running around
+            *run_gc = 1;
+            return value;
+          case double_tag:
+          case port_tag:
+          case c_opaque_tag:
+          case complex_num_tag: {
+            // These objects are immutable, transport now
+            object hp = gc_alloc(heap, gc_allocated_bytes(value, NULL, NULL), value, data, heap_grown);
+            return hp;
+          }
+          // Objs w/children force minor GC to guarantee everything is relocated:
+          case cvar_tag:
+          case closure0_tag:
+          case closure1_tag:
+          case closureN_tag:
+          case pair_tag:
+          case vector_tag:
+            *run_gc = 1;
+            return value;
+          default:
+            // Other object types are not stack-allocated so should never get here
+            printf("Invalid shared object type %d\n", type_of(value));
+            exit(1);
+        }
+      }
+    
+      return value;
+    }
+
+Then, `transport_stack_value` is called from each write barrier in a manner similar to the below for `set-car!`:
+
+    int do_gc = 0;
+    val = transport_stack_value(data, l, val, &do_gc);
+    ...
+    if (do_gc) { // GC and then do assignment
+      mclosure0(clo, (function_type)Cyc_set_car_cps_gc_return);
+      object buf[3]; buf[0] = l; buf[1] = val; buf[2] = cont;
+      GC(data, &clo, buf, 3);
+      return NULL;
+    }
+
+It is still necessary for application code to use the appropriate concurrency constructs - such as locks, atomics, etc - to ensure that a shared object is safely accessed by only one thread at a time.
+
+# Major Collection
+
+Baker's technique uses a copying collector for both the minor and major generations of collection. One of the drawbacks of using a copying collector for major GC is that it relocates all the live objects during collection. This is problematic for supporting native threads because an object can be relocated at any time, invalidating any references to the object. To prevent this either all threads must be stopped while major GC is running or a read barrier must be used each time an object is accessed. Both options add a potentially significant overhead so instead Cyclone uses a tracing collector based on the Doligez-Leroy-Gonthier (DLG) algorithm for major collections. 
+
+An advantage of this approach is that major GC executes asynchronously so threads can continue to run concurrently even during collections. A collector thread is used to perform a major GC with cooperation from the mutator threads.
+
+## Lazy Sweeping
+
+A fundamental mark-sweep optimization suggested by the [Garbage Collection Handbook](#further-reading) is lazy sweeping.
+
+In a simple mark-sweep collector the entire heap is swept at once when tracing is finished. Instead with lazy sweeping each mutator thread will sweep its own heap incrementally as part of allocation. When no more free space is available to meet a request the allocator will check to see if there are unswept heap pages, and if so, the mutator will pick a page and sweep it to free up space. This amortizes the cost of sweeping.
+
+Performance is improved in several ways:
+
+- Better Locality - Heap slots tend to be used soon after they are swept and sweep only needs to visit a small part of the heap. This allows programs to make better use of the processor cache.
+- Thread-Local Data - There is no need to lock the heap for allocation or sweeping since both operations are performed by the same thread.
+- Reduced Complexity - The algorithmic complexity of mark-sweep is reduced to be proportional to the size of the live data in the heap instead of the whole heap, similar to a copying collector. Lazy sweeping will perform best when most of the heap is empty.
+
+Lazy sweeping is discussed here in the first major GC section as it impacts most of the other components of the collector.
+
+## Object Marking
+
+An object can be marked using any of the following colors to indicate the status of its memory:
+
+  - :large_blue_circle: - Blue - Unallocated memory.
+  - :red_circle: - Red - An object on the stack.
+  - :white_circle: - White - Heap memory that has not been scanned by the collector. 
+  - :radio_button: - Gray - Objects marked by the collector that may still have child objects that must be marked.
+  - :black_circle: - Black - Objects marked by the collector whose immediate child objects have also been marked.
+  - :purple_circle: - Purple - Garbage objects on the heap that have not yet been reclaimed due to lazy sweeping.
+
+### Tri-Color Invariant
+
+Only objects marked as white, gray, or black participate in major collections. 
+
+White objects are freed during the sweep state. White is sometimes also referred to as the clear color.
+
+Black objects survive the collection cycle. Black is sometimes referred to as the mark color as live objects are ultimately marked black.
+
+Our collector must guarantee that a black object never has any children that are white objects. This satisfies the so-called tri-color invariant and guarantees that all white objects can be collected once the gray objects are marked. This is the reason our collector must use a gray color instead of transitioning white objects directly to black.
+
+Finally, a [mark buffer](#mark-buffers) is used to store the list of gray objects. This improves performance by avoiding repeated passes over the heap to search for gray objects.
+
+## Deferred Collection
+
+A set of three heap colors is insufficient for lazy sweeping because parts of the heap may not be swept during a collection cycle. Thus an object that is really garbage could accidentally be assigned the black color.
+
+For example, suppose a heap page consists entirely of white objects after a GC is finished. All of the objects are garbage and would be freed if the page is swept. However if this page is not swept before the next collection starts, the collector will [swap the values of white/black](#clear) and during the subsequent cycle all of the objects will appear as if they have the black color. Thus a sweep during this most recent GC cycle would not be able to free any of the objects!
+
+The solution is to add a new color (purple) to indicate garbage objects on the heap. Garbage can then be swept while the collector is busy doing other work such as mark/trace. In order to account for multiple generations of objects the object colors are incremented each cycle instead of being swapped. For example, the collector starts in the following state:
+
+    static unsigned char gc_color_mark = 5;   // Black, is swapped during GC
+    static unsigned char gc_color_clear = 3;  // White, is swapped during GC
+    static unsigned char gc_color_purple = 1;  // There are many "shades" of purple, this is the most recent one
+
+We can assign a new purple color after tracing is finished. At this point the clear color and the purple color are (essentially) the same, and any new objects are allocated using the mark color. When GC starts back up, the clear and mark colors are each incremented by 2:
+
+    // We now increment both so that clear becomes the old mark color and a
+    // new value is used for the mark color. The old clear color becomes
+    // purple, indicating any of these objects are garbage
+    ck_pr_add_8(&gc_color_purple, 2);
+    ck_pr_add_8(&gc_color_clear, 2);
+    ck_pr_add_8(&gc_color_mark, 2);
+
+So we now have purple (assigned the previous clear color), clear (assigned the previous mark color), and mark (assigned a new number). All of these numbers must be odd so they will never conflict with the red or blue colors. Effectively any odd numbered colors not part of this set represent other "shades" of purple.
+
+## Handshakes
+
+Instead of stopping the world and pausing all threads, when the collector needs to coordinate with the mutators it performs a handshake.
+
+Each of the mutator threads, and the collector itself, has a status variable:
+
+     typedef enum { STATUS_ASYNC 
+                  , STATUS_SYNC1 
+                  , STATUS_SYNC2 
+                  } gc_status_type;
+
+The collector will update its status variable and then wait for all of the collectors to change their status before continuing. The mutators periodically call a cooperate function to check in and update their status to match the collectors. A handshake is complete once all mutators have updated their status.
+
+## Collection Cycle
+
+During a GC cycle the collector thread transitions through the following states.
+
+### Clear
+The collector swaps the values of the clear color (white) and the mark color (black). This is more efficient than modifying the color on each object in the heap. The collector then transitions to sync 1. At this point no heap objects are marked, as demonstrated below:
+
+<img src="images/gc-graph-clear.png" alt="Initial object graph">
+
+### Mark
+The collector transitions to sync 2 and then async. At this point it marks the global variables and waits for the mutators to also transition to async. When a mutator transitions it will mark its roots and use black as the allocation color to prevent any new objects from being collected during this cycle:
+
+<img src="images/gc-graph-mark.png" alt="Initial object graph">
+
+### Trace
+The collector finds all live objects using a breadth-first search and marks them black:
+
+<img src="images/gc-graph-trace.png" alt="Initial object graph">
+
+The collector thread performs the bulk of its work during this phase. For more details see the [Collector Trace](#collector-trace) section.
+
+### Sweep
+This function is included here for completeness but is actually performed much later due to [lazy sweeping](#lazy-sweeping).
+
+When the time comes to reclaim memory a mutator scans a heap page and frees memory used by any of the white objects:
+
+<img src="images/gc-graph-sweep.png" alt="Initial object graph">
+
+### Resting
+The collector cycle is complete and it rests until it is triggered again.
+
+## Mutator Functions
+
+Each mutator calls the following functions to coordinate with the collector.
+
+### Allocate
+
+This function is called by a mutator to allocate memory on the heap for an object. This is generally only done during a minor GC when each object is relocated to the heap.
+
+There is no need for the mutator to directly coordinate with the collector during allocation as each thread uses its own set of heap pages.
+
+The main allocation function takes a fast or slow path depending upon whether a free slot is found on the current heap page. 
+
+The logic in simplified form is:
+
+    result = try_alloc();
+    if (result)
+      return result;
+
+    result = try_alloc_slow();
+    if (result) 
+      return result;
+
+    grow_heap(); // malloc more heap space
+    result = try_alloc_slow();
+    if (result) 
+      return result;
+
+    out_of_memory_error();
+  
+A heap page uses a "free list" of available slots to quickly find the next available slot. The `try_alloc` function simply finds the first slot on the free list and returns it, or `NULL` if there is no free slot.
+
+On the other hand, `try_alloc_slow` has to do more work to find the next available heap page, sweep it, and then call `try_alloc` to perform an allocation.
+
+If there is not enough free memory to fulfill a `try_alloc_slow` request a new page is allocated and added to the heap. This is the only choice, unfortunately. The collection process is asynchronous so memory cannot be freed immediately to make room.
+
+### Sweep
+
+Sweep walks an entire heap page, freeing all unused slots along the way. 
+
+To identify an unused object the algorithm must check for two colors:
+
+- Objects that are either newly-allocated or recently traced are given the allocation color; we need to keep them.
+- If the collector is currently tracing, objects not traced yet will have the trace/clear color. We need to keep any of those to make sure the collector has a chance to trace the entire heap.
+
+The code is as follows:
+
+      if (mark(p) != thd->gc_alloc_color && 
+          mark(p) != thd->gc_trace_color) {
+        ... // Free slot p
+      }
+
+### Update
+
+A write barrier is used to ensure any modified objects are properly marked for the current collection cycle. There are two cases:
+
+- Gray the object's new and old values if the mutator is in a synchronous status. 
+- Gray the object's old value if the collector is in the tracing stage.
+
+Because updates can occur at any time a modified object may still live on the stack. In this case the object is tagged to be grayed when it is relocated to the heap.
+
+### Cooperate
+
+Each mutator is required to periodically call this function to cooperate with the collector. During cooperation a mutator will update its status to match the collector's status, to handshake with the collector. 
+
+In addition when a mutator transitions to async it will:
+
+- Mark all of its roots gray
+- Use black as the allocation color for any new objects to prevent them from being collected during this cycle.
+
+Cyclone's mutators cooperate after each minor GC, for two reasons. Minor GC's are frequent and immediately afterwards all of the mutator's live objects can be marked because they are on the heap.
+
+Finally, at the end of a collection cycle the main thread must clean up heap data for any terminated threads.
+
+### Mark Gray
+
+Mutators call this function to add an object to their mark buffer.
+
+    mark_gray(m, obj):
+      if obj != clear_color:
+        m->mark_buffer[m->last_write] = obj
+        m->last_write++
+
+## Collector Functions
+
+### Collector Mark Gray
+
+The collector calls this function to add an object to the mark stack.
+
+    collector_mark_gray(obj):
+      if obj != clear_color:
+        mark_stack->push(obj)
+
+### Mark Black
+
+The collector calls this function to mark an object black and mark all of the object's children gray using Collector Mark Gray.
+
+    mark_black(obj):
+      if mark(obj) != mark_color:
+        for each child(c):
+          collector_mark_gray(c)
+        mark(obj) = mark_color
+
+
+### Empty Collector Mark Stack
+
+This function removes and marks each object on the collector's mark stack.
+
+    empty_collector_mark_stack():
+      while not mark_stack->empty():
+        mark_black(mark_stack->pop())
+
+### Collector Trace
+
+This function performs tracing for the collector by looping over all of the mutator mark buffers. All of the remaining objects in each buffer are marked black, as well as all the remaining objects on the collector's mark stack. This function continues looping until there are no more objects to mark:
+
+    collector_trace():
+      clean = 0
+      while not clean:
+        clean = 1
+        for each mutator(m):
+          while m->last_read < m->last_write:
+            clean = 0
+            mark_black(m->mark_buffer[m->last_read])
+            empty_collector_mark_stack()
+            m->last_read++
+
+The primary job of the collector thread is tracing. 
+
+While tracing the collector visits all live objects and marks them as being in use. Since these objects are stored all across the heap the tracing algorithm cannot take advantage of object locality and tends to demonstrate unusual memory access patterns, leading to inefficient use of the processor cache and poor performance. This makes tracing an excellent task to be done in parallel with the mutator threads so it does not slow down application code.
+
+Note that during tracing some synchronization is required between the collector and the mutator threads. When an object is changed (EG via: `set!`, `vector-set!`, etc) the mutator needs to add this object to the mark stack, which requires a mutex lock to safely update shared resources.
+
+## Cooperation by the Collector
+
+In practice a mutator will not always be able to cooperate in a timely manner. For example, a thread can block indefinitely waiting for user input or reading from a network port. In the meantime the collector will never be able to complete a handshake with this mutator and major GC will never be performed.
+
+Cyclone solves this problem by requiring that a mutator keep track of its thread state. With this information the collector can cooperate on behalf of a blocked mutator and do the work itself instead of waiting for the mutator. 
+
+The possible thread states are:
+
+- `CYC_THREAD_STATE_NEW` - A new thread not yet running.
+- `CYC_THREAD_STATE_RUNNABLE` - A thread that can be scheduled to run by the OS.
+- `CYC_THREAD_STATE_BLOCKED` - A thread that could be blocked.
+- `CYC_THREAD_STATE_BLOCKED_COOPERATING` - A blocked thread that the collector is cooperating with on behalf of the mutator.
+- `CYC_THREAD_STATE_TERMINATED` - A thread that has been terminated by the application but its resources have not been freed up yet.
+
+Before entering a C function that could block the mutator must call a function to update its thread state to `CYC_THREAD_STATE_BLOCKED`. This indicates to the collector that the thread may be blocked.
+
+When the collector handshakes it will check each mutator to see if it is blocked. Normally in this case the collector can just update the blocked mutator's status and move on to the next one. But if the mutator is transitioning to async all of its objects need to be relocated from the stack so they can be marked. In this case the collector changes the thread's state to `CYC_THREAD_STATE_BLOCKED_COOPERATING`, locks the mutator's mutex, and performs a minor collection for the thread. The mutator's objects can then be marked gray and its allocation color can be flipped. When it is finished cooperating for the mutator the collector releases its mutex.
+
+When a mutator exits a (potentially) blocking section of code, it must call another function to update its thread state to `CYC_THREAD_STATE_RUNNABLE`. In addition, the function will detect if the collector cooperated for this mutator by checking if its status is `CYC_THREAD_STATE_BLOCKED_COOPERATING`. If so, the mutator waits for its mutex to be released to ensure the collector has finished cooperating. The mutator then performs a minor GC again to ensure any additional objects - such as results from the blocking code - are moved to the heap before calling `longjmp` to jump back to the beginning of its stack. Either way, the mutator now calls into its continuation and resumes normal operations.
+
+## Running the Collector
+
+Cyclone checks the amount of free memory as part of its cooperation code. A major GC cycle is started if the amount of free memory dips below a threshold. Additionally, during a slow allocation the mutator checks how many heap pages are still free. If that number is too low we trigger a new GC cycle.
+
+The goal is to run major collections infrequently while at the same time minimizing the allocation of new heap pages.
+
+# Performance Measurements
+
+A [benchmark suite](#further-reading) was used to compare performance between the previous version of Cyclone (0.8.1) and the new version with lazy sweeping.
+
+The following table lists the differences in elapsed time (seconds) between versions:
+
+Benchmark | Baseline | Lazy Sweeping | Improvement
+--------- | -------- | ------------- | ------------
+browse | 25.34 | 22.21 | 12.35%
+deriv | 17.17 | 10.83 | 36.90%
+destruc | 38.00 | 30.94 | 18.59%
+diviter | 8.57 | 6.05 | 29.35%
+divrec | 17.98 | 14.49 | 19.46%
+puzzle | 46.97 | 44.97 | 4.25%
+triangl | 26.20 | 25.35 | 3.23%
+tak | 18.73 | 18.36 | 1.99%
+takl | 14.42 | 11.30 | 21.64%
+ntakl | 15.32 | 11.22 | 26.74%
+cpstak | 21.09 | 20.92 | 0.80%
+ctak | 2.78 | 2.77 | 0.28%
+fib | 41.26 | 41.05 | 0.51%
+fibc | 3.52 | 3.47 | 1.37%
+fibfp | 9.56 | 9.57 | -0.12%
+sum | 30.28 | 30.29 | -0.02%
+sumfp | 11.55 | 11.53 | 0.23%
+fft | 21.19 | 17.25 | 18.57%
+mbrot | 16.84 | 15.27 | 9.34%
+mbrotZ | 23.35 | 22.88 | 2.01%
+nucleic | 8.29 | 7.91 | 4.56%
+pi | 0.13 | 0.13 | 1.90%
+pnpoly | 43.64 | 41.80 | 4.22%
+ray | 9.13 | 9.12 | 0.05%
+simplex | 53.26 | 42.60 | 20.02%
+ack | 75.78 | 50.64 | 33.18%
+array1 | 30.84 | 30.65 | 0.60%
+string | 0.28 | 0.26 | 6.91%
+sum1 | 1.01 | 1.00 | 1.23%
+cat | 22.05 | 22.42 | -1.69%
+tail | 1.04 | 0.99 | 4.56%
+wc | 14.46 | 14.75 | -2.07%
+read1 | 3.61 | 3.20 | 11.31%
+conform | 40.67 | 34.00 | 16.40%
+dynamic | 33.84 | 27.61 | 18.41%
+earley | 31.49 | 26.84 | 14.78%
+graphs | 64.84 | 55.22 | 14.84%
+lattice | 84.57 | 68.93 | 18.50%
+matrix | 61.07 | 48.46 | 20.64%
+maze | 23.02 | 18.46 | 19.79%
+mazefun | 23.73 | 20.74 | 12.61%
+nqueens | 47.92 | 45.18 | 5.71%
+paraffins | 15.21 | 10.76 | 29.28%
+parsing | 39.50 | 38.55 | 2.41%
+peval | 32.11 | 27.72 | 13.67%
+primes | 18.79 | 12.83 | 31.74%
+quicksort | 56.64 | 48.13 | 15.03%
+scheme | 23.32 | 21.39 | 8.30%
+slatex | 9.74 | 8.14 | 16.37%
+chudnovsky | 0.09 | 0.09 | 1.79%
+nboyer | 13.80 | 11.84 | 14.24%
+sboyer | 11.90 | 12.09 | -1.60%
+gcbench | 37.12 | 32.37 | 12.79%
+mperm | 49.94 | 39.97 | 19.95%
+equal | 0.74 | 0.70 | 4.43%
+bv2string | 7.54 | 7.62 | -1.00%
+
+This data is illustrated in the following chart:
+
+<img src="images/benchmarks/lazy-sweep-benchmark-times.png" alt="Chart of Results">
+
+Here is an overall summary:
+
+Statistic | Benchmark | Result
+--------- | --------- | ------
+Overall Improvement | N/A |  13.36%
+Average Speedup     | N/A |  10.74%
+Maximum Speedup     | deriv |  36.90%
+Minimum Speedup     | wc |  -2.07%
+
+Overall we achieve an average speedup of 10.74% with lazy sweeping. That said there are a wide range of performance impacts across the whole benchmark suite. 
+
+Those benchmarks with the biggest speedups are likely those that are generating the most garbage. For example `ack` frequently invokes GC and most of the heap is freed during each GC cycle - this benchmark benefits greatly from lazy sweeping. Alternatively `wc` - which did not realize a speedup - spends most of its time running in a tight loop, invokes GC infrequently, and after a GC cycle there are many live objects left on the heap. 
+
+By all accounts lazy sweeping is a great win for Cyclone and has exceeded performance expectations. Though there is a slight performance overhead that affects some programs the overall performance improvement across a wide range of programs more than compensates. 
+
+# Conclusion
+
+[<img src="images/campfire.jpg" alt="Campfire">](#conclusion)
+
+The garbage collector is by far the most complex component of Cyclone. The primary motivation in developing it was to extend Baker's approach to support multiple native threads, which had never been done before prior to this project. Cyclone demonstrates the viability of this approach.
+
+Our GC is also positioned to potentially support state of the art GC's built on top of DLG such as Stopless, Chicken, and Clover.
+
+That said, heap memory fragmentation has not been addressed and could be an issue for long-running programs. Traditionally a compaction process is used to defragment a heap. An alternative strategy has also been suggested by Pizlo:
+
+> instead of copying objects to evacuate fragmented regions of the heap, fragmentation is instead embraced. A fragmented heap is allowed to stay fragmented, but the collector ensures that it can still satisfy allocation requests even if no large enough contiguous free region of space exists.
+
+Ultimately, a garbage collector is tricky to implement and the focus must primarily be on correctness first, with an eye towards performance.
+
+# Further Reading
+
+- [Baby's First Garbage Collector](http://journal.stuffwithstuff.com/2013/12/08/babys-first-garbage-collector/), by Bob Nystrom
+- [Chibi-Scheme](https://github.com/ashinn/chibi-scheme)
+- [CHICKEN internals: the garbage collector](http://www.more-magic.net/posts/internals-gc.html), by Peter Bex
+- [CONS Should Not CONS Its Arguments, Part II: Cheney on the M.T.A.](https://github.com/justinethier/cyclone/raw/master/docs/research-papers/CheneyMTA.pdf), by Henry Baker
+- Fragmentation Tolerant Real Time Garbage Collection (PhD Dissertation), by Filip Pizlo
+- [The Garbage Collection Handbook: The Art of Automatic Memory Management](http://gchandbook.org/), by Antony Hosking, Eliot Moss, and Richard Jones
+- Implementing an on-the-fly garbage collector for Java, by Domani et al
+- Incremental Parallel Garbage Collection, by Paul Thomas
+- Portable, Unobtrusive Garbage Collection for Multiprocessor Systems, by Damien Doligez and Georges Gonthier
+- [Introducing Riptide: WebKit's Retreating Wavefront Concurrent Garbage Collector](https://webkit.org/blog/7122/introducing-riptide-webkits-retreating-wavefront-concurrent-garbage-collector/), by Filip Pizlo
+- [Scheme Benchmarks](https://ecraven.github.io/r7rs-benchmarks/), by [ecraven](https://github.com/ecraven)
+- [The Ramsey sweep](http://people.csail.mit.edu/gregs/ll1-discuss-archive-html/msg00761.html), by Olin Shivers
+
+
+# Appendix
+
+## Terms
+- Collector - A thread running the garbage collection code. The collector is responsible for coordinating and performing most of the work for major garbage collections.
+- Continuation - With respect to the collectors, this is a function that is called to resume execution of application code. For more information see [this article on continuation passing style](https://en.wikipedia.org/wiki/Continuation-passing_style).
+- Forwarding Pointer - When a copying collector relocates an object it leaves one of these pointers behind with the object's new address.
+- Garbage Collector (GC) - A form of automatic memory management that frees memory allocated by objects that are no longer used by the program.
+- Heap - A section of memory used to store longer-lived variables. In C, heap memory is allocated using built-in functions such as `malloc`, and memory must be explicitly deallocated using `free`.
+- Mutation - A modification to an object. For example, changing a vector (array) entry.
+- Mutator - A thread running user (or "application") code; there may be more than one mutator running concurrently.
+- Read Barrier - Code that is executed before reading an object. Read barriers have a larger overhead than write barriers because object reads are much more common.
+- Root - During tracing the collector uses these objects as the starting point to find all reachable data.
+- Stack - The C call stack, where local variables are allocated and freed automatically when a function returns. Stack variables only exist until the function that created them returns, at which point the memory may be overwritten. The stack has a very limited size and undefined behavior (usually a crash) will result if that size is exceeded.
+- Sweep - A phase of garbage collection where the heap - either the whole heap or a subset - is scanned and any unused slots are made available for new allocations.
+- Tracing - A phase of garbage collection that visits and marks all live objects on the heap. This is done by starting from a set of "root" objects and iteratively following references to child objects.
+- Write Barrier - Code that is executed before writing to an object.
+
+## Code
+
+The implementation code is available here:
+
+- [`runtime.c`](../runtime.c) contains most of the runtime system, including code to perform minor GC. A good place to start would be the `GC` and `gc_minor` functions.
+- [`gc.c`](../gc.c) contains the major GC code.
+
+## Data Structures
+
+### Heap
+
+The heap is used to store all objects that survive minor GC, and consists of a linked list of pages. Each page contains a contiguous block of memory and a linked list of free chunks. When a new chunk is requested the first free chunk large enough to meet the request is found and either returned directly or carved up into a smaller chunk to return to the caller.
+
+Memory is always allocated in multiples of 32 bytes. On the one hand this helps prevent external fragmentation by allocating many objects of the same size. But on the other it incurs internal fragmentation because an object will not always fill all of its allocated memory.
+
+A separate set of heap pages is maintained by each mutator thread. Thus there is no need to lock during allocation or sweep operations.
+
+### Thread Data
+
+At runtime Cyclone passes the current continuation, number of arguments, and a thread data parameter to each compiled C function. The continuation and arguments are used by the application code to call into its next function with a result. Thread data is a structure that contains all of the necessary information to perform collections, including:
+
+- Thread state
+- Stack boundaries
+- Jump buffer
+- List of mutated objects detected by the minor GC write barrier
+- Major GC parameters - mark buffer, last read/write, etc (see next sections)
+- Call history buffer
+- Exception handler stack
+
+Each thread has its own instance of the thread data structure and its own stack (assigned by the C runtime/compiler).
+
+### Object Header
+
+Each object contains a header with the following information:
+
+- Tag - A number indicating the object type: cons, vector, string, etc.
+- Mark - The status of the object's memory.
+- Grayed - A field indicating the object has been grayed but has not been added to a mark buffer yet (see major GC sections below). This is only applicable for objects on the stack.
+
+### Mark Buffers
+
+Mark buffers are used to hold gray objects instead of explicitly marking objects gray. These mark buffers consist of fixed-size pointer arrays that are increased in size as necessary using `realloc`.  Each mutator has a reference to a mark buffer holding their gray objects. A last write variable is used to keep track of the buffer size.
+
+The collector updates the mutator's last read variable each time it marks an object from the mark buffer. Marking is finished when last read and last write are equal. The collector also maintains a single mark stack of objects that the collector has marked gray.
+
+An object on the stack cannot be added to a mark buffer because the reference may become invalid before it can be processed by the collector.
+

docs/Release-Checklist.md

@@ -7,6 +7,7 @@ Steps for making a release of Cyclone:
   - `Dockerfile`
   - `DEBIAN/control` in cyclone-bootstrap
   - `.github/workflows/Release.yml` job in cyclone-bootstrap
+  - `libs/common.sld` in cyclone winds repo
 - Update documentation, if applicable
 - Tag releases and push to Github
 - Upload release notes to `gh-pages` branch
@@ -14,3 +15,8 @@ Steps for making a release of Cyclone:
 - Update release on Homebrew (automated)
 - Update release on Dockerhub (push to bitbucket)
 - Upload new binary from cyclone-bootstrap release build to the cyclone-scheme "packages" repo
+- Update WASM hosted Cyclone
+  - Trigger CI action on the WASM repo to recompile the WASM binary: https://github.com/cyclone-scheme/wasm-terminal
+  - Download the generated `.zip` artifact
+  - Extract `terminal.js` and `terminal.wasm` and copy to the `_site` directory in the repo to update the build
+  - Optionally update year in the `terminal.html` file

docs/User-Manual.md

@@ -12,7 +12,12 @@
   - [Generated Files](#generated-files)
   - [Interpreter](#interpreter)
 - [Language Details](#language-details)
+- [Macros](#macros)
+  - [Syntax Rules](#syntax-rules)
+  - [Explicit Renaming](#explicit-renaming)
+  - [Debugging](#debugging)
 - [Multithreaded Programming](#multithreaded-programming)
+  - [Thread Safety](#thread-safety)
 - [Foreign Function Interface](#foreign-function-interface)
   - [Writing a Scheme Function in C](#writing-a-scheme-function-in-c)
   - [Foreign Library](#foreign-library)
@@ -159,6 +164,51 @@ A [R<sup>7</sup>RS Compliance Chart](Scheme-Language-Compliance.md) lists differ
 
 [API Documentation](API.md) is available for the libraries provided by Cyclone.
 
+# Macros
+
+## Syntax Rules
+
+High-level hygienic macros may be created using `syntax-rules`. This system is based on a template language specified by R<sup>7</sup>RS. The specification goes into more detail on how to work with these macros:
+
+    (define-syntax when
+      (syntax-rules  ()
+        ((when test result1 result2 ...)
+         (if test
+             (begin result1 result2 ...)))))
+
+## Explicit Renaming
+
+Alternatively a low-level explicit renaming (ER) system is provided that allows defining macros using Scheme code, in a similar manner as `defmacro`. 
+
+This macro system provides the convenience functions `(rename identifier)` to hygienically rename an identifier and `(compare identifier1 identifier2)` to compare two identifiers:
+
+    (define-syntax when
+      (er-macro-transformer
+        (lambda (exp rename compare)
+          (if (null? (cdr exp)) (error/loc "empty when" exp))
+          (if (null? (cddr exp)) (error/loc "no when body" exp))
+          `(if ,(cadr exp)
+               ((lambda () ,@(cddr exp)))))))
+
+## Debugging
+
+- From the interpreter one can use `expand` to perform macro expansion on the given expression:
+
+      cyclone> (expand '(when #t (+ 1 2 3)))
+      (if #t ((lambda () (+ 1 2 3))) )
+
+- Alternatively when developing an ER macro, since its just a Scheme function, the macro can be defined as a `lambda` and passed a quoted expression to debug:
+
+      (pretty-print
+        ((lambda (exp rename compare)
+           (if (null? (cdr exp)) (error/loc "empty when" exp))
+           (if (null? (cddr exp)) (error/loc "no when body" exp))
+           `(if ,(cadr exp)
+                ((lambda () ,@(cddr exp)))))
+        '(when #t  (write 1) (write 2)) #f #f))
+
+- Finally, a Scheme file may be compiled with the `-t` option to write all of the intermediate transformations - including macro expansions - out to the corresponding `.c` file.
+
 # Multithreaded Programming
 
 ## Overview
@@ -167,17 +217,11 @@ The [`srfi 18`](api/srfi/18.md) library may be imported to provide support for m
 
 Many helper functions are provided by [`(cyclone concurrent)`](api/cyclone/concurrent.md) to make it easier to write multithreaded programs.
 
-## Memory Layout
+## Thread Safety
 
-Cyclone's garbage collector moves objects in memory from the first generation (on the stack) to the second generation (on the heap). This causes problems when an object is used by multiple threads, as the address another thread expects to find an object at may suddenly change. To prevent race conditions an object must be guaranteed to be on the heap prior to being used by another thread. 
+Cyclone uses a generational garbage collector that automatically move objects from the first generation (on the stack) to the second generation (on the heap). This move is performed by the application thread that originally created the object. Without the proper safety measures in place this could cause problems as the address that another thread is using for an object may suddenly change. 
 
-The easiest way to meet this guarantee is to use one of the `make-shared` and `share-all!` functions from `(cyclone concurrent)`. Several of the other constructs from that library (such as futures and shared queues) use these functions internally to guarantee objects are safely shared between threads.
+**To prevent race conditions Cyclone automatically relocates objects to the heap before they can be accessed by more than one thread.** It is still necessary for application code to use the appropriate concurrency constructs - such as locks, atomics, etc - to ensure that an object is safely accessed by only one thread at a time.
-
-Finally, note there are some objects that are not relocated so the above does not apply:
-
-- Characters and integers are stored using value types and do not need to be garbage collected.
-- Symbols are stored in a global table rather than the stack/heap.
-- Mutexes, Atomics, and other concurrency-oriented objects are always allocated on the heap since by definition they are used by more than one thread.
 
 # Foreign Function Interface
 

docs/api/cyclone/foreign.md

@@ -2,12 +2,15 @@
 
 The `(cyclone foreign)` provides a convenient interface for integrating with C code. It is based in concept on the `(chicken foreign)` module from CHICKEN Scheme. Similarly to that module, this library manipulates the C code directly before it is compiled to a native binary. It is not possible to call these forms at runtime.
 
-# Overview
+# API
 
 - [`c-code`](#c-code)
 - [`c-value`](#c-value)
 - [`c-define`](#c-define)
 - [`c-define-type`](#c-define-type)
+- [`opaque?`](#opaque)
+- [`opaque-null?`](#opaque-null)
+- [`make-opaque`](#make-opaque)
 
 ## c-code
 
@@ -51,6 +54,23 @@ EG, to define a type that consists of integers in Scheme and strings in C:
 
     (c-define-type string-as-integer string number->string string->number)
 
+## opaque?
+
+    (opaque? obj)
+
+Predicate to determine if `obj` is a C Opaque object.
+
+## opaque-null?
+
+    (opaque-null? obj)
+
+Predicate to determine if `obj` is a C Opaque object that contains `NULL`.
+
+## make-opaque
+
+    (make-opaque)
+
+Create a C Opaque object containing `NULL`.
 
 # Type Specifiers
 

docs/api/cyclone/test.md

@@ -2,82 +2,149 @@
 
 The `(cyclone test)` library contains a testing framework ported from `(chibi test)` which in turn was ported from CHICKEN.
 
-- [`warning`](#warning)
+## Testing
-- [`test-group-inc!`](#test-group-inc)
-- [`print-exception`](#print-exception)
 - [`test`](#test)
 - [`test-equal`](#test-equal)
 - [`test-error`](#test-error)
 - [`test-assert`](#test-assert)
 - [`test-not`](#test-not)
 - [`test-values`](#test-values)
+- [`test-propagate-info`](#test-propagate-info)
+- [`test-run`](#test-run)
+
+## Test Groups
 - [`test-group`](#test-group)
-- [`current-test-group`](#current-test-group)
 - [`test-begin`](#test-begin)
 - [`test-end`](#test-end)
-- [`test-syntax-error`](#test-syntax-error)
-- [`test-propagate-info`](#test-propagate-info)
-- [`test-vars`](#test-vars)
-- [`test-run`](#test-run)
 - [`test-exit`](#test-exit)
+
+## Parameters
+- [`current-test-group`](#current-test-group)
 - [`current-test-verbosity`](#current-test-verbosity)
 - [`current-test-applier`](#current-test-applier)
-- [`current-test-handler`](#current-test-handler)
 - [`current-test-skipper`](#current-test-skipper)
 - [`current-test-group-reporter`](#current-test-group-reporter)
-- [`test-failure-count`](#test-failure-count)
 - [`current-test-epsilon`](#current-test-epsilon)
 - [`current-test-comparator`](#current-test-comparator)
-
+- [`test-failure-count`](#test-failure-count)
-# warning
-
-# test-group-inc!
-
-# print-exception
 
 # test
 
+*Syntax*
+
+    (test [name] expect expr)
+
+Evaluate `expr` and check that it is `equal?` to `expect`. 
+
+`name` is used in reporting, and defaults to a printed summary of `expr`.
+
 # test-equal
 
+*Syntax*
+
+    (test-equal equal [name] expect expr)
+
+Equivalent to test, using `equal` for comparison instead of `equal?`.
+
 # test-error
 
+*Syntax*
+
+    (test-error [name] expr)
+
+Like `test` but evaluates `expr` and checks that it raises an error.
+
 # test-assert
 
+*Syntax*
+
+    (test-assert [name] expr)
+
+Like `test` but evaluates `expr` and checks that it's true.
+
 # test-not
 
+*Syntax*
+
+    (test-not [name] expr)
+
+Like `test` but evaluates `expr` and checks that it's false.
+
 # test-values
 
-# test-group
+*Syntax*
 
-# current-test-group
+    (test-values [name] expect expr)
+
+Like `test` but `expect` and `expr` can both return multiple values.
 
 # test-begin
 
+    (test-begin)
+    (test-begin name)
+
+Begin testing a new group until the closing `(test-end)`.
+
 # test-end
 
-# test-syntax-error
+    (test-end)
+    (test-end name)
+
+Ends testing group introduced with `(test-begin)`, and summarizes the results.
 
 # test-propagate-info
 
-# test-vars
+    (test-propagate-info name expect expr info)
+
+Low-level macro to pass alist info to the underlying `test-run`.
 
 # test-run
 
+    (test-run expect expr info)
+
+The procedural interface to testing. `expect` and `expr` should be thunks, and `info` is an alist of properties used in test reporting.
+
 # test-exit
 
+    (test-exit)
+
+Exits with a failure status if any tests have failed, and a successful status otherwise.
+
+# test-group
+
+    (test-group body ...)
+
+Wraps `body` as a single test group, which can be filtered and summarized separately.
+
+# current-test-group
+
+The current test group as started by `test-group` or `test-begin`.
+
 # current-test-verbosity
 
+If true, show more verbose output per test. Inferred from the environment variable `TEST_VERBOSE`.
+
 # current-test-applier
 
-# current-test-handler
+The test applier - what we do with non-skipped tests. Takes the same signature as `test-run`, should be responsible for evaluating the thunks, determining the status of the test, and passing this information to `current-test-reporter`.
 
 # current-test-skipper
 
+The test skipper - what we do with non-skipped tests. This should not evaluate the thunks and simply pass off to `current-test-reporter`.
+
 # current-test-group-reporter
 
+Takes one argument, a test group, and prints a summary of the test results for that group.
+
 # test-failure-count
 
+A running count of all test failures and errors across all groups (and threads). Used by `test-exit`.
+
 # current-test-epsilon
 
+The epsilon used for floating point comparisons.
+
 # current-test-comparator
 
+The underlying comparator used in testing, defaults to `test-equal?`.
+

docs/api/scheme/base.md

@@ -162,6 +162,8 @@ For more information see the [R<sup>7</sup>RS Scheme Specification](../../r7rs.p
 
     (abs num)
 
+Return the absolute value of `num`.
+
 # and
 
 *Syntax*
@@ -179,24 +181,55 @@ Semantics: The `{test}` expressions are evaluated from left to right, and if any
 
     (any pred lst)
 
+Return `#t` if predicate function `pred` is true for any value of `lst`. Otherwise `#f` is returned.
+
 # append
 
     (append list ...)
 
+The last argument, if there is one, can be of any type.
+
+Returns a list consisting of the elements of the first list
+followed by the elements of the other lists. If there are no
+arguments, the empty list is returned. If there is exactly
+one argument, it is returned. Otherwise the resulting list
+is always newly allocated, except that it shares structure
+with the last argument. An improper list results if the last
+argument is not a proper list.
+
+    (append '(x) '(y)) => (x y)
+    (append '(a) '(b c d)) => (a b c d)
+    (append '(a (b)) '((c))) => (a (b) (c))
+    (append '(a b) '(c . d)) => (a b c . d)
+    (append '() 'a) => a
+
 # assoc
 
     (assoc obj alist)
 
     (assoc obj alist compare)
 
+It is an error if alist (for "association list") is not a list of pairs.
+
+This procedure finds the first pair in `alist` whose car field
+is `obj`, and returns that pair. If no pair in `alist` has `obj`
+as its car, then `#f` (not the empty list) is returned. 
+
+`assoc` uses `compare` to compare `obj` with the car fields
+of the pairs in `alist` if given and `equal?` otherwise.
+
 # assq
 
     (assq obj alist)
 
+The `assq` procedure is the same as `assoc` except it uses `eq?` to compare `obj` with the car fields of the pairs in `alist`.
+
 # assv
 
     (assv obj alist)
 
+The `assv` procedure is the same as `assoc` except it uses `eqv?` to compare `obj` with the car fields of the pairs in `alist`.
+
 # begin
 
 *Syntax*
@@ -224,6 +257,8 @@ This form of `begin` can be used as an ordinary expression.  The `{expression}`'
 
     (boolean=? b1 b2 ...)
 
+Returns `#t` if all the arguments are booleans and all are `#t` or all are `#f`.
+
 # bytevector-copy
 
     (bytevector-copy bytevector)
@@ -232,6 +267,11 @@ This form of `begin` can be used as an ordinary expression.  The `{expression}`'
 
     (bytevector-copy bytevector start end)
 
+Returns a newly allocated bytevector containing the bytes in `bytevector` between `start` and `end`.
+
+    (define a #u8(1 2 3 4 5))
+    (bytevector-copy a 2 4)) => #u8(3 4)
+
 # bytevector-copy!
 
     (bytevector-copy! to at from)
@@ -240,6 +280,13 @@ This form of `begin` can be used as an ordinary expression.  The `{expression}`'
 
     (bytevector-copy! to at from start end)
 
+Copies the bytes of `bytevector` from between `start` and `end` to bytevector `to`, starting at `at`.  
+
+    (define a (bytevector 1 2 3 4 5))
+    (define b (bytevector 10 20 30 40 50))
+    (bytevector-copy! b 1 a 0 2)
+    b => #u8(10 1 2 40 50)
+
 # call-with-current-continuation
 
     (call-with-current-continuation proc)
@@ -248,14 +295,31 @@ This form of `begin` can be used as an ordinary expression.  The `{expression}`'
 
     (call-with-port port proc)
 
+It is an error if `proc` does not accept one argument.
+
+The `call-with-port` procedure calls `proc` with `port` as an argument. If `proc` returns, then the `port` is closed automatically and the values yielded by the `proc` are returned.
+
 # call-with-values
 
     (call-with-values producer consumer)
 
+Calls its `producer` argument with no arguments and a
+continuation that, when passed some values, calls the
+`consumer` procedure with those values as arguments. The
+continuation for the call to consumer is the continuation
+of the call to `call-with-values`.
+
+    (call-with-values (lambda () (values 4 5))
+    (lambda (a b) b))
+    => 5
+    (call-with-values * -) => -1
+
 # call/cc
 
     (call/cc proc)
 
+An abbreviation for `call-with-current-continuation`.
+
 # case
 
 *Syntax*
@@ -299,30 +363,44 @@ If the selected `{clause}` or else clause uses the `=>` alternate form, then the
 
     (ceiling z)
 
+Returns the smallest integer not smaller than `z`.
+
 # char<=?
 
     (char<=? c1 c2 c3 ...)
 
+Return `#t` if the results of passing the arguments to `char->integer` are monotonically increasing or equal.
+
 # char<?
 
     (char<?  c1 c2 c3 ...)
 
+Return `#t` if the results of passing the arguments to `char->integer` are respectively equal, monotonically increasing.
+
 # char=?
 
     (char=?  c1 c2 c3 ...)
 
+Return `#t` if the results of passing the arguments to `char->integer` are equal.
+
 # char>=?
 
     (char>=? c1 c2 c3 ...)
 
+Return `#t` if the results of passing the arguments to `char->integer` are monotonically decreasing or equal.
+
 # char>?
 
     (char>?  c1 c2 c3 ...)
 
+Return `#t` if the results of passing the arguments to `char->integer` are monotonically decreasing.
+
 # complex?
 
     (complex? obj) 
 
+Return `#t` if `obj` is a complex number, `#f` otherwise.
+
 # cond
 
 *Syntax*
@@ -404,14 +482,20 @@ A `cond-expand` is then expanded by evaluating the `{feature requirement}`'s of
 
     (current-error-port)
 
+Returns the current error port (an output port).
+
 # current-input-port
 
     (current-input-port)
 
+Return the current input port.
+
 # current-output-port
 
     (current-output-port)
 
+Return the current output port.
+
 # define-record-type
 
 *Syntax*
@@ -420,10 +504,20 @@ A `cond-expand` is then expanded by evaluating the `{feature requirement}`'s of
 
       {constructor} {pred} {field} ...)
 
+Create a new record type.
+
+Record-type definitions are used to introduce new data
+types, called record types. Like other definitions, they can
+appear either at the outermost level or in a body. The values of a record type are called records and are aggregations
+of zero or more fields, each of which holds a single location. A predicate, a constructor, and field accessors and
+mutators are defined for each record type.
+
 # denominator
 
     (denominator n)
 
+Return the denominator of `n`.
+
 # do
 
 *Syntax*
@@ -440,34 +534,52 @@ A `cond-expand` is then expanded by evaluating the `{feature requirement}`'s of
 
     (dynamic-wind before thunk after)
 
+Calls `thunk` without arguments, returning the result(s) of this call.
+
+`before` is called whenever execution enters the dynamic extent of the call to `thunk` and `after` is called whenever it exits that dynamic extent.
+
 # eof-object
 
     (eof-object)
 
+Return the end of file (EOF) object.
+
 # error
 
     (error message obj ...)
 
+Raise an error with message `message` and one or more associated objects `obj`.
+
 # even?
 
     (even? num)
 
+Return `#t` if `num` is even and `#f` if it is not. It is an error if `num` is not a number.
+
 # every
 
     (every pred lst)
 
+Return `#t` if predicate function `pred` is true for every value of `lst`. Otherwise `#f` is returned.
+
 # exact
 
-    (exact? num)
+    (exact num)
+
+Return an exact representation of number `num`.
 
 # exact-integer?
 
     (exact-integer? num)
 
+Returns `#t` if `num` is both exact and an integer; otherwise returns `#f`.
+
 # exact?
 
     (exact? num)
 
+Return `#t` if `num` is exact.
+
 # expt
 
     (expt z1 z2)
@@ -476,32 +588,48 @@ A `cond-expand` is then expanded by evaluating the `{feature requirement}`'s of
 
     (features) 
 
+Return a list of feature identifiers which `cond-expand` treats as true.
+
 # floor
 
     (floor z)
 
+Return an integer not larger than `z`.
+
 # floor-quotient 
 
     (floor-quotient n m)
 
+Returns the integer quotient of dividing `n` by `m`.
+
 # floor-remainder
 
     (floor-remainder n m)
 
+Returns the integer remainder of dividing `n` by `m`.
+
 # floor/ 
 
     (floor/ n m)
 
+Return integer quotient and remainder of dividing `n` by `m`.
+
 # flush-output-port
 
     (flush-output-port)
 
     (flush-output-port port)
 
+Flushes any buffered output from the buffer of `output-port`
+to the underlying file or device and returns an unspecified
+value.
+
 # foldl
 
     (foldl func accum lst)
 
+Perform a left fold.
+
 # foldr
 
     (foldr func end lst)
@@ -510,18 +638,52 @@ A `cond-expand` is then expanded by evaluating the `{feature requirement}`'s of
 
     (for-each proc list1 list2 ...)
 
+It is an error if `proc` does not accept as many arguments as there are lists.
+
+The arguments to `for-each` are like the arguments to `map`,
+but `for-each` calls `proc` for its side effects rather than for
+its values. Unlike `map`, `for-each` is guaranteed to call `proc`
+on the elements of the lists in order from the first element(s) to the last, and the value returned by `for-each`
+is unspecified. If more than one list is given and not all
+lists have the same length, for-each terminates when the
+shortest list runs out. The lists can be circular, but it is
+an error if all of them are circular.
+
+    (let ((v (make-vector 5)))
+      (for-each (lambda (i)
+                  (vector-set! v i (* i i)))
+                ’(0 1 2 3 4))
+      v) => #(0 1 4 9 16)
+
 # gcd
 
     (gcd n1 ...)
 
+Return the greatest commong divisor of the arguments.
+
 # get-output-bytevector
 
     (get-output-bytevector port)
 
+Returns a bytevector consisting of the bytes that have been output to the `port` so far in the order they were output.
+
 # get-output-string
 
     (get-output-string port)
 
+Returns a string consisting of the characters that have been output to the `port` so far in the order they were output. If the result string is modified, the effect is unspecified.
+
+    (parameterize
+      ((current-output-port
+       (open-output-string)))
+      (display "piece")
+      (display " by piece ")
+      (display "by piece.")
+      (newline)
+      (get-output-string (current-output-port)))
+
+      => "piece by piece by piece.\n"
+
 # guard
 
 *Syntax*
@@ -536,22 +698,32 @@ A `cond-expand` is then expanded by evaluating the `{feature requirement}`'s of
 
     (inexact z)
 
+Return `z` as an inexact number.
+
 # inexact?
 
     (inexact? num)
 
+Return `#t` if `num` is inexact and `#f` otherwise.
+
 # input-port-open?
 
     (input-port-open? port)
 
+Return `#t` if the given input port is open and `#f` otherwise.
+
 # input-port?
 
     (input-port? port)
 
+Return `#t` if `port` is an input port and `#f` otherwise.
+
 # lcm
 
     (lcm n1 ...)
 
+Return the least common multiple of the arguments.
+
 # let
 
 *Syntax*
@@ -678,26 +850,54 @@ If it is not possible to evaluate each `{init}` without assigning or referring t
 
     (list obj ...)
 
+Return a newly allocated list of its arguments.
+
 # list-copy
 
     (list-copy lst)
 
+Returns a newly allocated copy of the given `obj` if it is a
+list. Only the pairs themselves are copied; the cars of the
+result are the same (in the sense of `eqv?`) as the cars of list.
+
+If `obj` is an improper list, so is the result, and the final cdrs
+are the same in the sense of `eqv?`. An obj which is not a
+list is returned unchanged. 
+
+It is an error if obj is a circular list.
+
+    (define a ’(1 8 2 8)) ; a may be immutable
+    (define b (list-copy a))
+    (set-car! b 3) ; b is mutable
+
+    b => (3 8 2 8)
+    a => (1 8 2 8)
+
+
 # list-ref
 
     (list-ref lst k)
 
+Returns the kth element of `lst`.
+
 # list-set!
 
     (list-set! lst k obj)
 
+Stores `obj` in element `k` of `lst`.
+
 # list-tail
 
     (list-tail lst k) 
 
+Returns the sublist of `lst` obtained by omitting the first `k` elements.
+
 # list?
 
     (list? o)
 
+Returns `#t` if the given object is a list, and `#f` otherwise.
+
 # make-constructor
 
     (make-constructor make name)
@@ -712,12 +912,18 @@ If it is not possible to evaluate each `{init}` without assigning or referring t
 
     (make-list k fill)
 
+Returns a newly allocated list of `k` elements. If a second
+argument is given, then each element is initialized to fill.
+Otherwise the initial contents of each element is unspecified.
+
 # make-parameter
 
     (make-parameter init)
 
     (make-parameter init converter)
 
+Returns a newly allocated parameter object, which is a procedure that accepts zero arguments and returns the value associated with the parameter object.
+
 # make-setter
 
     (make-setter sym name idx)
@@ -728,6 +934,11 @@ If it is not possible to evaluate each `{init}` without assigning or referring t
 
     (make-string k fill)
 
+The `make-string` procedure returns a newly allocated
+string of length `k`. If `fill` char is given, then all the characters
+of the string are initialized to `fill` , otherwise the contents
+of the string are unspecified.
+
 # make-type-predicate
 
     (make-type-predicate pred name)
@@ -736,70 +947,119 @@ If it is not possible to evaluate each `{init}` without assigning or referring t
 
     (map proc list1 list2 ...)
 
+The `map` procedure applies `proc` element-wise to the elements of the lists and returns a list of the results, in order.
+
+If more than one list is given and not all lists have the same length, `map` terminates when the shortest list runs out. The lists can be circular, but it is an error if all of them are circular. It is an error for `proc` to mutate any of the lists. The dynamic order in which `proc` is applied to the elements of the lists is unspecified. If multiple returns occur from `map`, the values returned by earlier returns are not mutated.
+
+    (map cadr ’((a b) (d e) (g h)))
+      => (b e h)
+
+    (map (lambda (n) (expt n n))
+         ’(1 2 3 4 5))
+      => (1 4 27 256 3125)
+
+    (map + ’(1 2 3) ’(4 5 6 7)) => (5 7 9)
+
 # max
 
     (max x1 x2 ...)
 
+`max` returns the largest of its arguments.
+
 # member
 
     (member obj lst) 
 
     (member obj lst compare) 
 
+Returns the first sublist of `lst` whose car is `obj`, where the sublists are the non-empty lists returned by `(list-tail lst k)` for `k` less than the length of `lst`. 
+
+If obj does not occur in list, then #f (not the empty
+list) is returned. 
+
+`member` uses compare to compare elements of the list, if given, and `equal?` otherwise.
+
 # memq
 
     (memq obj lst)
 
+The `memq` procedure is the same as `member` but uses `eq?` to compare `obj` with the elements of `lst`.
+
 # memv
 
     (memv obj lst)
 
+The `memv` procedure is the same as `member` but uses `eqv?` to compare `obj` with the elements of `lst`.
+
 # min
 
     (min x1 x2 ...)
 
+`min` returns the smallest of its arguments.
+
 # modulo
 
     (modulo a b)
 
+Return the integer remainder after dividing `a` by `b`.
+
 # negative?
 
     (negative? n)
 
+Returns `#t` if `n` is a negative number and `#f` otherwise. It is an error if `n` is not a number.
+
 # newline
 
     (newline)
 
     (newline port) 
 
+Write a newline to `port`, or the current output port if no argument is given.
+
 # not
 
     (not x)
 
+The `not` procedure returns `#t` if `x` is false, and returns `#f` otherwise.
+
 # numerator
 
-    (numerator n) n)
+    (numerator n)
+
+Return the numerator of `n`.
 
 # odd?
 
     (odd? num)
 
+Return `#t` if `num` is an odd number and `#f` otherwise.
+
 # open-input-bytevector
 
     (open-input-bytevector bv)
 
+Takes a bytevector and returns a binary input port that delivers bytes from the bytevector.
+
 # open-input-string
 
     (open-input-string string)
 
+Takes a string and returns a textual input port that delivers
+characters from the string.
+
 # open-output-bytevector
 
     (open-output-bytevector open-output-string)
 
+Returns a binary output port that will accumulate bytes for retrieval by `get-output-bytevector`.
+
 # open-output-string
 
     (open-output-string)
 
+Returns a textual output port that will accumulate characters for retrieval by `get-output-string`.
+
 # or
 
 *Syntax*
@@ -818,10 +1078,14 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (output-port-open? port)
 
+Returns `#t` if `port` is an open output port, and `#f` otherwise.
+
 # output-port?
 
     (output-port? obj)
 
+Returns `#t` if `obj` is an output port, and `#f` otherwise.
+
 # parameterize
 
 *Syntax*
@@ -834,6 +1098,8 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (positive? n)
 
+Returns `#t` if `n` is a positive number and `#f` otherwise.
+
 # quasiquote
 
 *Syntax*
@@ -844,30 +1110,52 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (quotient x y)
 
+Return the quotient of dividing `x` by `y`.
+
 # raise
 
     (raise obj)
 
+Raises an exception by invoking the current exception handler on `obj`. 
+
+The handler is called with the same dynamic environment as that of the call to `raise`, except that the current exception handler is the one that was in place when the handler being called was installed. If the handler returns, a secondary exception is raised in the same dynamic environment as the handler.
+
 # raise-continuable
 
     (raise-continuable obj)
 
+Raises an exception by invoking the current exception handler on `obj`. 
+
+The handler is called with the same dynamic
+environment as the call to `raise-continuable`, except
+that: (1) the current exception handler is the one that was
+in place when the handler being called was installed, and
+(2) if the handler being called returns, then it will again
+become the current exception handler. If the handler returns, the values it returns become the values returned by
+the call to `raise-continuable`.
+
 # rational?
 
     (rational? obj)
 
+Returns `#t` if `obj` is a rational number and `#f` otherwise.
+
 # read-line
 
     (read-line)
 
     (read-line port)
 
+Read a line of text from the current input port or `port` if specified.
+
 # read-string
 
     (read-string k)
 
     (read-string k port)
 
+Read a string from the current input port or `port` if specified.
+
 # receive
 
 *Syntax*
@@ -878,18 +1166,26 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (record? obj)
 
+Returns `#t` if `obj` is a record type and `#f` otherwise.
+
 # remainder
 
     (remainder num1 num2)
 
+Returns the remainder of dividing `num1` by `num2`.
+
 # reverse
 
     (reverse lst)
 
+Returns a newly allocated list that is the reverse of `lst`.
+
 # round
 
     (round z)
 
+Returns the closest integer to `z`.
+
 # slot-set!
 
     (slot-set! name obj idx val)
@@ -898,10 +1194,14 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (square z)
 
+Returns the square of `z`.
+
 # string
 
     (string char ...)
 
+Returns a string containing the given characters.
+
 # string->list
 
     (string->list string)
@@ -910,6 +1210,8 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (string->list string start end)
 
+Returns a newly allocated list containing the characters of `string`.
+
 # string->utf8
 
     (string->utf8 string)
@@ -918,6 +1220,8 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (string->utf8 string start end)
 
+Returns a newly allocated bytevector containing the UTF-8 bytecodes of `string`.
+
 # string->vector
 
     (string->vector string)
@@ -926,6 +1230,8 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (string->vector string start end)
 
+Returns a newly allocated vector containing the contents of `string`.
+
 # string-copy
 
     (string-copy string)
@@ -934,6 +1240,8 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (string-copy string end)
 
+Returns a copy of `string`.
+
 # string-copy!
 
     (string-copy! to at from)
@@ -942,6 +1250,14 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (string-copy! to at from start end)
 
+Copies the characters of `string` from between `start` and `end`
+to string `to`, starting at `at`.
+
+    (define a "12345")
+    (define b (string-copy "abcde"))
+    (string-copy! b 1 a 0 2)
+    b => "a12de"
+
 # string-fill!
 
     (string-fill! str fill)
@@ -950,14 +1266,20 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (string-fill! str fill start end)
 
+The `string-fill!` procedure stores `fill` in the elements of `str` between `start` and `end`.
+
 # string-for-each
 
     (string-for-each proc string1 string2 ...)
 
+`string-for-each` is like `for-each` but the arguments consist of strings instead of lists.
+
 # string-map
 
     (string-map proc string1 string2 ...)
 
+`string-maph` is like `map` but the arguments consist of strings instead of lists.
+
 # string<=?
 
     (string<=? str1 str2)
@@ -970,6 +1292,8 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (string=? str1 str2)
 
+Returns `#t` if all of the given strings are equal and false otherwise.
+
 # string>=?
 
     (string>=? str1 str2)
@@ -982,6 +1306,8 @@ Semantics: The `{test}` expressions are evaluated from left to right, and the va
 
     (symbol=? symbol1 symbol2 symbol3 ...)
 
+Returns `#t` if all of the arguments are the same symbol and `#f` otherwise.
+
 # syntax-error
 
 *Syntax*
@@ -1030,14 +1356,20 @@ Semantics: The `test` is evaluated, and if it evaluates to `#f`, the expressions
 
     (utf8->string bytevector start end)
 
+Convert bytecodes in the given `bytevector` to a string.
+
 # values
 
     (values obj ...)
 
+Return arguments received as multiple values.
+
 # vector
 
     (vector obj ...)
 
+`vector` returns a vector of its arguments.
+
 # vector->list
 
     (vector->list vector)
@@ -1046,6 +1378,8 @@ Semantics: The `test` is evaluated, and if it evaluates to `#f`, the expressions
 
     (vector->list vector start end)
 
+Return a newly-allocated list containing the contents of `vector`.
+
 # vector->string
 
     (vector->string vector)
@@ -1054,10 +1388,14 @@ Semantics: The `test` is evaluated, and if it evaluates to `#f`, the expressions
 
     (vector->string vector start end)
 
+Return a newly-allocated string containing the contents of `vector`.
+
 # vector-append
 
     (vector-append vector ...)
 
+Returns a newly allocated vector whose elements are the concatenation of the elements of the given vectors.
+
 # vector-copy
 
     (vector-copy vector)
@@ -1066,6 +1404,11 @@ Semantics: The `test` is evaluated, and if it evaluates to `#f`, the expressions
 
     (vector-copy vector start end)
 
+Returns a newly allocated copy of the elements of the given
+vector between `start` and `end`. The elements of the new
+vector are the same (in the sense of `eqv?`) as the elements
+of the old.
+
 # vector-copy!
 
     (vector-copy! to at from)
@@ -1074,6 +1417,14 @@ Semantics: The `test` is evaluated, and if it evaluates to `#f`, the expressions
 
     (vector-copy! to at from start end)
 
+Copies the elements of `vector` from between `start` and `end`
+to vector `to`, starting at `at`.
+
+    (define a (vector 1 2 3 4 5))
+    (define b (vector 10 20 30 40 50))
+    (vector-copy! b 1 a 0 2)
+    b => #(10 1 2 40 50)
+
 # vector-fill!
 
     (vector-fill! vector fill)
@@ -1082,14 +1433,20 @@ Semantics: The `test` is evaluated, and if it evaluates to `#f`, the expressions
 
     (vector-fill! vector fill start end)
 
+The `vector-fill!` procedure stores `fill` in the elements of `vector` between `start` and `end`.
+
 # vector-for-each
 
     (vector-for-each proc vector1 vector2 ...)
 
+`vector-for-each` is like `for-each` but the arguments consist of vectors instead of lists.
+
 # vector-map
 
     (vector-map proc vector1 vector2 ...)
 
+`vector-map` is like `map` but the arguments consist of vectors instead of lists.
+
 # when
 
 *Syntax*
@@ -1108,9 +1465,17 @@ Semantics: The `test` is evaluated, and if it evaluates to a true value, the exp
 
     (with-exception-handler handler thunk)
 
+The `with-exception-handler` procedure returns the results of invoking `thunk`. `handler` is installed as the current exception handler in the dynamic environment used for the invocation of `thunk`.
+
 # with-handler
 
-    (with-handler handler body)
+*Syntax*
+
+    (with-handler handler expression1 expression2 ...)
+
+`with-handler` provides a convenient exception handling syntax. 
+
+The expressions are executed in order and if no exceptions are raised the result of the last expression is returned. Otherwise if an exception is raised then `handler` is called and its results are returned.
 
 # write-char
 
@@ -1118,13 +1483,18 @@ Semantics: The `test` is evaluated, and if it evaluates to a true value, the exp
 
     (write-char char port)
 
+Write `char` to the current output port or `port` if specified.
+
 # write-string
 
     (write-string string)
 
     (write-string string port)
 
+Write `string` to the current output port or `port` if specified.
+
 # zero?
 
     (zero? n)
 
+Returns `#t` if `n` is zero and `#f` otherwise.

docs/api/scheme/char.md

@@ -31,30 +31,44 @@ For more information see the [R<sup>7</sup>RS Scheme Specification](../../r7rs.p
 
     (char-alphabetic? c)
 
+Return `#t` if `c` is alphabetic and `#f` otherwise.
+
 # char-ci<=?
 
     (char-ci<=? c1 c2 . cs)
 
+Return `#t` if the results of converting all characters to the same case and  passing the arguments to `char->integer` are monotonically increasing or equal.
+
 # char-ci<? 
 
     (char-ci<? c1 c2 . cs)
 
+Return `#t` if the results of converting all characters to the same case and  passing the arguments to `char->integer` are respectively equal, monotonically increasing.
+
 # char-ci=?
 
     (char-ci=? c1 c2 . cs)
 
+Return `#t` if the results of converting all characters to the same case and passing the arguments to `char->integer` are equal.
+
 # char-ci>=? 
 
     (char-ci>=? c1 c2 . cs)
 
+Return `#t` if the results of converting all characters to the same case and  passing the arguments to `char->integer` are monotonically decreasing or equal.
+
 # char-ci>?
 
     (char-ci>? c1 c2 . cs)
 
+Return `#t` if the results of converting all characters to the same case and passing the arguments to `char->integer` are monotonically decreasing.
+
 # char-downcase
 
     (char-downcase c)
 
+Returns the lowercase equivalent of `c` if one exists, otherwise `c` is returned.
+
 # char-foldcase
 
     (char-foldcase c)
@@ -63,26 +77,38 @@ For more information see the [R<sup>7</sup>RS Scheme Specification](../../r7rs.p
 
     (char-lower-case? c)
 
+Return `#t` if `c` is lower case and `#f` otherwise.
+
 # char-numeric?
 
     (char-numeric? c) 
 
+Return `#t` if `c` is numeric and `#f` otherwise.
+
 # char-upcase
 
     (char-upcase c)
 
+Returns the uppercase equivalent of `c` if one exists, otherwise `c` is returned.
+
 # char-upper-case?
 
     (char-upper-case? c)
 
+Return `#t` if `c` is alphabetic and `#f` otherwise.
+
 # char-whitespace?
 
     (char-whitespace? c)
 
+Return `#t` if `c` is whitespace and `#f` otherwise.
+
 # digit-value
 
     (digit-value c)
 
+This procedure returns the numeric value (0 to 9) of its argument if it is a numeric digit (that is, if `char-numeric?` returns `#t`), or `#f` on any other character.
+
 # string-ci<=? 
 
     (string-ci<=? s1 s2)
@@ -95,6 +121,8 @@ For more information see the [R<sup>7</sup>RS Scheme Specification](../../r7rs.p
 
     (string-ci=? s1 s2)
 
+Returns `#t` if all of the given strings are equal using a case-insensitive comparison, and false otherwise.
+
 # string-ci>=?
 
     (string-ci>=? s1 s2)
@@ -107,6 +135,8 @@ For more information see the [R<sup>7</sup>RS Scheme Specification](../../r7rs.p
 
     (string-downcase str)
 
+Return a newly-allocated string with any uppercase characters converted to lowercase.
+
 # string-foldcase
 
     (string-foldcase str)
@@ -115,3 +145,5 @@ For more information see the [R<sup>7</sup>RS Scheme Specification](../../r7rs.p
 
     (string-upcase str)
 
+Return a newly-allocated string with any lowercase characters converted to uppercase.
+

docs/api/scheme/complex.md

@@ -19,19 +19,26 @@ For more information see the [R<sup>7</sup>RS Scheme Specification](../../r7rs.p
 
     (imag-part x)
 
+Return the imaginary part of complex number `x`.
+
 # magnitude
 
     (magnitude z)
 
 # make-polar
 
-    (make-polar x y)
+    (make-polar r phi)
+
+Return a complex number corresponding to the given polar coordinate.
 
 # make-rectangular
 
     (make-rectangular x y)
 
+Create a complex number with real component `x` and imaginary component `y`.
+
 # real-part
 
     (real-part x)
 
+Return the real part of complex number `x`.

docs/api/scheme/cyclone/ast.md

@@ -2,8 +2,9 @@
 
 The `(scheme cyclone ast)` library defines abstract syntax tree types used during compilation.
 
+*This library is used internally by the compiler and its API may change at any time.*
+
 - [`ast:make-lambda`](#astmake-lambda)
-- [`ast:%make-lambda`](#astmake-lambda-1)
 - [`ast:lambda?`](#astlambda)
 - [`ast:lambda-id`](#astlambda-id)
 - [`ast:lambda-args`](#astlambda-args) 
@@ -16,42 +17,72 @@ The `(scheme cyclone ast)` library defines abstract syntax tree types used durin
 
 # ast:make-lambda
     (ast:make-lambda args body)
+    (ast:make-lambda args body cont)
 
-# ast:%make-lambda
+Create an instance of the `ast-lambda` record type. 
-    (ast:%make-lambda lambda-id args body)
+
+This data type is at the center of this module and consists of the following data:
+
+* `id` - Unique numeric ID assigned to each lambda
+* `args` - Arguments to the lambda. This may be one of:
+     * symbol indicating a function takes any number of arguments
+     * list of symbols corresponding to each of a fixed number of arguments to the function
+     * improper list indicating a function taking a fixed number of required arguments as well as an arbitrary number of optional arguments
+* `body` - Expression in the function body of the lambda
+* `cont` - Boolean indicating whether the lambda has a continuation
+
+`ast:make-lambda` automatically assigns the `id` field to a unique value.
 
 # ast:lambda?
     (ast:lambda? obj)
 
+Predicate indicating whether `obj` is an `ast-lambda` object.
+
 # ast:lambda-id
 
     (ast:lambda-id lambda-obj)
 
+Return the `id` field of the given `ast-lambda` object.
+
 # ast:lambda-args 
 
     (ast:lambda-args lambda-obj)
 
+Return the `args` field of the given `ast-lambda` object.
+
 # ast:set-lambda-args!
 
     (ast:set-lambda-args! lambda-obj args)
 
+Change the `args` field of the given `ast-lambda` object.
+
 # ast:lambda-body 
 
     (ast:lambda-body lambda-obj)
 
+Return the `body` field of the given `ast-lambda` object.
+
 # ast:set-lambda-body!
 
     (ast:set-lambda-body! lambda-obj body)
 
+Change the `body` field of the given `ast-lambda` object.
+
 # ast:ast->sexp
 
     (ast:ast->sexp exp)
 
+Convert an abstract syntax tree `exp` back into an equivalent expression consisting of standard Scheme S-expressions. IE: `lambda` forms instead of `ast-lambda` objects.
+
 # ast:sexp->ast
 
     (ast:sexp->ast exp)
 
+Convert a standard Scheme S-expression tree containing `lambda` forms into an equivalent abstract syntax tree consisting of equivalent `ast-lambda` objects.
+
 # ast:ast->pp-sexp
 
     (ast:ast->pp-sexp exp)
 
+Transform an abstract syntax tree into one that prints more cleanly.
+

docs/api/scheme/cyclone/cgen.md

@@ -2,6 +2,8 @@
 
 The `(scheme cyclone cgen)` library compiles scheme code to a Cheney-on-the-MTA C runtime.
 
+*This library is used internally by the compiler and its API may change at any time.*
+
 - [`mta:code-gen`](#mtacode-gen)
 - [`emit`](#emit)
 - [`emit*`](#emit-1)
@@ -45,4 +47,3 @@ Call `emits` for each of the given strings.
 
 `display` a newline to the current output port.
 
-

docs/api/scheme/cyclone/common.md

@@ -2,6 +2,8 @@
 
 The `(scheme cyclone common)` library contains definitions used by the compiler and interpreter.
 
+*This library is used internally by the compiler and its API may change at any time.*
+
 - [`*Cyc-version-banner*`](#cyc-version-banner)
 - [`*version*`](#version)
 - [`*version-number*`](#version-number)

docs/api/scheme/cyclone/cps-optimizations.md

@@ -2,6 +2,8 @@
 
 The `(scheme cyclone optimizations)` library performs CPS analysis and optimizations.
 
+*This library is used internally by the compiler and its API may change at any time.*
+
 - [`optimize-cps`](#optimize-cps)
 - [`analyze-cps`](#analyze-cps)
 - [`opt:contract`](#optcontract)

docs/api/scheme/cyclone/libraries.md

@@ -2,11 +2,15 @@
 
 The `(scheme cyclone libraries)` library implements r7rs libraries.
 
+*This library is used internally by the compiler and its API may change at any time.*
+
 - [`library?`](#library)
+- [`library-exists?`](#library-exists)
 - [`lib:list->import-set`](#liblist-import-set)
 - [`lib:name`](#libname)
 - [`lib:name->string`](#libname-string)
 - [`lib:name->symbol`](#libname-symbol)
+- [`lib:name->unique-string`](#libname-unique-string)
 - [`lib:result`](#libresult)
 - [`lib:exports`](#libexports)
 - [`lib:rename-exports`](#librename-exports)
@@ -19,7 +23,6 @@ The `(scheme cyclone libraries)` library implements r7rs libraries.
 - [`lib:import->path`](#libimport-path)
 - [`lib:read-imports`](#libread-imports)
 - [`lib:import->export-list`](#libimport-export-list)
-- [`lib:resolve-imports`](#libresolve-imports)
 - [`lib:resolve-meta`](#libresolve-meta)
 - [`lib:get-all`](#libget-all)
 - [`lib:get-all-import-deps`](#libget-all-import-deps)
@@ -31,49 +34,183 @@ The `(scheme cyclone libraries)` library implements r7rs libraries.
 
     (library? obj)
 
+Predicate - return `#t` if the given `obj` a `define-library` S-expression or `#f` otherwise.
+
+# library-exists?
+
+    (library-exists? import-set)
+    (library-exists? import-set file-extension)
+
+Determine if a library exists on the file system for the given import set.
+
+Checks for the default file extension of `.sld` unless `file-extension` is provided.
+
 # lib:list->import-set
 
+    (lib:list->import-set lis)
+
+Convert a raw list to an import set. For example, a list might be `(srfi 18)` containing the number `18`. An import set contains only symbols or sub-lists. Any numbers are converted to the corresponding symbol.
+
+This is also a convenient time to do any name conversions from an alias to the actual library, so any such conversion will also be performed.
+
 # lib:name
 
+    (lib:name ast)
+
+Return the library name as an import set. For example `(scheme base)`.
+
 # lib:name->string
 
+    (lib:name->string name)
+
+Convert name (as list of symbols) to a mangled string.
+
 # lib:name->symbol
 
+    (lib:name->symbol name)
+
+Convert library name to a unique symbol.
+
+# lib:name->unique-string
+
+    (lib:name->unique-string name)
+
+Convert name (as list of symbols) to a mangled string guaranteed to be unique.
+
 # lib:result
 
+    (lib:result result)
+    
+Helper function that returns `result` unless `result` is `#f` in which case the empty list is returned as a default value.
+
 # lib:exports
 
+    (lib:exports ast)
+
+Return the library's exports.
+
 # lib:rename-exports
 
+   (lib:rename-exports ast)
+
+Return the library's exports that are renamed.
+
 # lib:imports
 
+    (lib:imports ast)
+
+Return the library's imports.
+
 # lib:body
 
+    (lib:body ast)
+
+Return the given library's body. IE, the contents of `begin`.
+
 # lib:includes
 
+    (lib:includes ast)
+
+Retun the library's include directives.
+
 # lib:include-c-headers
 
+    (lib:include-c-headers ast)
+
+Return the library's `include-c-headers` directives.
+
 # lib:import->filename
 
+    (lib:import->filename import)
+    (lib:import->filename import extension)
+    (lib:import->filename import extension append-path)
+    (lib:import->filename import extension append-path prepend-path)
+
+Resolve library filename given an import `import`. 
+
+Options:
+
+- `extension`, assumes ".sld" file extension if one is not specified.
+- `append-path`, list of strings
+- `prepend-path`, list of strings
+
 # lib:import->metalist
 
+    (lib:import->metalist import append-dirs prepend-dirs)
+
+Given an import set `import` find the associated `.meta` file, if it exists, and return its contents. An empty list is returned if a file cannot be found.
+
 # lib:import->path
 
+    (lib:import->path import append-dirs prepend-dirs include)
+
+Get path to directory that contains the library.
+
 # lib:read-imports
 
+    (lib:read-imports import append-dirs prepend-dirs expander)
+
+Given a single import from an import-set, open the corresponding library file and retrieve the library's import-set.
+
 # lib:import->export-list
 
-# lib:resolve-imports
+    (lib:import->export-list import append-dirs prepend-dirs expander)
+
+Read export list for a given import.
 
 # lib:resolve-meta
 
+    (lib:resolve-meta imports append-dirs prepend-dirs)
+
+Return contents of all `.meta` files for the given import sets `imports`.
+
 # lib:get-all
 
+    (lib:get-all ast tag)
+
+Get all instances of given tagged list from a library definition, and collect the contents of them into a single list.
+
 # lib:get-all-import-deps
 
+    (lib:get-all-import-deps imports append-dirs prepend-dirs expander)
+
+Given an import set, get all dependant import names that are required
+The list of deps is intended to be returned in order, such that the
+libraries can be initialized properly in sequence.
+
 # lib:get-dep-list
 
+    (lib:get-dep-list imports)
+
+Given a list of alists `(library-name . imports)`, resolve all of the dependencies and return an ordered list of library names such that each library is encounted after the libraries it imports (IE, it's dependencies). For example:
+
+    (lib:get-dep-list `(
+      ((srfi 69) (scheme base) (scheme char))
+      ((scheme base) (scheme cyclone common))
+      ((scheme cyclone common))
+      ((scheme char) (scheme base))
+      ((scheme cyclone hashset) (scheme base) (scheme write))
+      ((scheme write) (scheme base))
+      ((scheme cyclone primitives) (scheme base) (scheme cyclone hashset) (srfi 69))
+      ((scheme process-context))
+      ((scheme cyclone libraries) (scheme base) (scheme read) (scheme process-context) (scheme cyclone util))
+      ((scheme read) (scheme base) (scheme cyclone common) (scheme cyclone util) (scheme char))
+      ((scheme cyclone util) (scheme base) (scheme char))
+      ((scheme eval) (scheme cyclone util) (scheme cyclone libraries) (scheme cyclone primitives) (scheme base) (scheme file) (scheme read))
+      ((scheme file) (scheme base))
+      ((scheme lazy) (scheme base))
+    ))
+
 # lib:imports->idb
 
+    (lib:imports->idb imports append-dirs prepend-dirs expander)
+
+Take a list of imports and create a "database" from them
+consisting of maps between each exported identifier and the
+library that imports that identifier. 
+
 # lib:idb:ids
 
+    (lib:idb:ids db)
+
+Take an idb "database" `db` and create a list of identifiers that are imported. EG: `((call/cc . (scheme base)))` ==> `(call/cc)`

docs/api/scheme/cyclone/macros.md

@@ -1,29 +0,0 @@
-# Macro Library
-
-The `(scheme cyclone macro)` library contains code to deal with macros.
-
-- [`define-syntax?`](#define-syntax)
-- [`macro:macro?`](#macromacro)
-- [`macro:expand`](#macroexpand)
-- [`macro:add!`](#macroadd)
-- [`macro:cleanup`](#macrocleanup)
-- [`macro:load-env!`](#macroload-env)
-- [`macro:get-env`](#macroget-env)
-- [`macro:get-defined-macros`](#macroget-defined-macros)
-
-# define-syntax?
-
-# macro:macro?
-
-# macro:expand
-
-# macro:add!
-
-# macro:cleanup
-
-# macro:load-env!
-
-# macro:get-env
-
-# macro:get-defined-macros
-

docs/api/scheme/cyclone/primitives.md

@@ -2,9 +2,9 @@
 
 The `(scheme cyclone primitives)` library contains information about Cyclone's scheme primitives.
 
+*This library is used internally by the compiler and its API may change at any time.*
+
 - [`prim?`](#prim)
-- [`*primitives*`](#primitives)
-- [`*primitives-num-args*`](#primitives-num-args)
 - [`prim-call?`](#prim-call)
 - [`prim->c-func`](#prim-c-func)
 - [`prim/data-arg?`](#primdata-arg)
@@ -15,33 +15,79 @@ The `(scheme cyclone primitives)` library contains information about Cyclone's s
 - [`prim:cont?`](#primcont)
 - [`prim:cont/no-args?`](#primcontno-args)
 - [`prim:arg-count?`](#primarg-count)
-- [`prim:allocates-object?)`](#primallocates-object)
+- [`prim:allocates-object?`](#primallocates-object)
 
 # prim?
 
-# \*primitives\*
+    (prim? obj)
 
-# \*primitives-num-args\*
+Determine if the given object is a symbol referring to a primitive.
 
 # prim-call?
 
+    (prim-call? exp)
+
+Determine if the given expression `exp` is a call to a primitive.
+
 # prim->c-func
 
+    (prim->c-func sym use-alloca? emit-unsafe)
+
+Returns text containing the C function that is used to implement primitive `sym`.
+
+If `emit-unsafe` is true then an unsafe version of the primtive, if available, will be returned.
+ 
 # prim/data-arg?
 
+    (prim/data-arg? sym)
+
+Primitive indicating if the primitive requires passing thread data as its first argument.
+
 # prim/c-var-assign
 
+    (prim/c-var-assign sym)
+
+Return the C data type of variable used to assign the result of primitive `sym`, if applicable. `#f` is returned otherwise.
+
 # prim/cvar?
 
+    (prim/cvar? sym)
+
+Determine if primitive `sym` creates a C variable.
+
 # prim:check-arg-count
 
+    (prim:check-arg-count sym num-args expected)
+
+Return `#f` the primitive `sym` cannot accept the given number of arguments `num-args` given the expected number of arguments `expected`, and `#t` otherwise.
+
 # prim:mutates?
 
+    (prim:mutates? sym)
+
+Does primitive `sym` mutate any of its arguments?
+
 # prim:cont?
 
+    (prim:cont? sym)
+
+Should the compiler pass a continuation as the function's first parameter?
+
 # prim:cont/no-args?
 
+    (prim:cont/no-args? sym)
+
+Is `sym` a primitive function that passes a continuation or thread data but has no other arguments?
+
 # prim:arg-count?
 
-# prim:allocates-object?)
+    (prim:arg-count? sym)
+
+Should the compiler pass an integer arg count as the function's first parameter?
+
+# prim:allocates-object?
+
+    (prim:allocates-object? sym use-alloca?)
+
+Does primitive `sym` allocate an object?
 

docs/api/scheme/cyclone/transforms.md

@@ -2,6 +2,8 @@
 
 The `(scheme cyclone transforms)` library performs Scheme-to-Scheme transformations, and also contains various utility functions used by the compiler.
 
+*This library is used internally by the compiler and its API may change at any time.*
+
 - [`*defined-macros*          `](#*defined-macros)
 - [`*do-code-gen*             `](#*do-code-gen)
 - [`*primitives*              `](#*primitives)
@@ -41,8 +43,6 @@ The `(scheme cyclone transforms)` library performs Scheme-to-Scheme transformati
 - [`env-make->id              `](#env-make-id)
 - [`env-make->values          `](#env-make-values)
 - [`env-make?                 `](#env-make)
-- [`expand                    `](#expand)
-- [`expand-lambda-body        `](#expand-lambda-body)
 - [`filter-unused-variables   `](#filter-unused-variables)
 - [`free-vars                 `](#free-vars)
 - [`get-macros                `](#get-macros)
@@ -161,10 +161,6 @@ The `(scheme cyclone transforms)` library performs Scheme-to-Scheme transformati
 
 # env-make? 
 
-# expand 
-
-# expand-lambda-body
-
 # filter-unused-variables 
 
 # free-vars 

docs/api/scheme/cyclone/util.md

@@ -2,6 +2,8 @@
 
 The `(scheme cyclone util`) library contains various utility functions used internally the compiler.
 
+*This library is used internally by the compiler and its API may change at any time.*
+
 - [`Cyc-er-compare?            `](#cyc-er-compare)
 - [`Cyc-er-rename              `](#cyc-er-rename)
 - [`app?                       `](#app)

docs/api/scheme/eval.md

@@ -7,6 +7,7 @@ For more information see the [R<sup>7</sup>RS Scheme Specification](../../r7rs.p
 - [`eval`](#eval)
 - [`create-environment`](#create-environment)
 - [`setup-environment`](#setup-environment)
+- [`expand`](#expand)
 
 # eval
 
@@ -30,3 +31,14 @@ A non-standard function to create a new environment on top of the default one.
     (setup-environment)
 
 A non-standard function to initialize a new global environment.
+
+# expand
+
+    (expand expr [[environment] [rename-environment]])
+
+Perform macro expansion on `expr` and return the resulting expression.
+
+`environment` may be optionally passed as the current environment. 
+
+`rename-environment` is an optional argument of an environment containing variables renamed directly by macros. This would generally be an empty environment when using this function for macro debugging.
+

docs/api/scheme/write.md

@@ -29,7 +29,12 @@ Write object to the given output port, or the current output if none is given. O
     (write-shared obj)
     (write-shared obj port)
 
+`write-shared` is the same as `write` because Cyclone does not support datum labels at this time.
+
 # write-simple
 
     (write-simple obj)
     (write-simple obj port)
+
+`write-simple` is the same as `write` because Cyclone does not support datum labels at this time.
+

docs/api/srfi/106.md

@@ -56,77 +56,348 @@ See the [SRFI document](http://srfi.schemers.org/srfi-106/srfi-106.html) for mor
 
 # make-client-socket
 
+    (make-client-socket node service [ai-family [ai-socktype [ai-flags [ai-protocol]]]]) -> socket
+
+Returns a client socket connected to an Internet address.
+The Internet address is identified by node and service. node and service must be string.
+Example value of node: `"localhost" "127.0.0.1"`
+Example value of service: `"http" "80"`
+The optional parameter may specify the created socket's behaviour.
+If the optional argument(s) is omitted, then following flags should be used as default:
+
+    ai-family
+      *af-inet*
+    ai-socktype
+      *sock-stream*
+    ai-flags
+      (socket-merge-flags *ai-v4mapped* *ai-addrconfig*)
+    ai-protocol
+      *ipproto-ip*
+
+The created socket may not be closed automatically so it is users' responsibility to close it explicitly.
+
 # make-server-socket
 
+    (make-server-socket service [ai-family [ai-socktype [ai-protocol]]]) -> socket
+
+Returns a server socket waiting for connection.
+The description of node argument is the same as make-client-socket.
+The optional parameter may specify the created socket's behaviour.
+
+If the optional argument(s) is omitted, then following flags should be used as default.
+
+    ai-family
+      *af-inet*
+    ai-socktype
+      *sock-stream*
+    ai-protocol
+      *ipproto-ip*
+
+The created socket may not be closed automatically so it is users' responsibility to close it explicitly.
+
 # socket?
 
+    (socket? object) -> boolean
+
+Returns `#t` if given `object` is socket object. Otherwise `#f`.
+
 # socket-accept
 
+    (socket-accept socket) -> socket
+
+Wait for an incoming connection request, and returns a fresh connected client socket.
+
 # socket-send
 
+    (socket-send socket bv [flags]) -> size
+
+Sends a binary data block to a socket and returns the sent data size.
+`flags` may specify the procedure's behaviour.
+
+If the `flags` is omitted, the default value must be the result of following form:
+
+    (message-type none)
+
 # socket-recv
 
+    (socket-recv socket size [flags]) -> bv
+
+Receives a binary data block from a socket. If zero length bytevector is returned, it means the peer connection is closed.
+`flags` may specify the procedure's behaviour.
+
+If the `flags` is omitted, the default value must be the result of following form:
+
+    (message-type none)
+
 # socket-shutdown
 
+    (socket-shutdown socket how) -> (unspecified)
+
+Shutdowns a socket.
+`how` must be one of the following constants:
+
+    *shut-rd*
+    *shut-wr*
+    *shut-rdwr*
+
 # socket-close
 
+    (socket-close socket) -> (unspecified)
+
+Closes a socket.
+The procedure does not shutdown the given socket. To shutdown a socket, socket-shutdown should be called explicitly.
+
 # socket-input-port
 
+    (socket-input-port socket) -> binary-input-port
+
+Returns a fresh binary input port associated with a socket, respectively.
+The port should not close underlying socket when it's closing.
+
 # socket-output-port
 
+    (socket-output-port socket) -> binary-output-port
+
+Returns a fresh binary output port associated with a socket, respectively.
+The port should not close underlying socket when it's closing.
+
 # call-with-socket
 
+    (call-with-socket socket proc) -> object
+
+Calls a given procedure with a given socket as an argument.
+
+If given `proc` returns then it returns the result of `proc` and socket will be automatically closed. If `proc` doesn't return then given socket won't be closed automatically. It's analogy of `call-with-port`.
+
 # address-family
 
+*Syntax*
+
+    (address-family name) -> address-family
+
+Returns proper address family from given name.
+
+    inet
+
+Returns `*af-inet*`
+
+    inet6
+
+Returns `*af-inet6*`
+
+    unspec
+
+Returns `*af-unspec*`
+
 # address-info 
 
+*Syntax*
+
+    (address-info names ...) -> address-info
+
+Returns merged address info flags from given names.
+
+    canoname
+
+Returns `*ai-canonname*`
+
+    numerichost
+
+Returns `*ai-numerichost*`
+
+    v4mapped
+
+Returns `*ai-v4mapped*`
+
+    all
+
+Returns `*ai-all*`
+
+    addrconfig
+
+Returns `*ai-addrconfig*`
+
 # socket-domain
 
+*Syntax*
+
+    (socket-domain name) -> socket-domain
+
+Returns socket domain flags from given name.
+
+    stream
+
+Returns `*sock-stream*`
+
+    datagram
+
+Returns `*sock-dgram*`
+
 # ip-protocol
 
+*Syntax*
+
+    (ip-protocol name) -> ip-protocol
+
+Returns ip-protocol flag from given name.
+
+   ip
+
+Returns `*ipproto-ip*`
+
+    tcp
+
+Returns `*ipproto-tcp*`
+
+    udp
+
+Returns `*ipproto-udp*`
+
 # message-type
 
+*Syntax*
+
+    (message-type names ...) -> message-type
+
+Returns message type flag from given name.
+
+The flag can be used both socket-recv and socket-send.
+
+    none
+
+Returns no flag.
+
+    peek
+
+Returns `*msg-peek*`
+
+    oob
+
+Returns `*msg-oob*`
+
+    wait-all
+
+Returns `*msg-waitall*`
+
 # shutdown-method
 
+*Syntax*
+
+    (shutdown-method names ...) -> shutdown-method
+
+Returns shutdown method flags from given names.
+
+    read
+
+Returns `*shut-rd*`
+
+    write
+
+Returns `*shut-wr*`
+
+If shutdown-method is given both read and write, then it must return `*shut-rdwr*`
+
 # socket-merge-flags
 
+    (socket-merge-flags flags ...) -> new-flags
+
+Merges given `flags` and returns a new flag.
+
 # socket-purge-flags
 
+    (socket-purge-flags base-flag flags ...) -> new-flags
+
+Removes `flags` from `base-flag` if exists and returns a new flag.
+
 # \*af-unspec\*
 
+This must behave the same as POSIX's `AF_UNSPEC`.
+
 # \*af-inet\*
 
+Internet domain sockets for use with IPv4 addresses.
+This must behave the same as POSIX's `AF_INET`.
+
 # \*af-inet6\*
 
+Internet domain sockets for use with IPv6 addresses.
+This must behave the same as POSIX's `AF_INET6`.
+
 # \*sock-stream\*
 
+Byte-stream socket.
+This must behave the same as POSIX's `SOCK_STREAM`.
+
 # \*sock-dgram\*
 
+Datagram socket.
+This must behave the same as POSIX's `SOCK_DGRAM`.
+
 # \*ai-canonname\*
 
+This must behave the same as POSIX's `AI_CANONNAME`.
+
 # \*ai-numerichost\*
 
+This must behave the same as POSIX's `AI_NUMERICHOST`.
+
 # \*ai-v4mapped\*
 
+This must behave the same as POSIX's `AI_V4MAPPED`.
+
 # \*ai-all\*
 
+This must behave the same as POSIX's `AI_ALL`.
+
 # \*ai-addrconfig\*
 
+This must behave the same as POSIX's `AI_ADDRCONFIG`.
+
 # \*ipproto-ip\*
 
+Internet protocol.
+This must behave the same as POSIX's `IPPROTO_IP`.
+
 # \*ipproto-tcp\*
 
+Transmission control protocol.
+This must behave the same as POSIX's `IPPROTO_TCP`.
+
 # \*ipproto-udp\*
 
+User datagram protocol.
+This must behave the same as POSIX's `IPPROTO_UDP`.
+
 # \*msg-peek\*
 
+For socket-recv.
+Peeks at an incoming message. The data is treated as unread and the next socket-recv shall still return this data.
+This must behave the same as `POSIX's MSG_PEEK`.
+
 # \*msg-oob\*
 
+For both `socket-recv` and `socket-send`.
+Requests/sends out-of-band data.
+This must behave the same as POSIX's `MSG_OOB`.
+
 # \*msg-waitall\*
 
+For socket-recv.
+On sockets created with `*sock-stream*` flag, this requests the procedure block until the full amount of data ban be returned.
+This must behave the same as POSIX's `MSG_WAITALL`.
+
 # \*shut-rd\*
 
+Disables further receive operation.
+This must behave the same as POSIX's `SHUT_RD`.
+
 # \*shut-wr\*
 
+Disables further send operations.
+This must behave the same as POSIX's `SHUT_WR`.
+
 # \*shut-rdwr\*
 
+Disables further send and receive operations.
+This must behave the same as POSIX's `SHUT_RDWR`.
+

docs/api/srfi/117.md

@@ -31,9 +31,6 @@ See the [SRFI document](http://srfi.schemers.org/srfi-117/srfi-117.html) for mor
 [`list-queue-append`](#list-queue-append)
 [`list-queue-append!`](#list-queue-append-1)
 [`list-queue-concatenate`](#list-queue-concatenate)
-[`list-queue-append`](#list-queue-append)
-[`list-queue-append!`](#list-queue-append-1)
-[`list-queue-concatenate`](#list-queue-concatenate)
 
 ## Mapping
 [`list-queue-map`](#list-queue-map)
@@ -42,53 +39,153 @@ See the [SRFI document](http://srfi.schemers.org/srfi-117/srfi-117.html) for mor
 
 # make-list-queue 
 
+    (make-list-queue list [ last ])
+
+Returns a newly allocated list queue containing the elements of `list` in order. The result shares storage with `list`. If the last argument is not provided, this operation is `O(n)` where n is the length of `list`.
+
+However, if last is provided, `make-list-queue` returns a newly allocated list queue containing the elements of the list whose first pair is `first` and whose last pair is `last`. It is an error if the pairs do not belong to the same list. Alternatively, both `first` and `last` can be the empty list. In either case, the operation is `O(1)`.
+
+Note: To apply a non-destructive list procedure to a list queue and return a new list queue, use `(make-list-queue (proc (list-queue-list list-queue)))`.
+
 # list-queue
 
+    (list-queue element ...)
+
+Returns a newly allocated list queue containing the elements. This operation is `O(n)` where `n` is the number of elements.
+
 # list-queue-copy
 
+    (list-queue-copy list-queue)
+
+Returns a newly allocated list queue containing the elements of list-queue. This operation is `O(n)` where `n` is the length of list-queue.
+
 # list-queue-unfold
 
+    (list-queue-unfold stop? mapper successor seed [ queue ])
+
+Performs the following algorithm:
+
+If the result of applying the predicate `stop?` to seed is true, return `queue`. Otherwise, apply the procedure `mapper` to `seed`, returning a value which is added to the front of `queue`. Then get a new seed by applying the procedure `successor` to `seed`, and repeat this algorithm.
+
+If `queue` is omitted, a newly allocated list queue is used.
+
 # list-queue-unfold-right
 
+    (list-queue-unfold-right stop? mapper successor seed [ queue ])
+
+Performs the following algorithm:
+
+If the result of applying the predicate `stop?` to `seed` is true, return the list queue. Otherwise, apply the procedure `mapper` to `seed`, returning a value which is added to the back of the list queue. Then get a new seed by applying the procedure successor to `seed`, and repeat this algorithm.
+
+If queue is omitted, a newly allocated list queue is used.
+
 # list-queue?
 
+    (list-queue? obj)
+
+Returns `#t` if `obj` is a list queue, and `#f` otherwise. This operation is `O(1)`.
+
 # list-queue-empty?
 
+    (list-queue-empty? list-queue)
+
+Returns `#t` if `list-queue` has no elements, and `#f` otherwise. This operation is `O(1)`.
+
 # list-queue-front
 
+    (list-queue-front list-queue)
+
+Returns the first element of `list-queue`. If the list queue is empty, it is an error. This operation is `O(1)`.
+
 # list-queue-back
 
+    (list-queue-back list-queue)
+
+Returns the last element of `list-queue`. If the list queue is empty, it is an error. This operation is `O(1)`.
+
 # list-queue-list
 
+    (list-queue-list list-queue)
+
+Returns the list that contains the members of `list-queue` in order. The result shares storage with `list-queue`. This operation is `O(1)`.
+
 # list-queue-first-last
 
+    (list-queue-first-last list-queue)
+
+Returns two values, the first and last pairs of the list that contains the members of `list-queue` in order. If `list-queue` is empty, returns two empty lists. The results share storage with `list-queue`. This operation is `O(1)`.
+
 # list-queue-add-front!
 
+    (list-queue-add-front! list-queue element)
+
+Adds element to the beginning of `list-queue`. Returns an unspecified value. This operation is `O(1)`.
+
 # list-queue-add-back!
 
+    (list-queue-add-back! list-queue element)
+
+Adds `element` to the end of `list-queue`. Returns an unspecified value. This operation is `O(1)`.
+
 # list-queue-remove-front!
 
+    (list-queue-remove-front! list-queue)
+
+Removes the first element of `list-queue` and returns it. If the list queue is empty, it is an error. This operation is `O(1)`.
+
 # list-queue-remove-back!
 
+    (list-queue-remove-back! list-queue)
+
+Removes the last element of `list-queue` and returns it. If the list queue is empty, it is an error. This operation is `O(n)` where `n` is the length of `list-queue`, because queues do not not have backward links.
+
 # list-queue-remove-all!
 
+    (list-queue-remove-all! list-queue)
+
+Removes all the elements of `list-queue` and returns them in order as a list. This operation is `O(1)`.
+
 # list-queue-set-list!
 
-# list-queue-append
+    (list-queue-set-list! list-queue list [ last ])
 
-# list-queue-append!
+Replaces the list associated with `list-queue` with `list`, effectively discarding all the elements of `list-queue` in favor of those in `list`. Returns an unspecified value. This operation is `O(n)` where `n` is the length of `list`. If `last` is provided, it is treated in the same way as in `make-list-queue`, and the operation is O(1).
 
-# list-queue-concatenate
+Note: To apply a destructive list procedure to a list queue, use `(list-queue-set-list! (proc (list-queue-list list-queue)))`.
 
 # list-queue-append
 
+    (list-queue-append list-queue ...)
+
+Returns a list queue which contains all the elements in front-to-back order from all the list-queues in front-to-back order. The result does not share storage with any of the arguments. This operation is `O(n)` in the total number of elements in all queues.
+
 # list-queue-append!
 
+    (list-queue-append! list-queue ...)
+
+Returns a list queue which contains all the elements in front-to-back order from all the list-queues in front-to-back order. It is an error to assume anything about the contents of the list-queues after the procedure returns. This operation is `O(n)` in the total number of queues, not elements. It is not part of the R7RS-small list API, but is included here for efficiency when pure functional append is not required.
+
 # list-queue-concatenate
 
+    (list-queue-concatenate list-of-list-queues)
+
+Returns a list queue which contains all the elements in front-to-back order from all the list queues which are members of list-of-list-queues in front-to-back order. The result does not share storage with any of the arguments. This operation is `O(n)` in the total number of elements in all queues. It is not part of the R7RS-small list API, but is included here to make appending a large number of queues possible in Schemes that limit the number of arguments to apply.
+
 # list-queue-map
 
+    (list-queue-map proc list-queue)
+
+Applies `proc` to each element of `list-queue` in unspecified order and returns a newly allocated list queue containing the results. This operation is `O(n)` where `n` is the length of `list-queue`.
+
 # list-queue-map!
 
+    (list-queue-map! proc list-queue)
+
+Applies proc to each element of `list-queue` in front-to-back order and modifies `list-queue` to contain the results. This operation is `O(n)` in the length of `list-queue`. It is not part of the R7RS-small list API, but is included here to make transformation of a list queue by mutation more efficient.
+
 # list-queue-for-each
 
+    (list-queue-for-each proc list-queue)
+
+Applies `proc` to each element of `list-queue` in front-to-back order, discarding the returned values. Returns an unspecified value. This operation is `O(n)` where `n` is the length of `list-queue`.
+

docs/api/srfi/128.md

@@ -4,9 +4,16 @@ The `(srfi 128)` provides comparators, which bundle a type test predicate, an eq
 
 See the [SRFI document](http://srfi.schemers.org/srfi-128/srfi-128.html) for more information.
 
+## Predicates
+
 - [`comparator?                   `](#comparator)
 - [`comparator-ordered?           `](#comparator-ordered)
 - [`comparator-hashable?          `](#comparator-hashable)
+
+## Constructors
+
+The following comparator constructors all supply appropriate type test predicates, equality predicates, ordering predicates, and hash functions based on the supplied arguments. They are allowed to cache their results: they need not return a newly allocated object, since comparators are pure and functional. In addition, the procedures in a comparator are likewise pure and functional.
+
 - [`make-comparator               `](#make-comparator)
 - [`make-pair-comparator          `](#make-pair-comparator)
 - [`make-list-comparator          `](#make-list-comparator)
@@ -14,6 +21,11 @@ See the [SRFI document](http://srfi.schemers.org/srfi-128/srfi-128.html) for mor
 - [`make-eq-comparator            `](#make-eq-comparator)
 - [`make-eqv-comparator           `](#make-eqv-comparator)
 - [`make-equal-comparator         `](#make-equal-comparator)
+
+## Standard Hash Functions
+
+These are hash functions for some standard Scheme types, suitable for passing to make-comparator. Users may write their own hash functions with the same signature. However, if programmers wish their hash functions to be backward compatible with the reference implementation of SRFI 69, they are advised to write their hash functions to accept a second argument and ignore it.
+
 - [`boolean-hash                  `](#boolean-hash)
 - [`char-hash                     `](#char-hash)
 - [`char-ci-hash                  `](#char-ci-hash)
@@ -21,9 +33,15 @@ See the [SRFI document](http://srfi.schemers.org/srfi-128/srfi-128.html) for mor
 - [`string-ci-hash                `](#string-ci-hash)
 - [`symbol-hash                   `](#symbol-hash)
 - [`number-hash                   `](#number-hash)
+
+## Default Comparators
+
 - [`make-default-comparator       `](#make-default-comparator)
 - [`default-hash                  `](#default-hash)
 - [`comparator-register-default!  `](#comparator-register-default)
+
+## Accessors and Invokers
+
 - [`comparator-type-test-predicate`](#comparator-type-test-predicate)
 - [`comparator-equality-predicate `](#comparator-equality-predicate)
 - [`comparator-ordering-predicate `](#comparator-ordering-predicate)
@@ -31,82 +49,308 @@ See the [SRFI document](http://srfi.schemers.org/srfi-128/srfi-128.html) for mor
 - [`comparator-test-type          `](#comparator-test-type)
 - [`comparator-check-type         `](#comparator-check-type)
 - [`comparator-hash               `](#comparator-hash)
+
+## Bounds and Salt
+
+The following macros allow the callers of hash functions to affect their behavior without interfering with the calling signature of a hash function, which accepts a single argument (the object to be hashed) and returns its hash value. They are provided as macros so that they may be implemented in different ways: as a global variable, a SRFI 39 or R7RS parameter, or an ordinary procedure, whatever is most efficient in a particular implementation.
+
 - [`hash-bound                    `](#hash-bound)
 - [`hash-salt                     `](#hash-salt)
+
+## Comparison Predicates
+
+These procedures are analogous to the number, character, and string comparison predicates of Scheme. They allow the convenient use of comparators to handle variable data types.
+
+These procedures apply the equality and ordering predicates of comparator to the objects as follows. If the specified relation returns `#t` for all `objecti` and `objectj` where `n` is the number of objects and `1 <= i < j <= n`, then the procedures return `#t`, but otherwise `#f`. Because the relations are transitive, it suffices to compare each object with its successor. The order in which the values are compared is unspecified.
+
 - [`=?                            `](#)
 - [`<?                            `](#-1)
 - [`>?                            `](#-2)
 - [`<=?                           `](#-3)
 - [`>=?                           `](#-4)
+
+## Syntax
+
 - [`comparator-if<=>              `](#comparator-if)
 
 # comparator?
 
+    (comparator? obj)
+
+Returns `#t` if `obj` is a comparator, and `#f` otherwise.
+
 # comparator-ordered?
 
+    (comparator-ordered? comparator)
+
+Returns `#t` if `comparator` has a supplied ordering predicate, and `#f` otherwise.
+
 # comparator-hashable?
 
+    (comparator-hashable? comparator)
+
+Returns `#t` if `comparator` has a supplied hash function, and `#f` otherwise.
+
 # make-comparator
 
+    (make-comparator type-test equality ordering hash)
+
+Returns a comparator which bundles the `type-test`, `equality`, `ordering`, and `hash` procedures provided. However, if `ordering` or `hash` is `#f`, a procedure is provided that signals an error on application. The predicates `comparator-ordered?` and/or `comparator-hashable?`, respectively, will return `#f` in these cases.
+
+Here are calls on `make-comparator` that will return useful comparators for standard Scheme types:
+
+* `(make-comparator boolean? boolean=? (lambda (x y) (and (not x) y)) boolean-hash)` will return a comparator for booleans, expressing the ordering `#f < #t` and the standard hash function for booleans.
+    
+* `(make-comparator real? = < (lambda (x) (exact (abs x))))` will return a comparator expressing the natural ordering of real numbers and a plausible (but not optimal) hash function.
+    
+* `(make-comparator string? string=? string<? string-hash)` will return a comparator expressing the implementation's ordering of strings and the standard hash function.
+    
+* `(make-comparator string? string-ci=? string-ci<? string-ci-hash)` will return a comparator expressing the implementation's case-insensitive ordering of strings and the standard case-insensitive hash function.
+
 # make-pair-comparator
 
+    (make-pair-comparator car-comparator cdr-comparator)
+
+This procedure returns comparators whose functions behave as follows.
+
+* The type test returns `#t` if its argument is a pair, if the car satisfies the type test predicate of car-comparator, and the cdr satisfies the type test predicate of cdr-comparator.
+
+* The equality function returns `#t` if the cars are equal according to car-comparator and the cdrs are equal according to cdr-comparator, and `#f` otherwise.
+
+* The ordering function first compares the cars of its pairs using the equality predicate of car-comparator. If they are not equal, then the ordering predicate of car-comparator is applied to the cars and its value is returned. Otherwise, the predicate compares the cdrs using the equality predicate of cdr-comparator. If they are not equal, then the ordering predicate of cdr-comparator is applied to the cdrs and its value is returned.
+
+* The hash function computes the hash values of the car and the cdr using the hash functions of car-comparator and cdr-comparator respectively and then hashes them together in an implementation-defined way.
+
 # make-list-comparator
 
+    (make-list-comparator element-comparator type-test empty? head tail)
+
+This procedure returns comparators whose functions behave as follows:
+
+* The type test returns `#t` if its argument satisfies type-test and the elements satisfy the type test predicate of element-comparator.
+
+* The total order defined by the equality and ordering functions is as follows (known as lexicographic order):
+
+  * The empty sequence, as determined by calling `empty?`, compares `equal` to itself.
+  * The empty sequence compares less than any non-empty sequence.
+  * Two non-empty sequences are compared by calling the head procedure on each. If the heads are not equal when compared using element-comparator, the result is the result of that comparison. Otherwise, the results of calling the tail procedure are compared recursively.
+
+* The hash function computes the hash values of the elements using the hash function of element-comparator and then hashes them together in an implementation-defined way.
+
 # make-vector-comparator
 
+    (make-vector-comparator element-comparator type-test length ref)
+
+This procedure returns comparators whose functions behave as follows:
+
+* The type test returns `#t` if its argument satisfies type-test and the elements satisfy the type test predicate of element-comparator.
+
+* The equality predicate returns `#t` if both of the following tests are satisfied in order: the lengths of the vectors are the same in the sense of `=`, and the elements of the vectors are the same in the sense of the equality predicate of element-comparator.
+
+* The ordering predicate returns `#t` if the results of applying length to the first vector is less than the result of applying `length` to the second vector. If the lengths are equal, then the elements are examined pairwise using the ordering predicate of element-comparator. If any pair of elements returns `#t`, then that is the result of the list comparator's ordering predicate; otherwise the result is `#f`.
+
+* The hash function computes the hash values of the elements using the hash function of element-comparator and then hashes them together in an implementation-defined way.
+
+Here is an example, which returns a comparator for byte vectors:
+
+    (make-vector-comparator
+      (make-comparator exact-integer? = < number-hash)
+      bytevector?
+      bytevector-length
+      bytevector-u8-ref)
+
 # make-eq-comparator
 
+    (make-eq-comparator)
+
 # make-eqv-comparator
 
+    (make-eqv-comparator)
+
 # make-equal-comparator
 
+    (make-equal-comparator)
+
+These procedures return comparators whose functions behave as follows:
+
+* The type test returns `#t` in all cases.
+
+* The equality functions are `eq?`, `eqv?`, and `equal?` respectively.
+
+* The ordering function is implementation-defined, except that it must conform to the rules for ordering functions. It may signal an error instead.
+
+* The hash function is default-hash.
+
+These comparators accept circular structure and `NaN`s.
+
 # boolean-hash
 
+    (boolean-hash obj)
+
 # char-hash
+    (char-hash obj)
 
 # char-ci-hash
 
+    (char-ci-hash obj)
+
 # string-hash
     
+    (string-hash obj)
+
 # string-ci-hash
+    (string-ci-hash obj)
     
 # symbol-hash
 
+    (symbol-hash obj)
+
 # number-hash
 
+    (number-hash obj)
+
+
 # make-default-comparator
 
+    (make-default-comparator)
+
+Returns a comparator known as a default comparator that accepts Scheme values and orders them in some implementation-defined way, subject to the following conditions:
+
+* Given disjoint types a and b, one of three conditions must hold:
+
+  * All objects of type a compare less than all objects of type b.
+  * All objects of type a compare greater than all objects of type b.
+  * All objects of both type a and type b compare equal to each other. This is not permitted for any of the Scheme types mentioned below.
+
+* The empty list must be ordered before all pairs.
+
+* When comparing booleans, it must use the total order `#f < #t`.
+
+* When comparing characters, it must use `char=?` and `char<?`.
+
+  Note: In R5RS, this is an implementation-dependent order that is typically the same as Unicode codepoint order; in R6RS and R7RS, it is Unicode codepoint order.
+
+* When comparing pairs, it must behave the same as a comparator returned by make-pair-comparator with default comparators as arguments.
+
+* When comparing symbols, it must use an implementation-dependent total order. One possibility is to use the order obtained by applying `symbol->string` to the symbols and comparing them using the total order implied by `string<?`.
+
+* When comparing bytevectors, it must behave the same as a comparator created by the expression `(make-vector-comparator (make-comparator bytevector? = < number-hash) bytevector? bytevector-length bytevector-u8-ref)`.
+
+* When comparing numbers where either number is complex, since non-real numbers cannot be compared with `<,` the following least-surprising ordering is defined: If the real parts are `<` or `>,` so are the numbers; otherwise, the numbers are ordered by their imaginary parts. This can still produce somewhat surprising results if one real part is exact and the other is inexact.
+
+* When comparing real numbers, it must use `=` and `<.`
+
+* When comparing strings, it must use `string=?` and `string<?`.
+
+  Note: In R5RS, this is lexicographic order on the implementation-dependent order defined by `char<?`; in R6RS it is lexicographic order on Unicode codepoint order; in R7RS it is an implementation-defined order.
+
+* When comparing vectors, it must behave the same as a comparator returned by `(make-vector-comparator (make-default-comparator) vector? vector-length vector-ref)`.
+
+* When comparing members of types registered with `comparator-register-default!`, it must behave in the same way as the comparator registered using that function.
+
+Default comparators use default-hash as their hash function.
+
 # default-hash
 
+    (default-hash obj)
+
+This is the hash function used by default comparators, which accepts a Scheme value and hashes it in some implementation-defined way, subject to the following conditions:
+
+* When applied to a pair, it must return the result of hashing together the values returned by `default-hash` when applied to the car and the cdr.
+
+* When applied to a boolean, character, string, symbol, or number, it must return the same result as `boolean-hash`, `char-hash`, `string-hash`, `symbol-hash`, or `number-hash` respectively.
+
+* When applied to a list or vector, it must return the result of hashing together the values returned by default-hash when applied to each of the elements.
+
 # comparator-register-default!
 
+    (comparator-register-default! comparator)
+
+Registers comparator for use by default comparators, such that if the objects being compared both satisfy the type test predicate of comparator, it will be employed by default comparators to compare them. Returns an unspecified value. It is an error if any value satisfies both the type test predicate of comparator and any of the following type test predicates: `boolean?`, `char?`, `null?`, `pair?`, `symbol?`, `bytevector?`, `number?`, `string?`, `vector?`, or the type test predicate of a comparator that has already been registered.
+
+This procedure is intended only to extend default comparators into territory that would otherwise be undefined, not to override their existing behavior. In general, the ordering of calls to comparator-register-default! should be irrelevant. However, implementations that support inheritance of record types may wish to ensure that default comparators always check subtypes before supertypes.
+
 # comparator-type-test-predicate
 
+    (comparator-type-test-predicate comparator)
+
 # comparator-equality-predicate
 
+    (comparator-equality-predicate comparator)
+
 # comparator-ordering-predicate
 
+    (comparator-ordering-predicate comparator)
+
 # comparator-hash-function
 
+    (comparator-hash-function comparator)
+
 # comparator-test-type
 
+    (comparator-test-type comparator obj)
+
+Invokes the type test predicate of comparator on `obj` and returns what it returns. More convenient than `comparator-type-test-predicate`, but less efficient when the predicate is called repeatedly.
+
 # comparator-check-type
 
+    (comparator-check-type comparator obj)
+
+Invokes the type test predicate of comparator on `obj` and returns true if it returns true, but signals an error otherwise. More convenient than `comparator-type-test-predicate`, but less efficient when the predicate is called repeatedly.
+
 # comparator-hash
 
+    (comparator-hash comparator obj)
+
+Invokes the hash function of comparator on `obj` and returns what it returns. More convenient than `comparator-hash-function`, but less efficient when the function is called repeatedly.
+
+Note: No invokers are required for the equality and ordering predicates, because `=?` and `<?` serve this function.
+
 # hash-bound
 
+*Syntax*
+
+    (hash-bound)
+
+Hash functions should be written so as to return a number between `0` and the largest reasonable number of elements (such as hash buckets) a data structure in the implementation might have. What that value is depends on the implementation. This value provides the current bound as a positive exact integer, typically for use by user-written hash functions. However, they are not required to bound their results in this way.
+
 # hash-salt
 
+*Syntax*
+
+    (hash-salt)
+
+A salt is random data in the form of a non-negative exact integer used as an additional input to a hash function in order to defend against dictionary attacks, or (when used in hash tables) against denial-of-service attacks that overcrowd certain hash buckets, increasing the amortized `O(1)` lookup time to `O(n)`. Salt can also be used to specify which of a family of hash functions should be used for purposes such as cuckoo hashing. This macro provides the current value of the salt, typically for use by user-written hash functions. However, they are not required to make use of the current salt.
+
+The initial value is implementation-dependent, but must be less than the value of `(hash-bound)`, and should be distinct for distinct runs of a program unless otherwise specified by the implementation. Implementations may provide a means to specify the salt value to be used by a particular invocation of a hash function.
+
 # =?
 
+    (=? comparator object1 object2 object3 ...)
+
 # <?
 
+    (<? comparator object1 object2 object3 ...)
+
 # >?
 
+    (>? comparator object1 object2 object3 ...)
+
 # <=?
 
+    (<=? comparator object1 object2 object3 ...)
+
 # >=?
 
+    (>=? comparator object1 object2 object3 ...)
+
 # comparator-if<=>
 
+*Syntax*
+
+    (comparator-if<=> [ <comparator> ] <object1> <object2> <less-than> <equal-to> <greater-than>)
+
+It is an error unless `<comparator>` evaluates to a comparator and `<object1>` and `<object2>` evaluate to objects that the comparator can handle. If the ordering predicate returns true when applied to the values of `<object1>` and `<object2>` in that order, then `<less-than>` is evaluated and its value returned. If the equality predicate returns true when applied in the same way, then `<equal-to>` is evaluated and its value returned. If neither returns true, `<greater-than>` is evaluated and its value returned.
+
+If `<comparator>` is omitted, a default comparator is used.
+

docs/api/srfi/132.md

@@ -4,58 +4,168 @@ The `(srfi 132)` library implements the the API for a full-featured sort toolkit
 
 See the [SRFI document](http://srfi.schemers.org/srfi-132/srfi-132.html) for more information.
 
-- [`list-sorted?`](#list-sorted)
-- [`vector-sorted?`](#vector-sorted)
-- [`list-merge`](#list-merge)
-- [`vector-merge`](#vector-merge)
-- [`list-sort`](#list-sort)
-- [`vector-sort`](#vector-sort)
-- [`list-stable-sort`](#list-stable-sort)
-- [`vector-stable-sort`](#vector-stable-sort)
-- [`list-merge!`](#list-merge-1)
-- [`vector-merge!`](#vector-merge-1)
-- [`list-sort!`](#list-sort-1)
-- [`vector-sort!`](#vector-sort-1)
-- [`list-stable-sort!`](#list-stable-sort)
-- [`vector-stable-sort!`](#vector-stable-sort)
-- [`list-delete-neighbor-dups`](#list-delete-neighbor-dups)
-- [`vector-delete-neighbor-dups`](#vector-delete-neighbor-dups)
 - [`list-delete-neighbor-dups!`](#list-delete-neighbor-dups-1)
+- [`list-delete-neighbor-dups`](#list-delete-neighbor-dups)
+- [`list-merge!`](#list-merge-1)
+- [`list-merge`](#list-merge)
+- [`list-sort!`](#list-sort-1)
+- [`list-sort`](#list-sort)
+- [`list-sorted?`](#list-sorted)
+- [`list-stable-sort!`](#list-stable-sort)
+- [`list-stable-sort`](#list-stable-sort)
 - [`vector-delete-neighbor-dups!`](#vector-delete-neighbor-dups-1)
-
+- [`vector-delete-neighbor-dups`](#vector-delete-neighbor-dups)
-# list-sorted?
+- [`vector-find-median`](#vector-find-median)
-
+- [`vector-find-median!`](#vector-find-median-1)
-# vector-sorted?
+- [`vector-merge!`](#vector-merge-1)
-
+- [`vector-merge`](#vector-merge)
-# list-merge
+- [`vector-select!`](#vector-select)
-
+- [`vector-separate!`](#vector-separate)
-# vector-merge
+- [`vector-sort!`](#vector-sort-1)
-
+- [`vector-sort`](#vector-sort)
-# list-sort
+- [`vector-sorted?`](#vector-sorted)
-
+- [`vector-stable-sort!`](#vector-stable-sort)
-# vector-sort
+- [`vector-stable-sort`](#vector-stable-sort)
-
-# list-stable-sort
-
-# vector-stable-sort
-
-# list-merge!
-
-# vector-merge!
-
-# list-sort!
-
-# vector-sort!
-
-# list-stable-sort!
-
-# vector-stable-sort!
 
 # list-delete-neighbor-dups
 
-# vector-delete-neighbor-dups
+    (list-delete-neighbor-dups = lis)
+
+This procedure does not alter its input list, but its result may share storage with the input list.
 
 # list-delete-neighbor-dups!
 
+    (list-delete-neighbor-dups! = lis)
+
+This procedure mutates its input list in order to construct its result. It makes only a single, iterative, linear-time pass over its argument, using set-cdr!s to rearrange the cells of the list into the final result — it works "in place." Hence, any cons cell appearing in the result must have originally appeared in the input.
+
+# list-merge
+
+    (list-merge < lis1 lis2)
+
+This procedure does not alter its inputs, and is allowed to return a value that shares a common tail with a list argument.
+
+All four merge operations are stable: an element of the initial list `lis1` or vector `v1` will come before an equal-comparing element in the second list `lis2` or vector `v2` in the result.
+
+# list-merge!
+
+    (list-merge! < lis1 lis2)
+
+This procedure makes only a single, iterative, linear-time pass over its argument lists, using `set-cdr!`s to rearrange the cells of the lists into the list that is returned — it works "in place." Hence, any cons cell appearing in the result must have originally appeared in an input. It returns the sorted input.
+
+Additionally, `list-merge!` is iterative, not recursive — it can operate on arguments of arbitrary size without requiring an unbounded amount of stack space. The intent of this iterative-algorithm commitment is to allow the programmer to be sure that if, for example, `list-merge!` is asked to merge two ten-million-element lists, the operation will complete without performing some extremely (possibly twenty-million) deep recursion.
+
+All four merge operations are stable: an element of the initial list `lis1` or vector `v1` will come before an equal-comparing element in the second list `lis2` or vector `v2` in the result.
+
+# list-sort
+
+    (list-sort < lis)
+
+This procedure provides basic sorting.
+
+# list-sort!
+
+    (list-sort! < lis)
+
+This procedure is a linear update operator and is allowed to alter the cons cells of the arguments to produce its results. A sorted list containing the same elements as `lis` is returned.
+
+# list-sorted?
+
+    (list-sorted? < lis)
+
+Returns true iff the input list is in sorted order, as determined by `<`. Specifically, return `#f` iff there is an adjacent pair `... X Y ...` in the input list such that `Y < X` in the sense of `<`.
+
+# list-stable-sort
+
+    (list-stable-sort < lis)
+
+Provides a stable sort.
+
+# list-stable-sort!
+
+    (list-stable-sort! < lis)
+
+This procedure is a linear update operator and is allowed to alter the cons cells of the arguments to produce its results. A sorted list containing the same elements as `lis` is returned.
+
+# vector-delete-neighbor-dups
+
+    (vector-delete-neighbor-dups = v [ start [ end ] ])
+
+This procedure does not alter its input vector, but rather newly allocates and returns a vector to hold the result.
+
 # vector-delete-neighbor-dups!
 
+    (vector-delete-neighbor-dups! = v [ start [ end ] ])
+
+This procedure reuses its input vector to hold the answer, packing it into the index range [start, newend), where newend is the non-negative exact integer that is returned as its value. The vector is not altered outside the range [start, newend).
+
+# vector-find-median
+
+    (vector-find-median < v knil [ mean ])
+
+This procedure does not alter its input vector, but rather newly allocates a vector to hold the intermediate result. Runs in O(n) time.
+
+# vector-find-median!
+
+    (vector-find-median! < v knil [ mean ])
+
+This procedure reuses its input vector to hold the intermediate result, leaving it sorted, but is otherwise the same as vector-find-median. Runs in O(n ln n) time.
+
+# vector-merge
+
+    (vector-merge < v1 v2 [ start1 [ end1 [ start2 [ end2 ] ] ] ])
+
+This procedure does not alter its inputs, and returns a newly allocated vector of length `(end1 - start1) + (end2 - start2)`.
+
+All four merge operations are stable: an element of the initial list `lis1` or vector `v1` will come before an equal-comparing element in the second list `lis2` or vector `v2` in the result.
+
+# vector-merge!
+
+    (vector-merge! < to from1 from2 [ start [ start1 [ end1 [ start2 [ end2 ] ] ] ] ])
+
+This procedure writes its result into vector `to`, beginning at index `start`, for indices less than `end`, which is defined as `start + (end1 - start1) + (end2 - start2)`. The target subvector `to[start, end)` may not overlap either of the source subvectors `from1[start1, end1]` and `from2[start2, end2]`. It returns an unspecified value.
+
+All four merge operations are stable: an element of the initial list `lis1` or vector `v1` will come before an equal-comparing element in the second list `lis2` or vector `v2` in the result.
+
+# vector-select!
+
+    (vector-select! < v k [ start [ end ] ] )
+
+This procedure returns the `k`th smallest element (in the sense of the `<` argument) of the region of a vector between `start` and `end`. Elements within the range may be reordered, whereas those outside the range are left alone. Runs in `O(n)` time.
+
+# vector-separate!
+
+    (vector-separate! < v k [ start [ end ] ] )
+
+This procedure places the smallest `k` elements (in the sense of the `<` argument) of the region of a vector between `start` and `end` into the first `k` positions of that range, and the remaining elements into the remaining positions. Otherwise, the elements are not in any particular order. Elements outside the range are left alone. Runs in `O(n)` time. Returns an unspecified value.
+
+# vector-sort
+
+    (vector-sort < v [ start [ end ] ])
+
+This procedure does not alter its inputs, but allocates a fresh vector as the result, of length `end - start`.
+
+# vector-sort!
+
+    (vector-sort! < v [ start [ end ] ])
+
+Sort the data in-place and return an unspecified value.
+
+# vector-sorted?
+
+    (vector-sorted? < v [start [ end ] ])
+
+Returns true iff the input vector is in sorted order, as determined by `<`. Specifically, return `#f` iff there is an adjacent pair `... X Y ...` in the input vector such that `Y < X` in the sense of `<`. The optional `start` and `end` range arguments restrict `vector-sorted?` to examining the indicated subvector.
+
+# vector-stable-sort
+
+    (vector-stable-sort < v [ start [ end ] ])
+
+This procedure does not alter its inputs, but allocates a fresh vector as the result, of length `end - start`.
+
+# vector-stable-sort!
+
+    (vector-stable-sort! < v [ start [ end ] ])
+
+Sorts the data in-place. (But note that `vector-stable-sort!` may allocate temporary storage proportional to the size of the input — there are no known `O(n lg n)` stable vector sorting algorithms that run in constant space.) Returns an unspecified value.
+

docs/api/srfi/133.md

@@ -1,4 +1,4 @@
-# SRFI 133 - Sort Libraries
+# SRFI 133 - Vector Library
 
 The `(srfi 133)` provides a vector library.
 
@@ -45,55 +45,316 @@ See the [SRFI document](http://srfi.schemers.org/srfi-133/srfi-133.html) for mor
 
 # vector-unfold
 
+    (vector-unfold f length initial-seed ...) -> vector
+
+The fundamental vector constructor. Creates a vector whose length is `length` and iterates across each index `k` between `0` and `length`, applying `f` at each iteration to the current index and current seeds, in that order, to receive n + 1 values: first, the element to put in the kth slot of the new vector and n new seeds for the next iteration. It is an error for the number of seeds to vary between iterations. Note that the termination condition is different from the `unfold` procedure of SRFI 1.
+
+Examples:
+
+    (vector-unfold (λ (i x) (values x (- x 1)))
+                     10 0)
+    #(0 -1 -2 -3 -4 -5 -6 -7 -8 -9)
+    
+Construct a vector of the sequence of integers in the range [0,n).
+
+    (vector-unfold values n)
+    #(0 1 2 ... n-2 n-1)
+
+Copy vector.
+
+    (vector-unfold (λ (i) (vector-ref vector i))
+                     (vector-length vector))
+
 # vector-unfold-right
 
+    (vector-unfold-right f length initial-seed ...) -> vector
+
+Like `vector-unfold`, but it uses `f` to generate elements from right-to-left, rather than left-to-right. The first `index` used is `length - 1`. Note that the termination condition is different from the `unfold-right` procedure of SRFI 1.
+
+Examples:
+
+Construct a vector of pairs of non-negative integers whose values sum to 4.
+
+    (vector-unfold-right (λ (i x) (values (cons i x) (+ x 1))) 5 0)
+    #((0 . 4) (1 . 3) (2 . 2) (3 . 1) (4 . 0))
+
+Reverse vector.
+
+    (vector-unfold-right (λ (i x) (values (vector-ref vector x) (+ x 1)))
+                           (vector-length vector)
+                           0)
+
+
 # vector-reverse-copy
 
+    (vector-reverse-copy vec [start [end]]) -> vector
+
+Like `vector-copy`, but it copies the elements in the reverse order from `vec`.
+
+Example:
+
+    (vector-reverse-copy '#(5 4 3 2 1 0) 1 5)
+    #(1 2 3 4)
+
 # vector-concatenate
 
+    (vector-concatenate list-of-vectors) -> vector
+
+Appends each vector in `list-of-vectors`. This is equivalent to:
+
+    (apply vector-append list-of-vectors)
+
+However, it may be implemented better.
+
+Example:
+
+    (vector-concatenate '(#(a b) #(c d)))
+    #(a b c d)
+
 # vector-append-subvectors
 
+    (vector-append-subvectors [vec start end] ...) -> vector
+
+Returns a vector that contains every element of each `vec` from `start` to `end` in the specified order. This procedure is a generalization of `vector-append`.
+
+Example:
+
+    (vector-append-subvectors '#(a b c d e) 0 2 '#(f g h i j) 2 4)
+    #(a b h i)
+
 # vector-empty?
 
+    (vector-empty? vec) -> boolean
+
+Returns `#t` if `vec` is empty, i.e. its length is `0`, and `#f` if not.
+
 # vector=
 
+    (vector= elt=? vec ...) -> boolean
+
+Vector structure comparator, generalized across user-specified element comparators. Vectors `a` and `b` are considered equal by `vector=` iff their lengths are the same, and for each respective element `Ea` and `Eb`, `(elt=? Ea Eb)` returns a true value. `Elt=?` is always applied to two arguments.
+
+If there are only zero or one vector arguments, `#t` is automatically returned. The dynamic order in which comparisons of elements and of vectors are performed is left completely unspecified; do not rely on a particular order.
+
+Examples:
+
+    (vector= eq? '#(a b c d) '#(a b c d))
+    #t
+    
+    (vector= eq? '#(a b c d) '#(a b d c))
+    #f
+    
+    (vector= = '#(1 2 3 4 5) '#(1 2 3 4))
+    #f
+    
+    (vector= = '#(1 2 3 4) '#(1 2 3 4))
+    #t
+
+The two trivial cases.
+
+    (vector= eq?)
+    #t
+    
+    (vector= eq? '#(a))
+    #t
+
+Note the fact that we don't use vector literals in the next two. It is unspecified whether or not literal vectors with the same external representation are `eq?`.
+
+    (vector= eq? (vector (vector 'a)) (vector (vector 'a)))
+    #f
+    
+    (vector= equal? (vector (vector 'a)) (vector (vector 'a)))
+    #t
+
 # vector-fold
 
+    (vector-fold kons knil vec1 vec2 ...) -> value
+
+The fundamental vector iterator. `Kons` is iterated over each value in all of the vectors, stopping at the end of the shortest; `kons` is applied as `(kons state (vector-ref vec1 i) (vector-ref vec2 i) ...)` where `state` is the current state value. The current state value begins with `knil`, and becomes whatever `kons` returned on the previous iteration, and `i` is the current index.
+
+The iteration is strictly left-to-right.
+
+Examples:
+
+Find the longest string's length in `vector-of-strings`.
+
+    (vector-fold (λ (len str) (max (string-length str) len))
+                   0 vector-of-strings)
+
+Produce a list of the reversed elements of `vec`.
+
+    (vector-fold (λ (tail elt) (cons elt tail))
+                   '() vec)
+
+Count the number of even numbers in `vec`.
+
+    (vector-fold (λ (counter n)
+                     (if (even? n) (+ counter 1) counter))
+                   0 vec)
+
 # vector-fold-right
 
+    (vector-fold-right kons knil vec1 vec2 ...) -> value
+
+Similar to `vector-fold`, but it iterates right to left instead of left to right.
+
+Example:
+
+Convert a vector to a list.
+
+    (vector-fold-right (λ (tail elt) (cons elt tail))
+                    '() '#(a b c d))
+    (a b c d)
+
 # vector-map!
 
+    (vector-map! f vec1 vec2 ...) -> unspecified
+
+Similar to `vector-map`, but rather than mapping the new elements into a new vector, the new mapped elements are destructively inserted into `vec1`. Again, the dynamic order of application of `f` is unspecified, so it is dangerous for `f` to apply either `vector-ref` or `vector-set!` to `vec1` in `f`.
+
 # vector-count
 
+    (vector-count pred? vec1 vec2 ...) -> exact nonnegative integer
+
+Counts the number of parallel elements in the vectors that satisfy `pred?`, which is applied, for each index `i` in the range [0, length) where `length` is the length of the smallest vector argument, to each parallel element in the vectors, in order.
+
+Examples:
+
+    (vector-count even? '#(3 1 4 1 5 9 2 5 6))
+    3
+
+    (vector-count < '#(1 3 6 9) '#(2 4 6 8 10 12))
+    2
+
 # vector-cumulate
 
+    (vector-cumulate f knil vec) -> vector
+
+Returns a newly allocated vector `new` with the same length as `vec`. Each element `i` of `new` is set to the result of invoking `f` on `newi-1` and `veci`, except that for the first call on `f`, the first argument is `knil`. The new vector is returned.
+
+Example:
+
+    (vector-cumulate + 0 '#(3 1 4 1 5 9 2 5 6))
+    #(3 4 8 9 14 23 25 30 36)
+
 # vector-index
 
+    (vector-index pred? vec1 vec2 ...) -> exact nonnegative integer or #f
+
+Finds & returns the index of the first elements in `vec1 vec2 ...` that satisfy `pred?`. If no matching element is found by the end of the shortest vector, `#f` is returned.
+
+Examples:
+
+    (vector-index even? '#(3 1 4 1 5 9))
+    2
+
+    (vector-index < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))
+    1
+
+    (vector-index = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))
+    #f
+
 # vector-index-right
 
+    (vector-index-right pred? vec1 vec2 ...) -> exact nonnegative integer or #f
+
+Like `vector-index`, but it searches right-to-left, rather than left-to-right, and all of the vectors must have the same length.
+
 # vector-skip
 
+    (vector-skip pred? vec1 vec2 ...) -> exact nonnegative integer or #f
+
+Finds & returns the index of the first elements in `vec1 vec2 ...` that do not satisfy `pred?`. If all the values in the vectors satisfy `pred?` until the end of the shortest vector, this returns `#f`. This is equivalent to:
+
+    (vector-index (λ (x1 x2 ...) (not (pred? x1 x1 ...)))
+                        vec1 vec2 ...)
+
+Example:
+
+    (vector-skip number? '#(1 2 a b 3 4 c d))
+    2
+
 # vector-skip-right 
 
+    (vector-skip-right pred? vec1 vec2 ...) -> exact nonnegative integer or #f
+
+Like `vector-skip`, but it searches for a non-matching element right-to-left, rather than left-to-right, and it is an error if all of the vectors do not have the same length. This is equivalent to:
+
+    (vector-index-right (λ (x1 x2 ...) (not (pred? x1 x1 ...)))
+                             vec1 vec2 ...)
+
 # vector-binary-search
 
+    (vector-binary-search vec value cmp) -> exact nonnegative integer or #f
+
+Similar to `vector-index` and `vector-index-right`, but instead of searching left to right or right to left, this performs a binary search. If there is more than one element of `vec` that matches value in the sense of `cmp`, `vector-binary-search` may return the index of any of them.
+
+`cmp` should be a procedure of two arguments and return a negative integer, which indicates that its first argument is less than its second, zero, which indicates that they are equal, or a positive integer, which indicates that the first argument is greater than the second argument. An example `cmp` might be:
+
+    (lambdaλ (char1 char2)
+            (cond ((char<? char1 char2) -1)
+                    ((char=? char1 char2) 0)
+                            (else 1)))
+
 # vector-any
 
+    (vector-any pred? vec1 vec2 ...) -> value or #f
+
+Finds the first set of elements in parallel from `vec1 vec2 ...` for which `pred?` returns a true value. If such a parallel set of elements exists, `vector-any` returns the value that `pred?` returned for that set of elements. The iteration is strictly left-to-right.
+
 # vector-every
 
+    (vector-every pred? vec1 vec2 ...) -> value or #f
+
+If, for every index `i` between `0` and the length of the shortest vector argument, the set of elements `(vector-ref vec1 i) (vector-ref vec2 i) ...` satisfies `pred?`, `vector-every` returns the value that `pred?` returned for the last set of elements, at the last index of the shortest vector. The iteration is strictly left-to-right.
+
 # vector-partition
 
+    (vector-partition pred? vec) -> vector and integer
+
+A vector the same size as `vec` is newly allocated and filled with all the elements of `vec` that satisfy `pred?` in their original order followed by all the elements that do not satisfy `pred?`, also in their original order.
+
+Two values are returned, the newly allocated vector and the index of the leftmost element that does not satisfy `pred?`.
+
 # vector-swap!
 
+    (vector-swap! vec i j) -> unspecified
+
+Swaps or exchanges the values of the locations in `vec` at `i` & `j`.
+
 # vector-reverse! 
 
+    (vector-reverse! vec [start [end]]) -> unspecified
+
+Destructively reverses the contents of the sequence of locations in `vec` between `start` and `end`. Start defaults to `0` and `end` defaults to the length of `vec`. Note that this does not deeply reverse.
+
 # vector-reverse-copy!
 
+    (vector-reverse-copy! to at from [start [end]]) -> unspecified
+
+Like `vector-copy!`, but the elements appear in to in reverse order.
+
 # vector-unfold!
 
+    (vector-unfold! f vec start end initial-seed ...) -> unspecified
+
+Like `vector-unfold`, but the elements are copied into the vector `vec` starting at element `start` rather than into a newly allocated vector. Terminates when `end-start` elements have been generated.
+
 # vector-unfold-right!
 
+    (vector-unfold-right! f vec start end initial-seed ...) -> unspecified
+
+`Like `vector-unfold!`, but the elements are copied in reverse order into the vector `vec` starting at the index preceding `end`.
+
 # reverse-vector->list
 
+    (reverse-vector->list vec [start [end]]) -> proper-list
+
+Like `vector->list`, but the resulting list contains the elements in reverse of `vec`.
+
 # reverse-list->vector
 
+    (reverse-list->vector proper-list) -> vector
+
+Like `list->vector`, but the resulting vector contains the elements in reverse of `proper-list`.
+

docs/api/srfi/18.md

@@ -92,9 +92,9 @@ The current thread exits the running state as if its quantum had expired.
 
 # thread-terminate!
 
-    (thread-terminate!)
+    (thread-terminate! thread)
 
-Immediately abort the current thread.
+Immediately abort the given thread.
 
 # thread-join!
 

ffi.c

@@ -20,8 +20,11 @@ void *Cyc_init_thread(object thread_and_thunk, int argc, object *args);
  * for the call and perform a minor GC to ensure any returned object
  * is on the heap and safe to use.
  */
-static void Cyc_return_from_scm_call(gc_thread_data *thd, int argc, object k, object result)
+static void Cyc_return_from_scm_call(void *data, object _, int argc,
+                                     object * args)
 {
+  gc_thread_data *thd = data;
+  object result = args[0];
   // Cleaup thread object per Cyc_exit_thread
   gc_remove_mutator(thd);
   ck_pr_cas_int((int *)&(thd->thread_state), CYC_THREAD_STATE_RUNNABLE,
@@ -39,10 +42,13 @@ static void Cyc_return_from_scm_call(gc_thread_data *thd, int argc, object k, ob
  * We store results and longjmp back to where we started, at the
  * bottom of the trampoline (we only jump once).
  */
-static void Cyc_after_scm_call(gc_thread_data *thd, int argc, object k, object result)
+static void Cyc_after_scm_call(void *data, object _, int argc, object * args)
 {
+  gc_thread_data *thd = data;
+  object result = args[0];
   mclosure0(clo, Cyc_return_from_scm_call);
-  object buf[1]; buf[0] = result;
+  object buf[1];
+  buf[0] = result;
   GC(thd, &clo, buf, 1);
 }
 
@@ -54,7 +60,8 @@ static void Cyc_after_scm_call(gc_thread_data *thd, int argc, object k, object r
  * can do anything "normal" Scheme code does, and any returned
  * objects will be on the heap and available for use by the caller.
  */
-object Cyc_scm_call(gc_thread_data *parent_thd, object fnc, int argc, object *args)
+object Cyc_scm_call(gc_thread_data * parent_thd, object fnc, int argc,
+                    object * args)
 {
   jmp_buf l;
   gc_thread_data local;
@@ -101,8 +108,10 @@ object Cyc_scm_call(gc_thread_data *parent_thd, object fnc, int argc, object *ar
  * We store results and longjmp back to where we started, at the
  * bottom of the trampoline (we only jump once).
  */
-static void no_gc_after_call_scm(gc_thread_data *thd, int argc, object k, object result)
+static void no_gc_after_call_scm(gc_thread_data * thd, object _, int argc,
+                                 object * args)
 {
+  object result = args[0];
   thd->gc_cont = result;
   longjmp(*(thd->jmp_start), 1);
 }
@@ -113,7 +122,8 @@ static void no_gc_after_call_scm(gc_thread_data *thd, int argc, object k, object
 static void no_gc_call_scm(gc_thread_data * thd, object fnc, object obj)
 {
   mclosure0(after, (function_type) no_gc_after_call_scm);
-  ((closure)fnc)->fn(thd, 2, fnc, &after, obj);
+  object buf[2] = { &after, obj };
+  ((closure) fnc)->fn(thd, fnc, 2, buf);
 }
 
 /**

gc.c

@@ -28,18 +28,19 @@
 
 // 64-bit is 3, 32-bit is 2
 #define GC_BLOCK_BITS 5
-#define GC_BLOCK_SIZE (1 << GC_BLOCK_BITS)
 
 /* HEAP definitions, based off heap from Chibi scheme */
 #define gc_heap_first_block(h) ((object)(h->data + gc_heap_align(gc_free_chunk_size)))
-#define gc_heap_last_block(h) ((object)((char*)h->data + h->size - gc_heap_align(gc_free_chunk_size)))
 #define gc_heap_end(h) ((object)((char*)h->data + h->size))
 #define gc_heap_pad_size(s) (sizeof(struct gc_heap_t) + (s) + gc_heap_align(1))
 #define gc_free_chunk_size (sizeof(gc_free_list))
 
 #define gc_align(n, bits) (((n)+(1<<(bits))-1)&(((uintptr_t)-1)-((1<<(bits))-1)))
 
-//#define gc_word_align(n) gc_align((n), 2)
+// Align to 8 byte block size (EG: 8, 16, etc)
+#define gc_word_align(n) gc_align((n), 3)
+
+// Align on GC_BLOCK_BITS, currently block size of 32 bytes
 #define gc_heap_align(n) gc_align(n, GC_BLOCK_BITS)
 
 ////////////////////
@@ -54,6 +55,7 @@ static unsigned char gc_color_purple = 1;  // There are many "shades" of purple,
 
 static int gc_status_col = STATUS_SYNC1;
 static int gc_stage = STAGE_RESTING;
+static int gc_threads_merged = 0;
 
 // Does not need sync, only used by collector thread
 static void **mark_stack = NULL;
@@ -157,13 +159,17 @@ static void mark_buffer_free(mark_buffer *mb)
 const int NUM_ALLOC_SIZES = 10;
 static double allocated_size_counts[10] = {
   0, 0, 0, 0, 0,
-  0,0,0,0,0};
+  0, 0, 0, 0, 0
+};
+
 static double allocated_obj_counts[25] = {
   0, 0, 0, 0, 0,
   0, 0, 0, 0, 0,
   0, 0, 0, 0, 0,
   0, 0, 0, 0, 0,
-  0,0,0,0,0};
+  0, 0, 0, 0, 0
+};
+
 // TODO: allocated object sizes (EG: 32, 64, etc).
 static double allocated_heap_counts[4] = { 0, 0, 0, 0 };
 
@@ -370,7 +376,8 @@ void gc_free_old_thread_data()
  * @param gc_heap Root of the heap
  * @return Free space in bytes
  */
-uint64_t gc_heap_free_size(gc_heap *h) {
+uint64_t gc_heap_free_size(gc_heap * h)
+{
   uint64_t free_size = 0;
   for (; h; h = h->next) {
     if (h->is_unswept == 1) {   // Assume all free prior to sweep
@@ -493,13 +500,15 @@ void gc_print_fixed_size_free_list(gc_heap *h)
  * @brief Essentially this is half of the sweep code, for sweeping bump&pop
  * @param h Heap page to convert
  */
-static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd) 
+static size_t gc_convert_heap_page_to_free_list(gc_heap * h,
+                                                gc_thread_data * thd)
 {
   size_t freed = 0;
   object p;
   gc_free_list *next;
   int remaining = h->size - (h->size % h->block_size);
-  if (h->data_end == NULL) return 0; // Already converted
+  if (h->data_end == NULL)
+    return 0;                   // Already converted
 
   next = h->free_list = NULL;
   while (remaining > h->remaining) {
@@ -508,8 +517,7 @@ static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd)
     int color = mark(p);
 //    printf("found object %d color %d at %p with remaining=%lu\n", tag, color, p, remaining);
     // free space, add it to the free list
-    if (color != thd->gc_alloc_color &&
+    if (color != thd->gc_alloc_color && color != thd->gc_trace_color) { //gc_color_clear) 
-        color != thd->gc_trace_color) { //gc_color_clear) 
       // Run any finalizers
       if (type_of(p) == mutex_tag) {
 #if GC_DEBUG_VERBOSE
@@ -545,8 +553,7 @@ static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd)
       freed += h->block_size;
       if (next == NULL) {
         next = h->free_list = p;
-      }
+      } else {
-      else {
         next->next = p;
         next = next->next;
       }
@@ -561,8 +568,7 @@ static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd)
 //    printf("no object at %p fill with free list\n", p);
     if (next == NULL) {
       next = h->free_list = p;
-    }
+    } else {
-    else {
       next->next = p;           //(gc_free_list *)(((char *) next) + h->block_size);
       next = next->next;
     }
@@ -621,7 +627,8 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
     q = h->free_list;
     while (p < end) {
       // find preceding/succeeding free list pointers for p
-      for (r = (q?q->next:NULL); r && ((char *)r < (char *)p); q = r, r = r->next) ;
+      for (r = (q ? q->next : NULL); r && ((char *)r < (char *)p);
+           q = r, r = r->next) ;
       if ((char *)q == (char *)p || (char *)r == (char *)p) {   // this is a free block, skip it
         //printf("Sweep skip free block %p remaining=%lu\n", p, remaining);
         p = (object) (((char *)p) + h->block_size);
@@ -637,8 +644,7 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
         exit(1);
       }
 #endif
-      if (mark(p) != thd->gc_alloc_color && 
+      if (mark(p) != thd->gc_alloc_color && mark(p) != thd->gc_trace_color) {   //gc_color_clear) 
-          mark(p) != thd->gc_trace_color) { //gc_color_clear) 
 #if GC_DEBUG_VERBOSE
         fprintf(stderr, "sweep is freeing unmarked obj: %p with tag %d\n", p,
                 type_of(p));
@@ -737,7 +743,8 @@ gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page)
     return NULL;
   }
 #if GC_DEBUG_TRACE
-  fprintf(stderr, "DEBUG freeing heap type %d page at addr: %p\n", page->type, page);
+  fprintf(stderr, "DEBUG freeing heap type %d page at addr: %p\n", page->type,
+          page);
 #endif
 
   prev_page->next = page->next;
@@ -753,16 +760,19 @@ gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page)
 static int gc_is_heap_empty(gc_heap * h)
 {
   gc_free_list *f;
-  if (!h) return 0;
+  if (!h)
+    return 0;
 
   if (h->data_end) {            // Fixed-size bump&pop
     return (h->remaining == (h->size - (h->size % h->block_size)));
   }
 
-  if (!h->free_list) return 0;
+  if (!h->free_list)
+    return 0;
 
   f = h->free_list;
-  if (f->size != 0 || !f->next) return 0;
+  if (f->size != 0 || !f->next)
+    return 0;
 
   f = f->next;
   return (f->size + gc_heap_align(gc_free_chunk_size)) == h->size;
@@ -797,7 +807,8 @@ void gc_print_stats(gc_heap * h)
     heap_is_empty = gc_is_heap_empty(h);
     fprintf(stderr,
             "Heap type=%d, page size=%u, is empty=%d, used=%u, free=%u, free chunks=%u, min=%u, max=%u\n",
-            h->type, h->size, heap_is_empty, h->size - free, free, free_chunks, free_min, free_max);
+            h->type, h->size, heap_is_empty, h->size - free, free, free_chunks,
+            free_min, free_max);
   }
 }
 
@@ -826,7 +837,8 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
       hp->num_args = ((closureN) obj)->num_args;
       hp->num_elements = ((closureN) obj)->num_elements;
       hp->elements = (object *) (((char *)hp) + sizeof(closureN_type));
-      memcpy(hp->elements, ((closureN)obj)->elements, sizeof(object *) * hp->num_elements);
+      memcpy(hp->elements, ((closureN) obj)->elements,
+             sizeof(object *) * hp->num_elements);
       return (char *)hp;
     }
   case pair_tag:{
@@ -865,7 +877,8 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
       type_of(hp) = vector_tag;
       hp->num_elements = ((vector) obj)->num_elements;
       hp->elements = (object *) (((char *)hp) + sizeof(vector_type));
-      memcpy(hp->elements, ((vector)obj)->elements, sizeof(object *) * hp->num_elements);
+      memcpy(hp->elements, ((vector) obj)->elements,
+             sizeof(object *) * hp->num_elements);
       return (char *)hp;
     }
   case bytevector_tag:{
@@ -1048,8 +1061,7 @@ gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data *thd)
       new_size = HEAP_SIZE;
     }
 #if GC_DEBUG_TRACE
-    fprintf(stderr, "Growing heap %d new page size = %zu\n", h->type,
+    fprintf(stderr, "Growing heap %d new page size = %zu\n", h->type, new_size);
-            new_size);
 #endif
   }
   h_last = gc_heap_last(h_last);        // Ensure we don't unlink any heaps
@@ -1073,8 +1085,7 @@ gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data *thd)
  * This function will fail if there is no space on the heap for the 
  * requested object.
  */
-void *gc_try_alloc(gc_heap * h, size_t size, char *obj,
+void *gc_try_alloc(gc_heap * h, size_t size, char *obj, gc_thread_data * thd)
-                   gc_thread_data * thd)
 {
   gc_free_list *f1, *f2, *f3;
 
@@ -1127,7 +1138,8 @@ int gc_num_unswept_heaps(gc_heap *h)
   return count;
 }
 
-void gc_start_major_collection(gc_thread_data *thd){
+void gc_start_major_collection(gc_thread_data * thd)
+{
   if (ck_pr_load_int(&gc_stage) == STAGE_RESTING) {
 #if GC_DEBUG_TRACE
     gc_log(stderr, "gc_start_major_collection - initiating collector");
@@ -1136,7 +1148,8 @@ void gc_start_major_collection(gc_thread_data *thd){
   }
 }
 
-void *gc_try_alloc_slow(gc_heap *h_passed, gc_heap *h, size_t size, char *obj, gc_thread_data *thd)
+void *gc_try_alloc_slow(gc_heap * h_passed, gc_heap * h, size_t size, char *obj,
+                        gc_thread_data * thd)
 {
 #ifdef CYC_HIGH_RES_TIMERS
   long long tstamp = hrt_get_current();
@@ -1214,7 +1227,8 @@ hrt_log_delta("gc sweep", tstamp);
  * This function will fail if there is no space on the heap for the 
  * requested object.
  */
-static void *gc_try_alloc_fixed_size(gc_heap * h, size_t size, char *obj, gc_thread_data * thd)
+static void *gc_try_alloc_fixed_size(gc_heap * h, size_t size, char *obj,
+                                     gc_thread_data * thd)
 {
   void *result;
 
@@ -1244,7 +1258,8 @@ static void *gc_try_alloc_fixed_size(gc_heap * h, size_t size, char *obj, gc_thr
   return NULL;
 }
 
-void *gc_try_alloc_slow_fixed_size(gc_heap *h_passed, gc_heap *h, size_t size, char *obj, gc_thread_data *thd)
+void *gc_try_alloc_slow_fixed_size(gc_heap * h_passed, gc_heap * h, size_t size,
+                                   char *obj, gc_thread_data * thd)
 {
 #ifdef CYC_HIGH_RES_TIMERS
   long long tstamp = hrt_get_current();
@@ -1321,11 +1336,11 @@ void *gc_alloc_bignum(gc_thread_data *data)
   //tmp.hdr.mark = gc_color_red;
   //tmp.hdr.grayed = 0;
   tmp.tag = bignum_tag;
-  bn = gc_alloc(((gc_thread_data *)data)->heap, sizeof(bignum_type), (char *)(&tmp), (gc_thread_data *)data, &heap_grown);
+  bn = gc_alloc(((gc_thread_data *) data)->heap, sizeof(bignum_type),
+                (char *)(&tmp), (gc_thread_data *) data, &heap_grown);
 
   if ((result = mp_init(&bignum_value(bn))) != MP_OKAY) {
-     fprintf(stderr, "Error initializing number %s",
+    fprintf(stderr, "Error initializing number %s", mp_error_to_string(result));
-                     mp_error_to_string(result));
     exit(1);
   }
   return bn;
@@ -1340,10 +1355,10 @@ void *gc_alloc_bignum(gc_thread_data *data)
 void *gc_alloc_from_bignum(gc_thread_data * data, bignum_type * src)
 {
   int heap_grown;
-  return gc_alloc(((gc_thread_data *)data)->heap, sizeof(bignum_type), (char *)(src), (gc_thread_data *)data, &heap_grown);
+  return gc_alloc(((gc_thread_data *) data)->heap, sizeof(bignum_type),
+                  (char *)(src), (gc_thread_data *) data, &heap_grown);
 }
 
-
 /**
  * @brief Allocate memory on the heap for an object
  * @param hrt   The root of the heap to allocate from
@@ -1364,33 +1379,13 @@ void *gc_alloc(gc_heap_root * hrt, size_t size, char *obj, gc_thread_data * thd,
   gc_heap *h_passed, *h = NULL;
   int heap_type;
   void *(*try_alloc)(gc_heap * h, size_t size, char *obj, gc_thread_data * thd);
-  void *(*try_alloc_slow)(gc_heap *h_passed, gc_heap *h, size_t size, char *obj, gc_thread_data *thd);
+  void *(*try_alloc_slow)(gc_heap * h_passed, gc_heap * h, size_t size,
+                          char *obj, gc_thread_data * thd);
   size = gc_heap_align(size);
-  if (size <= 32) {
+  if (size <= (32 * (LAST_FIXED_SIZE_HEAP_TYPE + 1))) {
-    heap_type = HEAP_SM;
+    heap_type = (size - 1) / 32;
-    //try_alloc = &gc_try_alloc;
-    //try_alloc_slow = &gc_try_alloc_slow;
-    // TODO:
     try_alloc = &gc_try_alloc_fixed_size;
     try_alloc_slow = &gc_try_alloc_slow_fixed_size;
-  } else if (size <= 64) {
-    heap_type = HEAP_64;
-    //try_alloc = &gc_try_alloc;
-    //try_alloc_slow = &gc_try_alloc_slow;
-    // TODO:
-    try_alloc = &gc_try_alloc_fixed_size;
-    try_alloc_slow = &gc_try_alloc_slow_fixed_size;
-// Only use this heap on 64-bit platforms, where larger objs are used more often
-// Code from http://stackoverflow.com/a/32717129/101258
-#if INTPTR_MAX == INT64_MAX
-  } else if (size <= 96) {
-    heap_type = HEAP_96;
-    //try_alloc = &gc_try_alloc;
-    //try_alloc_slow = &gc_try_alloc_slow;
-    // TODO:
-    try_alloc = &gc_try_alloc_fixed_size;
-    try_alloc_slow = &gc_try_alloc_slow_fixed_size;
-#endif
   } else if (size >= MAX_STACK_OBJ) {
     heap_type = HEAP_HUGE;
     try_alloc = &gc_try_alloc;
@@ -1424,14 +1419,8 @@ fprintf(stderr, "slow alloc of %p\n", result);
     if (result) {
       // Check if we need to start a major collection
       if (heap_type != HEAP_HUGE &&
-        (//(try_alloc == &gc_try_alloc_fixed_size && // Fixed-size object heap
+          (h_passed->num_unswept_children <
-         // h_passed->num_unswept_children < (GC_COLLECT_UNDER_UNSWEPT_HEAP_COUNT * 128)) ||
+           GC_COLLECT_UNDER_UNSWEPT_HEAP_COUNT)) {
-         h_passed->num_unswept_children < GC_COLLECT_UNDER_UNSWEPT_HEAP_COUNT)) {
-//           gc_num_unswept_heaps(h_passed) < GC_COLLECT_UNDER_UNSWEPT_HEAP_COUNT)){
-//        printf("major collection heap_type = %d h->num_unswept = %d, computed = %d\n", heap_type,  h_passed->num_unswept_children, gc_num_unswept_heaps(h_passed));
-        //if (h_passed->num_unswept_children != gc_num_unswept_heaps(h_passed)) {
-        //  printf("ERROR, counts do not match!\n");
-        //}
         gc_start_major_collection(thd);
       }
     } else {
@@ -1447,9 +1436,16 @@ fprintf(stderr, "slowest alloc of %p\n", result);
 #endif
       if (result) {
         // We had to allocate memory, start a major collection ASAP!
-        if (heap_type != HEAP_HUGE) {
+        //
+        // Huge heaps are a special case because we always allocate a new page
+        // for them. However, we still initiate a collection for them, giving
+        // us a convenient way to handle short-lived HUGE objects. In practice
+        // this makes a BIG difference in memory usage for the array1 benchmark.
+        // Longer-term there may be a better way to deal with huge objects.
+        //
+        //if (heap_type != HEAP_HUGE) {
         gc_start_major_collection(thd);
-        }
+        //}
       } else {
         fprintf(stderr, "out of memory error allocating %zu bytes\n", size);
         fprintf(stderr, "Heap type %d diagnostics:\n", heap_type);
@@ -1464,8 +1460,9 @@ fprintf(stderr, "slowest alloc of %p\n", result);
 #endif
 
 #if GC_DEBUG_VERBOSE
-  fprintf(stderr, "alloc %p size = %zu, obj=%p, tag=%d, mark=%d, thd->alloc=%d, thd->trace=%d\n", result,
+  fprintf(stderr,
-          size, obj, type_of(obj), mark(((object) result)),
+          "alloc %p size = %zu, obj=%p, tag=%d, mark=%d, thd->alloc=%d, thd->trace=%d\n",
+          result, size, obj, type_of(obj), mark(((object) result)),
           thd->gc_alloc_color, thd->gc_trace_color);
   // Debug check, should no longer be necessary
   //if (is_value_type(result)) {
@@ -1661,13 +1658,11 @@ gc_heap *gc_sweep(gc_heap * h, gc_thread_data *thd)
     //   have the trace/clear color. We need to keep any of those to make sure
     //   the collector has a chance to trace the entire heap.
     if (                        //mark(p) != markColor &&
-          mark(p) != thd->gc_alloc_color && 
+         mark(p) != thd->gc_alloc_color && mark(p) != thd->gc_trace_color) {    //gc_color_clear) 
-          mark(p) != thd->gc_trace_color) { //gc_color_clear) 
 #if GC_DEBUG_VERBOSE
-        fprintf(stderr, "sweep is freeing unmarked obj: %p with tag %d mark %d - alloc color %d trace color %d\n", p,
+      fprintf(stderr,
-                type_of(p),
+              "sweep is freeing unmarked obj: %p with tag %d mark %d - alloc color %d trace color %d\n",
-                mark(p),
+              p, type_of(p), mark(p), thd->gc_alloc_color, thd->gc_trace_color);
-                thd->gc_alloc_color, thd->gc_trace_color);
 #endif
       //mark(p) = gc_color_blue;        // Needed?
       if (type_of(p) == mutex_tag) {
@@ -1861,9 +1856,13 @@ static void mark_stack_or_heap_obj(gc_thread_data * thd, object obj, int locked)
     grayed(obj) = 1;
   } else {
     // Value is on the heap, mark gray right now
-    if (!locked) { pthread_mutex_lock(&(thd->lock)); }
+    if (!locked) {
+      pthread_mutex_lock(&(thd->lock));
+    }
     gc_mark_gray(thd, obj);
-    if (!locked) { pthread_mutex_unlock(&(thd->lock)); }
+    if (!locked) {
+      pthread_mutex_unlock(&(thd->lock));
+    }
   }
 }
 
@@ -1903,6 +1902,38 @@ void gc_mut_update(gc_thread_data * thd, object old_obj, object value)
   }
 }
 
+static void gc_sweep_primordial_thread_heap()
+{
+  int heap_type, must_free;
+  gc_heap *h, *prev, *next, *sweep;
+  pthread_mutex_lock(&(primordial_thread->lock));
+  for (heap_type = 0; heap_type < NUM_HEAP_TYPES; heap_type++) {
+    prev = primordial_thread->heap->heap[heap_type];
+    h = prev->next;
+    while (h != NULL) {
+      next = h->next;
+      must_free = 0;
+      if (h->is_unswept) {
+        if (h->type <= LAST_FIXED_SIZE_HEAP_TYPE) {
+          sweep = gc_sweep_fixed_size(h, primordial_thread);
+        } else {
+          sweep = gc_sweep(h, primordial_thread);
+        }
+        must_free = (sweep == NULL);
+      } else {
+        must_free = gc_is_heap_empty(h);
+      }
+      if (must_free) {
+        gc_heap_free(h, prev);
+      } else {
+        prev = h;
+      }
+      h = next;
+    }
+  }
+  pthread_mutex_unlock(&(primordial_thread->lock));
+}
+
 /**
  * @brief Called by a mutator to cooperate with the collector thread
  * @param thd Mutator's thread data
@@ -1913,11 +1944,23 @@ void gc_mut_update(gc_thread_data * thd, object old_obj, object value)
  */
 void gc_mut_cooperate(gc_thread_data * thd, int buf_len)
 {
-  int i, status_c, status_m;
+  int i, status_c, status_m, stage, merged;
 #if GC_DEBUG_VERBOSE
   int debug_print = 0;
 #endif
 
+  // Since terminated threads' heap pages are merged into
+  // the primordial thread's heap, it may be that a sweep
+  // for the primordeal thread is never triggered even though
+  // the heep keeps growing. Perform a sweep here if necessary.
+  stage = ck_pr_load_int(&gc_stage);
+  merged = ck_pr_load_int(&gc_threads_merged);
+  if ((thd == primordial_thread) && (merged == 1)
+      && ((stage == STAGE_SWEEPING) || (stage == STAGE_RESTING))) {
+    gc_sweep_primordial_thread_heap();
+    ck_pr_cas_int(&gc_threads_merged, 1, 0);
+  }
+
   // Handle any pending marks from write barrier
   gc_sum_pending_writes(thd, 0);
 
@@ -2012,36 +2055,6 @@ fprintf(stdout, "done tracing, cooperator is clearing full bits\n");
     // Clear allocation counts to delay next GC trigger
     thd->heap_num_huge_allocations = 0;
     thd->num_minor_gcs = 0;
-// TODO: can't do this now because we don't know how much of the heap is free, as none if it has
-// been swept and we are sweeping incrementally
-//
-//    for (heap_type = 0; heap_type < 2; heap_type++) {
-//      uint64_t free_size = gc_heap_free_size(thd->heap->heap[heap_type]),
-//               threshold = (thd->cached_heap_total_sizes[heap_type]) * GC_FREE_THRESHOLD;
-//      if (free_size < threshold) {
-//        int i, new_heaps = (int)((threshold - free_size) / HEAP_SIZE);
-//        if (new_heaps < 1) {
-//          new_heaps = 1;
-//        }
-////#if GC_DEBUG_TRACE
-//        fprintf(stderr, "Less than %f%% of the heap %d is free (%llu / %llu), growing it %d times\n",
-//                100.0 * GC_FREE_THRESHOLD, heap_type, free_size, threshold, new_heaps);
-////#endif
-//if (new_heaps > 100){ exit(1);} // Something is wrong!
-//        for(i = 0; i < new_heaps; i++){
-//          gc_grow_heap(thd->heap->heap[heap_type], heap_type, 0, 0, thd);
-//        }
-//    //  while ( gc_heap_free_size(thd->heap->heap[heap_type]) < //thd->cached_heap_free_sizes[heap_type] <
-//    //    if (heap_type == HEAP_SM) {
-//    //      gc_grow_heap(thd->heap->heap[heap_type], heap_type, 0, 0, thd);
-//    //    } else if (heap_type == HEAP_64) {
-//    //      gc_grow_heap(thd->heap->heap[heap_type], heap_type, 0, 0, thd);
-//    //    } else if (heap_type == HEAP_REST) {
-//    //      gc_grow_heap(thd->heap->heap[heap_type], heap_type, 0, 0, thd);
-//    //    }
-//      }
-//    }
-
 
     // DEBUG diagnostics
 #if GC_DEBUG_SHOW_SWEEP_DIAG
@@ -2057,57 +2070,36 @@ fprintf(stdout, "done tracing, cooperator is clearing full bits\n");
 
   thd->num_minor_gcs++;
   if (thd->num_minor_gcs % 10 == 9) {   // Throttle a bit since usually we do not need major GC
-    thd->cached_heap_free_sizes[HEAP_SM]   = gc_heap_free_size(thd->heap->heap[HEAP_SM]) ;
+    int heap_type, over_gc_collection_threshold = 0;
-    thd->cached_heap_free_sizes[HEAP_64]   = gc_heap_free_size(thd->heap->heap[HEAP_64]) ;
-    thd->cached_heap_free_sizes[HEAP_96]   = gc_heap_free_size(thd->heap->heap[HEAP_96]) ;
-    thd->cached_heap_free_sizes[HEAP_REST] = gc_heap_free_size(thd->heap->heap[HEAP_REST]);
 
+    for (heap_type = 0; heap_type < HEAP_HUGE; heap_type++) {
+      thd->cached_heap_free_sizes[heap_type] =
+          gc_heap_free_size(thd->heap->heap[heap_type]);
+      if (thd->cached_heap_free_sizes[heap_type] <
+          thd->cached_heap_total_sizes[heap_type] * GC_COLLECTION_THRESHOLD) {
+        over_gc_collection_threshold = 1;
+      }
 #if GC_DEBUG_VERBOSE
-    fprintf(stderr, "heap %d free %zu total %zu\n", HEAP_SM, thd->cached_heap_free_sizes[HEAP_SM], thd->cached_heap_total_sizes[HEAP_SM]);
+      fprintf(stderr, "heap %d free %zu total %zu\n",
-    if (thd->cached_heap_free_sizes[HEAP_SM] > thd->cached_heap_total_sizes[HEAP_SM]) {
+              heap_type,
-      fprintf(stderr, "gc_mut_cooperate - Invalid cached heap sizes, free=%zu total=%zu\n", 
+              thd->cached_heap_free_sizes[heap_type],
-        thd->cached_heap_free_sizes[HEAP_SM], thd->cached_heap_total_sizes[HEAP_SM]);
+              thd->cached_heap_total_sizes[heap_type]);
-      exit(1);
+      if (thd->cached_heap_free_sizes[heap_type] >
-    }
+          thd->cached_heap_total_sizes[heap_type]) {
-    fprintf(stderr, "heap %d free %zu total %zu\n", HEAP_64, thd->cached_heap_free_sizes[HEAP_64], thd->cached_heap_total_sizes[HEAP_64]);
+        fprintf(stderr,
-    if (thd->cached_heap_free_sizes[HEAP_64] > thd->cached_heap_total_sizes[HEAP_64]) {
+                "gc_mut_cooperate - Invalid cached heap sizes, free=%zu total=%zu\n",
-      fprintf(stderr, "gc_mut_cooperate - Invalid cached heap sizes, free=%zu total=%zu\n", 
+                thd->cached_heap_free_sizes[heap_type],
-        thd->cached_heap_free_sizes[HEAP_64], thd->cached_heap_total_sizes[HEAP_64]);
+                thd->cached_heap_total_sizes[heap_type]);
-      exit(1);
-    }
-    fprintf(stderr, "heap %d free %zu total %zu\n", HEAP_96, thd->cached_heap_free_sizes[HEAP_96], thd->cached_heap_total_sizes[HEAP_96]);
-    if (thd->cached_heap_free_sizes[HEAP_96] > thd->cached_heap_total_sizes[HEAP_96]) {
-      fprintf(stderr, "gc_mut_cooperate - Invalid cached heap sizes, free=%zu total=%zu\n", 
-        thd->cached_heap_free_sizes[HEAP_96], thd->cached_heap_total_sizes[HEAP_96]);
-      exit(1);
-    }
-    fprintf(stderr, "heap %d free %zu total %zu\n", HEAP_REST, thd->cached_heap_free_sizes[HEAP_REST], thd->cached_heap_total_sizes[HEAP_REST]);
-    if (thd->cached_heap_free_sizes[HEAP_REST] > thd->cached_heap_total_sizes[HEAP_REST]) {
-      fprintf(stderr, "gc_mut_cooperate - Invalid cached heap sizes, free=%zu total=%zu\n", 
-        thd->cached_heap_free_sizes[HEAP_REST], thd->cached_heap_total_sizes[HEAP_REST]);
         exit(1);
       }
 #endif
+    }
 
     // Initiate collection cycle if free space is too low.
     // Threshold is intentially low because we have to go through an
     // entire handshake/trace/sweep cycle, ideally without growing heap.
     if (ck_pr_load_int(&gc_stage) == STAGE_RESTING &&
-        (
+        (over_gc_collection_threshold ||
-         //(gc_heap_free_size(thd->heap->heap[HEAP_SM]) < //thd->cached_heap_free_sizes[HEAP_SM] <
-         (thd->cached_heap_free_sizes[HEAP_SM] <
-          thd->cached_heap_total_sizes[HEAP_SM] * GC_COLLECTION_THRESHOLD) ||
-         //(gc_heap_free_size(thd->heap->heap[HEAP_64]) < //thd->cached_heap_free_sizes[HEAP_64] <
-         (thd->cached_heap_free_sizes[HEAP_64] <
-          thd->cached_heap_total_sizes[HEAP_64] * GC_COLLECTION_THRESHOLD) ||
-  #if INTPTR_MAX == INT64_MAX
-         //(gc_heap_free_size(thd->heap->heap[HEAP_96]) < //thd->cached_heap_free_sizes[HEAP_96] <
-         (thd->cached_heap_free_sizes[HEAP_96] <
-          thd->cached_heap_total_sizes[HEAP_96] * GC_COLLECTION_THRESHOLD) ||
-  #endif
-         //(gc_heap_free_size(thd->heap->heap[HEAP_REST]) < //thd->cached_heap_free_sizes[HEAP_REST] <
-         (thd->cached_heap_free_sizes[HEAP_REST] <
-          thd->cached_heap_total_sizes[HEAP_REST] * GC_COLLECTION_THRESHOLD) ||
          // Separate huge heap threshold since these are typically allocated as whole pages
          (thd->heap_num_huge_allocations > 100)
         )) {
@@ -2144,8 +2136,7 @@ void gc_mark_gray(gc_thread_data * thd, object obj)
   // timing issues when incrementing colors and since if we ever reach a
   // purple object during tracing we would want to mark it.
   // TODO: revisit if checking for gc_color_purple is truly necessary here and elsewhere.
-  if (is_object_type(obj) && (mark(obj) == gc_color_clear ||
+  if (is_object_type(obj) && (mark(obj) == gc_color_clear || mark(obj) == gc_color_purple)) {   // TODO: sync??
-                              mark(obj) == gc_color_purple)) {     // TODO: sync??
     // Place marked object in a buffer to avoid repeated scans of the heap.
 // TODO:
 // Note that ideally this should be a lock-free data structure to make the
@@ -2171,7 +2162,8 @@ void gc_mark_gray2(gc_thread_data * thd, object obj)
 {
   if (is_object_type(obj) && (mark(obj) == gc_color_clear ||
                               mark(obj) == gc_color_purple)) {
-    mark_buffer_set(thd->mark_buffer, thd->last_write + thd->pending_writes, obj);
+    mark_buffer_set(thd->mark_buffer, thd->last_write + thd->pending_writes,
+                    obj);
     thd->pending_writes++;
   }
 }
@@ -2194,8 +2186,9 @@ static void gc_collector_mark_gray(object parent, object obj)
     fprintf(stderr, "mark gray parent = %p (%d) obj = %p\n", parent,
             type_of(parent), obj);
   } else if (is_object_type(obj)) {
-    fprintf(stderr, "not marking gray, parent = %p (%d) obj = %p mark(obj) = %d, gc_color_clear = %d\n", parent,
+    fprintf(stderr,
-            type_of(parent), obj, mark(obj), gc_color_clear);
+            "not marking gray, parent = %p (%d) obj = %p mark(obj) = %d, gc_color_clear = %d\n",
+            parent, type_of(parent), obj, mark(obj), gc_color_clear);
   }
 }
 #else
@@ -2256,6 +2249,7 @@ void gc_mark_black(object obj)
         if (obj) {
           gc_collector_mark_gray(obj, o);
         }
+        break;
       }
     default:
       break;
@@ -2274,46 +2268,54 @@ void gc_mark_black(object obj)
 #else
 // See full version above for debugging purposes.
 // Also sync any changes to this macro with the function version
-#define gc_mark_black(obj) \
+#define gc_mark_black(_obj) \
 { \
   int markColor = ck_pr_load_8(&gc_color_mark); \
-  if (is_object_type(obj) && mark(obj) != markColor) { \
+  if (is_object_type(_obj) && mark(_obj) != markColor) { \
-    switch (type_of(obj)) { \
+    switch (type_of(_obj)) { \
     case pair_tag:{ \
-        gc_collector_mark_gray(obj, car(obj)); \
+        gc_collector_mark_gray(_obj, car(_obj)); \
-        gc_collector_mark_gray(obj, cdr(obj)); \
+        gc_collector_mark_gray(_obj, cdr(_obj)); \
         break; \
       } \
     case closure1_tag: \
-      gc_collector_mark_gray(obj, ((closure1) obj)->element); \
+      gc_collector_mark_gray(_obj, ((closure1) _obj)->element); \
       break; \
     case closureN_tag:{ \
-        int i, n = ((closureN) obj)->num_elements; \
+        int i, n = ((closureN) _obj)->num_elements; \
         for (i = 0; i < n; i++) { \
-          gc_collector_mark_gray(obj, ((closureN) obj)->elements[i]); \
+          gc_collector_mark_gray(_obj, ((closureN) _obj)->elements[i]); \
         } \
         break; \
       } \
     case vector_tag:{ \
-        int i, n = ((vector) obj)->num_elements; \
+        int i, n = ((vector) _obj)->num_elements; \
         for (i = 0; i < n; i++) { \
-          gc_collector_mark_gray(obj, ((vector) obj)->elements[i]); \
+          gc_collector_mark_gray(_obj, ((vector) _obj)->elements[i]); \
         } \
         break; \
       } \
     case cvar_tag:{ \
-        cvar_type *c = (cvar_type *) obj; \
+        cvar_type *c = (cvar_type *) _obj; \
         object pvar = *(c->pvar); \
         if (pvar) { \
-          gc_collector_mark_gray(obj, pvar); \
+          gc_collector_mark_gray(_obj, pvar); \
+        } \
+        break; \
+      } \
+    case atomic_tag: { \
+        atomic_type *a = (atomic_type *)_obj; \
+        object o = ck_pr_load_ptr(&(a->obj)); \
+        if (_obj) { \
+          gc_collector_mark_gray(_obj, o); \
         } \
         break; \
       } \
     default: \
       break; \
     } \
-    if (mark(obj) != gc_color_red) { \
+    if (mark(_obj) != gc_color_red) { \
-      mark(obj) = markColor; \
+      mark(_obj) = markColor; \
     } \
   } \
 }
@@ -2349,7 +2351,8 @@ void gc_collector_trace()
 #if GC_DEBUG_VERBOSE
         fprintf(stderr,
                 "gc_mark_black mark buffer %p, last_read = %d last_write = %d\n",
-                mark_buffer_get(m->mark_buffer, m->last_read), m->last_read, last_write);
+                mark_buffer_get(m->mark_buffer, m->last_read), m->last_read,
+                last_write);
 #endif
         gc_mark_black(mark_buffer_get(m->mark_buffer, m->last_read));
         gc_empty_collector_stack();
@@ -2470,7 +2473,8 @@ void gc_wait_handshake()
 //printf("DEBUG - update mutator GC status\n");            
             ck_pr_cas_int(&(m->gc_status), statusm, statusc);
 #if GC_DEBUG_TRACE
-            fprintf(stderr, "DEBUG - collector is cooperating for blocked mutator\n");            
+            fprintf(stderr,
+                    "DEBUG - collector is cooperating for blocked mutator\n");
 #endif
             buf_len =
                 gc_minor(m, m->stack_limit, m->stack_start, m->gc_cont, NULL,
@@ -2617,8 +2621,7 @@ static pthread_t collector_thread;
  */
 void gc_start_collector()
 {
-  if (pthread_create
+  if (pthread_create(&collector_thread, NULL, collector_main, NULL)) {
-      (&collector_thread, NULL, collector_main, NULL)) {
     fprintf(stderr, "Error creating collector thread\n");
     exit(1);
   }
@@ -2655,7 +2658,6 @@ void gc_mark_globals(object globals, object global_table)
   }
 }
 
-
 /////////////////////////////////////////////
 // END tri-color marking section
 /////////////////////////////////////////////
@@ -2692,8 +2694,7 @@ void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
   thd->mutations = NULL;
   thd->mutation_buflen = 128;
   thd->mutation_count = 0;
-  thd->mutations = 
+  thd->mutations = vpbuffer_realloc(thd->mutations, &(thd->mutation_buflen));
-      vpbuffer_realloc(thd->mutations, &(thd->mutation_buflen));
   thd->globals_changed = 1;
   thd->param_objs = NULL;
   thd->exception_handler_stack = NULL;
@@ -2723,13 +2724,10 @@ void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
   thd->cached_heap_total_sizes = calloc(5, sizeof(uintptr_t));
   thd->heap = calloc(1, sizeof(gc_heap_root));
   thd->heap->heap = calloc(1, sizeof(gc_heap *) * NUM_HEAP_TYPES);
-  thd->heap->heap[HEAP_REST] = gc_heap_create(HEAP_REST, INITIAL_HEAP_SIZE, thd);
-  thd->heap->heap[HEAP_SM] = gc_heap_create(HEAP_SM, INITIAL_HEAP_SIZE, thd);
-  thd->heap->heap[HEAP_64] = gc_heap_create(HEAP_64, INITIAL_HEAP_SIZE, thd);
-  if (sizeof(void *) == 8) { // Only use this heap on 64-bit platforms
-    thd->heap->heap[HEAP_96] = gc_heap_create(HEAP_96, INITIAL_HEAP_SIZE, thd);
-  }
   thd->heap->heap[HEAP_HUGE] = gc_heap_create(HEAP_HUGE, 1024, thd);
+  for (int i = 0; i < HEAP_HUGE; i++) {
+    thd->heap->heap[i] = gc_heap_create(i, INITIAL_HEAP_SIZE, thd);
+  }
 }
 
 /**
@@ -2786,10 +2784,28 @@ void gc_thread_data_free(gc_thread_data * thd)
  *
  * This function assumes appropriate locks are already held.
  */
-void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc)
+int gc_heap_merge(gc_heap * hdest, gc_heap * hsrc)
 {
+  int freed = 0;
   gc_heap *last = gc_heap_last(hdest);
+  gc_heap *cur = hsrc, *prev = last, *next;
   last->next = hsrc;
+  // free any empty heaps and convert remaining heaps
+  // to free list so that they can be swept
+  while (cur != NULL) {
+    cur->is_unswept = 1;
+    next = cur->next;
+    if (gc_is_heap_empty(cur)) {
+      freed += cur->size;
+      gc_heap_free(cur, prev);
+    } else {
+      gc_convert_heap_page_to_free_list(cur, primordial_thread);
+      ck_pr_cas_int(&gc_threads_merged, 0, 1);
+      prev = cur;
+    }
+    cur = next;
+  }
+  return freed;
 }
 
 /**
@@ -2802,15 +2818,47 @@ void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc)
 void gc_merge_all_heaps(gc_thread_data * dest, gc_thread_data * src)
 {
   gc_heap *hdest, *hsrc;
-  int heap_type;
+  int freed, heap_type, i;
+  pair_type *context = NULL;
+  vector_type *v = src->scm_thread_obj;
+
+  // The following objects are part of the thread context and should
+  // be stored on the primordial thread's heap. Make this explicit by
+  // including it in the thread object.
+  if (src->gc_num_args > 0) {
+    for (i = src->gc_num_args - 1; i >= 0; --i) {
+      context = gc_alloc_pair(dest, (src->gc_args)[i], context);
+    }
+  }
+  if (src->gc_cont != NULL && is_object_type(src->gc_cont)) {
+    context = gc_alloc_pair(dest, src->gc_cont, context);
+  }
+  if (src->exception_handler_stack != NULL) {
+    context = gc_alloc_pair(dest, src->exception_handler_stack, context);
+  }
+  if (src->param_objs != NULL) {
+    context = gc_alloc_pair(dest, src->param_objs, context);
+  }
+
+  if (context != NULL) {
+    gc_mark_black(context);
+    v->elements[8] = context;
+  }
 
   for (heap_type = 0; heap_type < NUM_HEAP_TYPES; heap_type++) {
     hdest = dest->heap->heap[heap_type];
     hsrc = src->heap->heap[heap_type];
+    if (!hdest) {
+      fprintf(stderr,
+              "WARNING !!!!! merging heap type %d does not happen: hdest = %p hsrc = %p size = %d\n",
+              heap_type, hdest, hsrc, hsrc->size);
+      fflush(stderr);
+    }
     if (hdest && hsrc) {
-      gc_heap_merge(hdest, hsrc);
+      freed = gc_heap_merge(hdest, hsrc);
       ck_pr_add_ptr(&(dest->cached_heap_total_sizes[heap_type]),
-           ck_pr_load_ptr(&(src->cached_heap_total_sizes[heap_type])));
+                    ck_pr_load_ptr(&(src->cached_heap_total_sizes[heap_type])) -
+                    freed);
       ck_pr_add_ptr(&(dest->cached_heap_free_sizes[heap_type]),
                     ck_pr_load_ptr(&(src->cached_heap_free_sizes[heap_type])));
     }
@@ -2877,7 +2925,8 @@ void gc_recopy_obj(object obj, gc_thread_data *thd)
  * it was blocking, the mutator will move any remaining stack objects to 
  * the heap and longjmp.
  */
-void gc_mutator_thread_runnable(gc_thread_data * thd, object result, object maybe_copied)
+void gc_mutator_thread_runnable(gc_thread_data * thd, object result,
+                                object maybe_copied)
 {
   char stack_limit;
   // Transition from blocked back to runnable using CAS.
@@ -2916,9 +2965,10 @@ void gc_mutator_thread_runnable(gc_thread_data * thd, object result, object mayb
     // Collector didn't do anything; make a normal continuation call
     if (type_of(thd->gc_cont) == pair_tag || prim(thd->gc_cont)) {
       thd->gc_args[0] = result;
-      Cyc_apply_from_buf(thd, 1, thd->gc_cont, thd->gc_args);
+      Cyc_apply_from_buf(thd, 2, thd->gc_cont, thd->gc_args);
     } else {
-      (((closure) (thd->gc_cont))->fn) (thd, 1, thd->gc_cont, result);
+      object buf[1] = { result };
+      (((closure) (thd->gc_cont))->fn) (thd, thd->gc_cont, 1, buf);
     }
   }
 }

guix/cyclone.scm

@@ -0,0 +1,87 @@
+;; cyclone.scm
+(use-modules
+ (gnu packages)
+ (gnu packages multiprecision)
+ ((guix licenses)
+  #:select (gpl2 gpl2+ lgpl2.0+ lgpl2.1 lgpl2.1+ lgpl3+ asl2.0
+                 bsd-0 bsd-3 cc-by-sa4.0 non-copyleft expat
+                 public-domain))
+ (guix gexp)
+ (guix packages)
+ (guix download)
+ (guix git-download)
+ (guix utils)
+ (guix build-system gnu)
+ (gnu packages c))
+
+(define-public cyclone
+  (package
+    (name "cyclone")
+    (version "0.36.0")
+    (source (origin
+              (method git-fetch)
+              (uri (git-reference
+                    (url "https://github.com/justinethier/cyclone-bootstrap")
+                    (commit (string-append "v" version))))
+              (sha256
+               (base32
+                "0fv0mnrn5shbx77383f4mbkvc4i9yyj1bjm3dfyhipnaqapbhqpi"))
+              (file-name (git-file-name name version))))
+    (build-system gnu-build-system)
+    (arguments
+     (list
+      #:test-target "test"
+      #:make-flags #~(list (string-append
+                            "CC=" #$(this-package-input "gcc-toolchain")
+                            "/bin/gcc")
+                           (string-append "PREFIX=" #$output)
+                           (string-append "COMP_INCDIRS=-I$(PREFIX)/include -I"
+                                          #$(this-package-input "gcc-toolchain")
+                                          "/include")
+                           (string-append
+                            "COMP_LIBDIRS=-L$(PREFIX)/lib "
+                            "-Wl,-rpath=" #$(this-package-input "ck") "/lib "
+                            "-L" #$(this-package-input "ck") "/lib "
+                            "-Wl,-rpath=" #$(this-package-input "libtommath")
+                            "/lib "
+                            "-L" #$(this-package-input "libtommath") "/lib "
+                            "-Wl,-rpath="
+                            #$(this-package-input "gcc-toolchain") "/lib "
+                            "-L" #$(this-package-input "gcc-toolchain")
+                            "/lib"))
+      #:phases #~(modify-phases %standard-phases
+                   (delete 'configure) ; no configure script
+                   (add-before 'build 'replace-cyclonebn
+                     (lambda* (#:key outputs #:allow-other-keys)
+                       (substitute* "Makefile"
+                         (("-lcyclonebn")
+                          "-ltommath")
+                         (("^[$][(]CYC_BN_LIB[)] :")
+                          "dont-build-cyclonebn :")
+                         (("^	[$][(]INSTALL[)] .* [$][(]CYC_BN_LIB[)].*$")
+                          "#dont-install-cyclonebn\n")
+                         (("[$][(]CYC_BN_LIB[)]")
+                          ""))
+                       (substitute* "Makefile.config"
+                         (("-lcyclonebn")
+                          "-ltommath"))))
+                   (add-after 'install 'wrap
+                     (lambda _
+                       (wrap-program (string-append #$output "/bin/cyclone")
+                         `("LIBRARY_PATH" ":" prefix
+                           ,(list (string-append
+                                   #$(this-package-input "gcc-toolchain")
+                                   "/lib")))))))))
+    (inputs (list ck libtommath (module-ref (resolve-interface
+                                             '(gnu packages commencement))
+                                            'gcc-toolchain)))
+    (home-page "https://justinethier.github.io/cyclone/")
+    (synopsis "R7RS Scheme to C compiler")
+    (description
+     "Cyclone Scheme is a R7RS Scheme-to-C compiler that uses a variant of
+Cheney on the MTA to implement full tail recursion, continuations, and
+generational garbage collection.  It also includes the Winds package manager
+for installing Cyclone libraries.")
+    (license expat)))
+
+cyclone

hashset.c

@@ -86,7 +86,6 @@ static void maybe_rehash(hashset_t set)
   size_t *old_items;
   size_t old_capacity, ii;
 
-
   if (set->nitems + set->n_deleted_items >= (double)set->capacity * 0.85) {
     old_items = set->items;
     old_capacity = set->capacity;
@@ -154,4 +153,3 @@ void hashset_to_array(hashset_t set, void **items)
     }
   }
 }
-

include/cyclone/bignum.h

@@ -178,10 +178,7 @@ typedef int mp_endian;
 
 #ifndef MP_FIXED_CUTOFFS
   extern int
-KARATSUBA_MUL_CUTOFF,
+   KARATSUBA_MUL_CUTOFF, KARATSUBA_SQR_CUTOFF, TOOM_MUL_CUTOFF, TOOM_SQR_CUTOFF;
-KARATSUBA_SQR_CUTOFF,
-TOOM_MUL_CUTOFF,
-TOOM_SQR_CUTOFF;
 #endif
 
 /* define this to use lower memory usage routines (exptmods mostly) */
@@ -258,7 +255,8 @@ typedef struct  {
 
 /* callback for mp_prime_random, should fill dst with random bytes and return how many read [upto len] */
   typedef int private_mp_prime_callback(unsigned char *dst, int len, void *dat);
-typedef private_mp_prime_callback MP_DEPRECATED(mp_rand_source) ltm_prime_callback;
+  typedef private_mp_prime_callback MP_DEPRECATED(mp_rand_source)
+   ltm_prime_callback;
 
 /* error code to char* string */
   const char *mp_error_to_string(mp_err code) MP_WUR;
@@ -352,13 +350,19 @@ void mp_set(mp_int *a, mp_digit b);
   mp_err mp_init_set(mp_int * a, mp_digit b) MP_WUR;
 
 /* get integer, set integer and init with integer (deprecated) */
-MP_DEPRECATED(mp_get_mag_u32/mp_get_u32) unsigned long mp_get_int(const mp_int *a) MP_WUR;
+   MP_DEPRECATED(mp_get_mag_u32 /
-MP_DEPRECATED(mp_get_mag_ul/mp_get_ul) unsigned long mp_get_long(const mp_int *a) MP_WUR;
+                 mp_get_u32) unsigned long mp_get_int(const mp_int * a) MP_WUR;
-MP_DEPRECATED(mp_get_mag_ull/mp_get_ull) unsigned long long mp_get_long_long(const mp_int *a) MP_WUR;
+   MP_DEPRECATED(mp_get_mag_ul /
+                 mp_get_ul) unsigned long mp_get_long(const mp_int * a) MP_WUR;
+   MP_DEPRECATED(mp_get_mag_ull /
+                 mp_get_ull) unsigned long long mp_get_long_long(const mp_int *
+                                                                 a) MP_WUR;
    MP_DEPRECATED(mp_set_ul) mp_err mp_set_int(mp_int * a, unsigned long b);
    MP_DEPRECATED(mp_set_ul) mp_err mp_set_long(mp_int * a, unsigned long b);
-MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int *a, unsigned long long b);
+   MP_DEPRECATED(mp_set_ull) mp_err mp_set_long_long(mp_int * a,
-MP_DEPRECATED(mp_init_ul) mp_err mp_init_set_int(mp_int *a, unsigned long b) MP_WUR;
+                                                     unsigned long long b);
+   MP_DEPRECATED(mp_init_ul) mp_err mp_init_set_int(mp_int * a,
+                                                    unsigned long b) MP_WUR;
 
 /* copy, b = a */
   mp_err mp_copy(const mp_int * a, mp_int * b) MP_WUR;
@@ -369,24 +373,27 @@ mp_err mp_init_copy(mp_int *a, const mp_int *b) MP_WUR;
 /* trim unused digits */
   void mp_clamp(mp_int * a);
 
-
 /* export binary data */
-MP_DEPRECATED(mp_pack) mp_err mp_export(void *rop, size_t *countp, int order, size_t size,
+   MP_DEPRECATED(mp_pack) mp_err mp_export(void *rop, size_t *countp, int order,
-                                        int endian, size_t nails, const mp_int *op) MP_WUR;
+                                           size_t size, int endian,
+                                           size_t nails,
+                                           const mp_int * op) MP_WUR;
 
 /* import binary data */
-MP_DEPRECATED(mp_unpack) mp_err mp_import(mp_int *rop, size_t count, int order,
+   MP_DEPRECATED(mp_unpack) mp_err mp_import(mp_int * rop, size_t count,
-      size_t size, int endian, size_t nails,
+                                             int order, size_t size, int endian,
+                                             size_t nails,
                                              const void *op) MP_WUR;
 
 /* unpack binary data */
-mp_err mp_unpack(mp_int *rop, size_t count, mp_order order, size_t size, mp_endian endian,
+  mp_err mp_unpack(mp_int * rop, size_t count, mp_order order, size_t size,
-                 size_t nails, const void *op) MP_WUR;
+                   mp_endian endian, size_t nails, const void *op) MP_WUR;
 
 /* pack binary data */
   size_t mp_pack_count(const mp_int * a, size_t nails, size_t size) MP_WUR;
-mp_err mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order, size_t size,
+  mp_err mp_pack(void *rop, size_t maxcount, size_t *written, mp_order order,
-               mp_endian endian, size_t nails, const mp_int *op) MP_WUR;
+                 size_t size, mp_endian endian, size_t nails,
+                 const mp_int * op) MP_WUR;
 
 /* ---> digit manipulation <--- */
 
@@ -435,7 +442,8 @@ void mp_rand_source(mp_err(*source)(void *out, size_t size));
  * implemented ways to gather entropy.
  * It is compatible with `rng_get_bytes()` from libtomcrypt so you could
  * provide that one and then set `ltm_rng = rng_get_bytes;` */
-extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen, void (*callback)(void));
+  extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen,
+                                  void(*callback)(void));
   extern void (*ltm_rng_callback)(void);
 #endif
 
@@ -448,22 +456,26 @@ extern void (*ltm_rng_callback)(void);
    MP_DEPRECATED(s_mp_get_bit) int mp_get_bit(const mp_int * a, int b) MP_WUR;
 
 /* c = a XOR b (two complement) */
-MP_DEPRECATED(mp_xor) mp_err mp_tc_xor(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+   MP_DEPRECATED(mp_xor) mp_err mp_tc_xor(const mp_int * a, const mp_int * b,
+                                          mp_int * c) MP_WUR;
   mp_err mp_xor(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
 
 /* c = a OR b (two complement) */
-MP_DEPRECATED(mp_or) mp_err mp_tc_or(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+   MP_DEPRECATED(mp_or) mp_err mp_tc_or(const mp_int * a, const mp_int * b,
+                                        mp_int * c) MP_WUR;
   mp_err mp_or(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
 
 /* c = a AND b (two complement) */
-MP_DEPRECATED(mp_and) mp_err mp_tc_and(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+   MP_DEPRECATED(mp_and) mp_err mp_tc_and(const mp_int * a, const mp_int * b,
+                                          mp_int * c) MP_WUR;
   mp_err mp_and(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
 
 /* b = ~a (bitwise not, two complement) */
   mp_err mp_complement(const mp_int * a, mp_int * b) MP_WUR;
 
 /* right shift with sign extension */
-MP_DEPRECATED(mp_signed_rsh) mp_err mp_tc_div_2d(const mp_int *a, int b, mp_int *c) MP_WUR;
+   MP_DEPRECATED(mp_signed_rsh) mp_err mp_tc_div_2d(const mp_int * a, int b,
+                                                    mp_int * c) MP_WUR;
   mp_err mp_signed_rsh(const mp_int * a, int b, mp_int * c) MP_WUR;
 
 /* ---> Basic arithmetic <--- */
@@ -493,7 +505,8 @@ mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
   mp_err mp_sqr(const mp_int * a, mp_int * b) MP_WUR;
 
 /* a/b => cb + d == a */
-mp_err mp_div(const mp_int *a, const mp_int *b, mp_int *c, mp_int *d) MP_WUR;
+  mp_err mp_div(const mp_int * a, const mp_int * b, mp_int * c,
+                mp_int * d) MP_WUR;
 
 /* c = a mod b, 0 <= c < b  */
   mp_err mp_mod(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
@@ -519,7 +532,8 @@ mp_err mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
   mp_err mp_mul_d(const mp_int * a, mp_digit b, mp_int * c) MP_WUR;
 
 /* a/b => cb + d == a */
-mp_err mp_div_d(const mp_int *a, mp_digit b, mp_int *c, mp_digit *d) MP_WUR;
+  mp_err mp_div_d(const mp_int * a, mp_digit b, mp_int * c,
+                  mp_digit * d) MP_WUR;
 
 /* c = a mod b, 0 <= c < b  */
   mp_err mp_mod_d(const mp_int * a, mp_digit b, mp_digit * c) MP_WUR;
@@ -527,13 +541,16 @@ mp_err mp_mod_d(const mp_int *a, mp_digit b, mp_digit *c) MP_WUR;
 /* ---> number theory <--- */
 
 /* d = a + b (mod c) */
-mp_err mp_addmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR;
+  mp_err mp_addmod(const mp_int * a, const mp_int * b, const mp_int * c,
+                   mp_int * d) MP_WUR;
 
 /* d = a - b (mod c) */
-mp_err mp_submod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR;
+  mp_err mp_submod(const mp_int * a, const mp_int * b, const mp_int * c,
+                   mp_int * d) MP_WUR;
 
 /* d = a * b (mod c) */
-mp_err mp_mulmod(const mp_int *a, const mp_int *b, const mp_int *c, mp_int *d) MP_WUR;
+  mp_err mp_mulmod(const mp_int * a, const mp_int * b, const mp_int * c,
+                   mp_int * d) MP_WUR;
 
 /* c = a * a (mod b) */
   mp_err mp_sqrmod(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
@@ -545,7 +562,8 @@ mp_err mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
   mp_err mp_gcd(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
 
 /* produces value such that U1*a + U2*b = U3 */
-mp_err mp_exteuclid(const mp_int *a, const mp_int *b, mp_int *U1, mp_int *U2, mp_int *U3) MP_WUR;
+  mp_err mp_exteuclid(const mp_int * a, const mp_int * b, mp_int * U1,
+                      mp_int * U2, mp_int * U3) MP_WUR;
 
 /* c = [a, b] or (a*b)/(a, b) */
   mp_err mp_lcm(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
@@ -555,20 +573,25 @@ mp_err mp_lcm(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
  * returns error if a < 0 and b is even
  */
   mp_err mp_root_u32(const mp_int * a, uint32_t b, mp_int * c) MP_WUR;
-MP_DEPRECATED(mp_root_u32) mp_err mp_n_root(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
+   MP_DEPRECATED(mp_root_u32) mp_err mp_n_root(const mp_int * a, mp_digit b,
-MP_DEPRECATED(mp_root_u32) mp_err mp_n_root_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR;
+                                               mp_int * c) MP_WUR;
+   MP_DEPRECATED(mp_root_u32) mp_err mp_n_root_ex(const mp_int * a, mp_digit b,
+                                                  mp_int * c, int fast) MP_WUR;
 
 /* special sqrt algo */
   mp_err mp_sqrt(const mp_int * arg, mp_int * ret) MP_WUR;
 
 /* special sqrt (mod prime) */
-mp_err mp_sqrtmod_prime(const mp_int *n, const mp_int *prime, mp_int *ret) MP_WUR;
+  mp_err mp_sqrtmod_prime(const mp_int * n, const mp_int * prime,
+                          mp_int * ret) MP_WUR;
 
 /* is number a square? */
   mp_err mp_is_square(const mp_int * arg, mp_bool * ret) MP_WUR;
 
 /* computes the jacobi c = (a | n) (or Legendre if b is prime)  */
-MP_DEPRECATED(mp_kronecker) mp_err mp_jacobi(const mp_int *a, const mp_int *n, int *c) MP_WUR;
+   MP_DEPRECATED(mp_kronecker) mp_err mp_jacobi(const mp_int * a,
+                                                const mp_int * n,
+                                                int *c) MP_WUR;
 
 /* computes the Kronecker symbol c = (a | p) (like jacobi() but with {a,p} in Z */
   mp_err mp_kronecker(const mp_int * a, const mp_int * p, int *c) MP_WUR;
@@ -592,7 +615,8 @@ mp_err mp_montgomery_setup(const mp_int *n, mp_digit *rho) MP_WUR;
   mp_err mp_montgomery_calc_normalization(mp_int * a, const mp_int * b) MP_WUR;
 
 /* computes x/R == x (mod N) via Montgomery Reduction */
-mp_err mp_montgomery_reduce(mp_int *x, const mp_int *n, mp_digit rho) MP_WUR;
+  mp_err mp_montgomery_reduce(mp_int * x, const mp_int * n,
+                              mp_digit rho) MP_WUR;
 
 /* returns 1 if a is a valid DR modulus */
   mp_bool mp_dr_is_modulus(const mp_int * a) MP_WUR;
@@ -622,7 +646,8 @@ mp_err mp_reduce_2k_setup_l(const mp_int *a, mp_int *d) MP_WUR;
   mp_err mp_reduce_2k_l(mp_int * a, const mp_int * n, const mp_int * d) MP_WUR;
 
 /* Y = G**X (mod P) */
-mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y) MP_WUR;
+  mp_err mp_exptmod(const mp_int * G, const mp_int * X, const mp_int * P,
+                    mp_int * Y) MP_WUR;
 
 /* ---> Primes <--- */
 
@@ -635,20 +660,26 @@ mp_err mp_exptmod(const mp_int *G, const mp_int *X, const mp_int *P, mp_int *Y)
 #define PRIME_SIZE (MP_DEPRECATED_PRAGMA("PRIME_SIZE has been made internal") PRIVATE_MP_PRIME_TAB_SIZE)
 
 /* table of first PRIME_SIZE primes */
-MP_DEPRECATED(internal) extern const mp_digit ltm_prime_tab[PRIVATE_MP_PRIME_TAB_SIZE];
+   MP_DEPRECATED(internal) extern const mp_digit
+      ltm_prime_tab[PRIVATE_MP_PRIME_TAB_SIZE];
 
 /* result=1 if a is divisible by one of the first PRIME_SIZE primes */
-MP_DEPRECATED(mp_prime_is_prime) mp_err mp_prime_is_divisible(const mp_int *a, mp_bool *result) MP_WUR;
+   MP_DEPRECATED(mp_prime_is_prime) mp_err mp_prime_is_divisible(const mp_int *
+                                                                 a,
+                                                                 mp_bool *
+                                                                 result) MP_WUR;
 
 /* performs one Fermat test of "a" using base "b".
  * Sets result to 0 if composite or 1 if probable prime
  */
-mp_err mp_prime_fermat(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR;
+  mp_err mp_prime_fermat(const mp_int * a, const mp_int * b,
+                         mp_bool * result) MP_WUR;
 
 /* performs one Miller-Rabin test of "a" using base "b".
  * Sets result to 0 if composite or 1 if probable prime
  */
-mp_err mp_prime_miller_rabin(const mp_int *a, const mp_int *b, mp_bool *result) MP_WUR;
+  mp_err mp_prime_miller_rabin(const mp_int * a, const mp_int * b,
+                               mp_bool * result) MP_WUR;
 
 /* This gives [for a given bit size] the number of trials required
  * such that Miller-Rabin gives a prob of failure lower than 2^-96
@@ -658,12 +689,14 @@ int mp_prime_rabin_miller_trials(int size) MP_WUR;
 /* performs one strong Lucas-Selfridge test of "a".
  * Sets result to 0 if composite or 1 if probable prime
  */
-mp_err mp_prime_strong_lucas_selfridge(const mp_int *a, mp_bool *result) MP_WUR;
+  mp_err mp_prime_strong_lucas_selfridge(const mp_int * a,
+                                         mp_bool * result) MP_WUR;
 
 /* performs one Frobenius test of "a" as described by Paul Underwood.
  * Sets result to 0 if composite or 1 if probable prime
  */
-mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) MP_WUR;
+  mp_err mp_prime_frobenius_underwood(const mp_int * N,
+                                      mp_bool * result) MP_WUR;
 
 /* performs t random rounds of Miller-Rabin on "a" additional to
  * bases 2 and 3.  Also performs an initial sieve of trial
@@ -712,8 +745,10 @@ mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style) MP_WUR;
  * so it can be NULL
  *
  */
-MP_DEPRECATED(mp_prime_rand) mp_err mp_prime_random_ex(mp_int *a, int t, int size, int flags,
+   MP_DEPRECATED(mp_prime_rand) mp_err mp_prime_random_ex(mp_int * a, int t,
-      private_mp_prime_callback cb, void *dat) MP_WUR;
+                                                          int size, int flags,
+                                                          private_mp_prime_callback
+                                                          cb, void *dat) MP_WUR;
   mp_err mp_prime_rand(mp_int * a, int t, int size, int flags) MP_WUR;
 
 /* Integer logarithm to integer base */
@@ -721,35 +756,53 @@ mp_err mp_log_u32(const mp_int *a, uint32_t base, uint32_t *c) MP_WUR;
 
 /* c = a**b */
   mp_err mp_expt_u32(const mp_int * a, uint32_t b, mp_int * c) MP_WUR;
-MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
+   MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d(const mp_int * a, mp_digit b,
-MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR;
+                                               mp_int * c) MP_WUR;
+   MP_DEPRECATED(mp_expt_u32) mp_err mp_expt_d_ex(const mp_int * a, mp_digit b,
+                                                  mp_int * c, int fast) MP_WUR;
 
 /* ---> radix conversion <--- */
   int mp_count_bits(const mp_int * a) MP_WUR;
 
-
+   MP_DEPRECATED(mp_ubin_size) int mp_unsigned_bin_size(const mp_int *
-MP_DEPRECATED(mp_ubin_size) int mp_unsigned_bin_size(const mp_int *a) MP_WUR;
+                                                        a) MP_WUR;
-MP_DEPRECATED(mp_from_ubin) mp_err mp_read_unsigned_bin(mp_int *a, const unsigned char *b, int c) MP_WUR;
+   MP_DEPRECATED(mp_from_ubin) mp_err mp_read_unsigned_bin(mp_int * a, const unsigned char
-MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin(const mp_int *a, unsigned char *b) MP_WUR;
+                                                           *b, int c) MP_WUR;
-MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR;
+   MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin(const mp_int * a,
+                                                       unsigned char *b) MP_WUR;
+   MP_DEPRECATED(mp_to_ubin) mp_err mp_to_unsigned_bin_n(const mp_int * a,
+                                                         unsigned char *b,
+                                                         unsigned long *outlen)
+   MP_WUR;
 
    MP_DEPRECATED(mp_sbin_size) int mp_signed_bin_size(const mp_int * a) MP_WUR;
-MP_DEPRECATED(mp_from_sbin) mp_err mp_read_signed_bin(mp_int *a, const unsigned char *b, int c) MP_WUR;
+   MP_DEPRECATED(mp_from_sbin) mp_err mp_read_signed_bin(mp_int * a,
-MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin(const mp_int *a,  unsigned char *b) MP_WUR;
+                                                         const unsigned char *b,
-MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin_n(const mp_int *a, unsigned char *b, unsigned long *outlen) MP_WUR;
+                                                         int c) MP_WUR;
+   MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin(const mp_int * a,
+                                                     unsigned char *b) MP_WUR;
+   MP_DEPRECATED(mp_to_sbin) mp_err mp_to_signed_bin_n(const mp_int * a,
+                                                       unsigned char *b,
+                                                       unsigned long *outlen)
+   MP_WUR;
 
   size_t mp_ubin_size(const mp_int * a) MP_WUR;
   mp_err mp_from_ubin(mp_int * a, const unsigned char *buf, size_t size) MP_WUR;
-mp_err mp_to_ubin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR;
+  mp_err mp_to_ubin(const mp_int * a, unsigned char *buf, size_t maxlen,
+                    size_t *written) MP_WUR;
 
   size_t mp_sbin_size(const mp_int * a) MP_WUR;
   mp_err mp_from_sbin(mp_int * a, const unsigned char *buf, size_t size) MP_WUR;
-mp_err mp_to_sbin(const mp_int *a, unsigned char *buf, size_t maxlen, size_t *written) MP_WUR;
+  mp_err mp_to_sbin(const mp_int * a, unsigned char *buf, size_t maxlen,
+                    size_t *written) MP_WUR;
 
   mp_err mp_read_radix(mp_int * a, const char *str, int radix) MP_WUR;
-MP_DEPRECATED(mp_to_radix) mp_err mp_toradix(const mp_int *a, char *str, int radix) MP_WUR;
+   MP_DEPRECATED(mp_to_radix) mp_err mp_toradix(const mp_int * a, char *str,
-MP_DEPRECATED(mp_to_radix) mp_err mp_toradix_n(const mp_int *a, char *str, int radix, int maxlen) MP_WUR;
+                                                int radix) MP_WUR;
-mp_err mp_to_radix(const mp_int *a, char *str, size_t maxlen, size_t *written, int radix) MP_WUR;
+   MP_DEPRECATED(mp_to_radix) mp_err mp_toradix_n(const mp_int * a, char *str,
+                                                  int radix, int maxlen) MP_WUR;
+  mp_err mp_to_radix(const mp_int * a, char *str, size_t maxlen,
+                     size_t *written, int radix) MP_WUR;
   mp_err mp_radix_size(const mp_int * a, int radix, int *size) MP_WUR;
 
 #ifndef MP_NO_FILE
@@ -777,5 +830,4 @@ mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream) MP_WUR;
 #ifdef __cplusplus
 }
 #endif
-
 #endif

include/cyclone/hashset.h

@@ -71,5 +71,4 @@ extern "C" {
 #ifdef __cplusplus
 }
 #endif
-
 #endif

include/cyclone/runtime-main.h

@@ -12,7 +12,7 @@
 long global_stack_size = 0;
 long global_heap_size = 0;
 
-static void c_entry_pt(void *, int, closure, closure);
+static void c_entry_pt(void *data, object clo, int argc, object * args);
 static void Cyc_heap_init(long heap_size);
 
 static void Cyc_heap_init(long heap_size)

include/cyclone/runtime.h

@@ -9,7 +9,6 @@
 #ifndef CYCLONE_RUNTIME_H
 #define CYCLONE_RUNTIME_H
 
-
 /**
  * The boolean True value.
  * \ingroup objects
@@ -66,40 +65,147 @@ void gc_init_heap(long heap_size);
  *
  */
 /**@{*/
-#define Cyc_check_num_args(data, fnc_name, num_args, args) { \
+#define Cyc_check_num_args(data, fnc_name, num_expected_args, args, args_len) { \
-  object l = Cyc_length(data, args); \
+  if (num_expected_args > args_len) { \
-  if (num_args > obj_obj2int(l)) { \
     char buf[128]; \
-    snprintf(buf, 127, "Expected %d arguments to %s but received %ld", \
+    snprintf(buf, 127, "Expected %d arguments to %s but received %d", \
-             num_args, fnc_name, obj_obj2int(l));  \
+             num_expected_args, fnc_name, args_len);  \
     Cyc_rt_raise_msg(data, buf); \
   } \
 }
 
+#define Cyc_check_argc(data, fnc_name, argc, expected) { \
+  if (expected > argc) { \
+    char buf[128]; \
+    snprintf(buf, 127, "Expected %d arguments to %s but received %d", \
+             expected, fnc_name, argc);  \
+    Cyc_rt_raise_msg(data, buf); \
+  } \
+}
+
+/**
+ * Raise an error if obj is immutable
+ * @param data - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_verify_mutable(data, obj) { \
   if (immutable(obj)) Cyc_immutable_obj_error(data, obj); }
+
+/**
+ * Raise an error if obj is mutable
+ * @param data - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_verify_immutable(data, obj) { \
   if (boolean_f == Cyc_is_immutable(obj)) Cyc_mutable_obj_error(data, obj); }
+
+/**
+ * Perform type checking and raise an error if the check fails.
+ * @param data - Thread data object
+ * @param fnc_test - Predicate to do type checking
+ * @param tag - Object tag we are checking for
+ * @param obj - Object to check
+ */
 #define Cyc_check_type(data, fnc_test, tag, obj) { \
   if ((boolean_f == fnc_test(obj))) Cyc_invalid_type_error(data, tag, obj); }
 #define Cyc_check_type2(data, fnc_test, tag, obj) { \
   if ((boolean_f == fnc_test(data, obj))) Cyc_invalid_type_error(data, tag, obj); }
 
+/**
+ * Type Checking - raise an error unless `obj` is a pair object or NULL
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_pair_or_null(d,obj) { if (obj != NULL) { Cyc_check_pair(d,obj); }}
+/**
+ * Type Checking - raise an error unless the object is a pair
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_pair(d,obj) Cyc_check_type(d,Cyc_is_pair, pair_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is a procedure
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_proc(d,obj) Cyc_check_type2(d,Cyc_is_procedure, closureN_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is a number
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_num(d,obj) Cyc_check_type(d,Cyc_is_number, integer_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is an immediate integer
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_fixnum(d,obj) Cyc_check_type(d,Cyc_is_fixnum, integer_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is an integer
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_int(d,obj) Cyc_check_type(d,Cyc_is_integer, integer_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is a double precision number
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_double(d,obj) Cyc_check_type(d,Cyc_is_double, double_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is a string
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_str(d,obj) Cyc_check_type(d,Cyc_is_string, string_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is a symbol
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_sym(d,obj) Cyc_check_type(d,Cyc_is_symbol, symbol_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is a vector
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_vec(d,obj) Cyc_check_type(d,Cyc_is_vector, vector_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is a bytevector
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_bvec(d,obj) Cyc_check_type(d,Cyc_is_bytevector, bytevector_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is a port
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_port(d,obj) Cyc_check_type(d,Cyc_is_port, port_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is a mutex
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_mutex(d,obj) Cyc_check_type(d,Cyc_is_mutex, mutex_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is a condition variable
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_cond_var(d,obj) Cyc_check_type(d,Cyc_is_cond_var, cond_var_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is an atomic
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_atomic(d,obj) Cyc_check_type(d,Cyc_is_atomic, atomic_tag, obj)
+/**
+ * Type Checking - raise an error unless the object is an opaque
+ * @param d - Thread data object
+ * @param obj - Object to check
+ */
 #define Cyc_check_opaque(d,obj) Cyc_check_type(d,Cyc_is_opaque, c_opaque_tag, obj)
 void Cyc_invalid_type_error(void *data, int tag, object found);
 void Cyc_immutable_obj_error(void *data, object obj);
@@ -124,44 +230,39 @@ object Cyc_global_set(void *thd, object sym, object * glo, object value);
 
 #define global_set_cps(thd,k,glo,value) Cyc_global_set_cps(thd, k, NULL, (object *)&glo, value)
 #define global_set_cps_id(thd,k,id,glo,value) Cyc_global_set_cps(thd, k, id, (object *)&glo, value)
-object Cyc_global_set_cps(void *thd, object cont, object sym, object * glo, object value);
+object Cyc_global_set_cps(void *thd, object cont, object sym, object * glo,
+                          object value);
 
-/* Variable argument count support 
+/**
-
+ * Variable argument count support 
-   This macro is intended to be executed at the top of a function that
+ *
-   is passed 'var' as a variable-length argument. 'count' is the number
+ *   This macro is intended to be executed at the top of a function that
-   of varargs that were passed. EG: 
+ *   is passed 'var' as a variable-length argument. 'count' is the number
-   - C definition: f(object a, ...)
+ *   of varargs that were passed. EG: 
-   - C call: f(1, 2, 3)
+ *   - C definition: f(object a, ...)
-   - var: a
+ *   - C call: f(1, 2, 3)
-   - count: 3
+ *   - var: a
-
+ *   - count: 3
-   Argument count would need to be passed by the caller of f. Presumably
+ *
-   our compiler will compute the difference between the number of required
+ *   Argument count would need to be passed by the caller of f. Presumably
-   args and the number of provided ones, and pass the difference as 'count'
+ *   our compiler will compute the difference between the number of required
+ *   args and the number of provided ones, and pass the difference as 'count'
  */
-#define load_varargs(var, arg_var, count) \
+#define load_varargs(var, args_var, start, count) \
-  list var = (count > 0) ? alloca(sizeof(pair_type)*count) : NULL; \
+  list var = ((count) > 0) ? alloca(sizeof(pair_type)*(count)) : NULL; \
   { \
     int i; \
     object tmp; \
-    va_list va; \
+    if ((count) > 0) { \
-    if (count > 0) { \
+      for (i = 0; i < (count); i++) { \
-      va_start(va, arg_var); \
+        tmp = args_var[start + i]; \
-      for (i = 0; i < count; i++) { \
-        if (i) { \
-            tmp = va_arg(va, object); \
-        } else { \
-            tmp = arg_var; \
-        } \
         var[i].hdr.mark = gc_color_red; \
         var[i].hdr.grayed = 0; \
         var[i].hdr.immutable = 0; \
         var[i].tag = pair_tag; \
         var[i].pair_car = tmp; \
-        var[i].pair_cdr = (i == (count-1)) ? NULL : &var[i + 1]; \
+        var[i].pair_cdr = (i == ((count)-1)) ? NULL : &var[i + 1]; \
       } \
-      va_end(va); \
     } \
   }
 /* Prototypes for primitive functions. */
@@ -173,15 +274,11 @@ object Cyc_global_set_cps(void *thd, object cont, object sym, object * glo, obje
 
 /**@{*/
 object apply(void *data, object cont, object func, object args);
-void Cyc_apply(void *data, int argc, closure cont, object prim, ...);
+void Cyc_apply(void *data, object cont, int argc, object * args);
-void dispatch_apply_va(void *data, int argc, object clo, object cont, object func, ...);
+void dispatch_apply_va(void *data, object clo, int argc, object * args);
 object apply_va(void *data, object cont, int argc, object func, ...);
 void dispatch(void *data, int argc, function_type func, object clo, object cont,
               object args);
-void dispatch_va(void *data, int argc, function_type_va func, object clo,
-                 object cont, object args);
-void do_dispatch(void *data, int argc, function_type func, object clo,
-                 object * buffer);
 
 /**@}*/
 
@@ -191,8 +288,7 @@ void do_dispatch(void *data, int argc, function_type func, object clo,
  */
 /**@{*/
 object Cyc_string_cmp(void *data, object str1, object str2);
-object dispatch_string_91append(void *data, int argc, object clo, object cont,
+void dispatch_string_91append(void *data, object clo, int _argc, object * args);
-                                object str1, ...);
 object Cyc_string2number_(void *d, object cont, object str);
 object Cyc_string2number2_(void *data, object cont, int argc, object str, ...);
 int binstr2int(const char *str);
@@ -246,16 +342,14 @@ object Cyc_set_cvar(object var, object value);
  */
 /**@{*/
 object Cyc_display(void *data, object, FILE * port);
-void dispatch_display_va(void *data, int argc, object clo, object cont,
+void dispatch_display_va(void *data, object clo, int argc, object * args);
-                         object x, ...);
 object Cyc_display_va(void *data, int argc, object x, ...);
-object Cyc_display_va_list(void *data, int argc, object x, va_list ap);
+object Cyc_display_va_list(void *data, object x, object opts);
 object Cyc_write_char(void *data, object c, object port);
 object Cyc_write(void *data, object, FILE * port);
-void dispatch_write_va(void *data, int argc, object clo, object cont,
+void dispatch_write_va(void *data, object clo, int argc, object * args);
-                       object x, ...);
 object Cyc_write_va(void *data, int argc, object x, ...);
-object Cyc_write_va_list(void *data, int argc, object x, va_list ap);
+object Cyc_write_va_list(void *data, object x, object opts);
 port_type Cyc_stdout(void);
 port_type Cyc_stdin(void);
 port_type Cyc_stderr(void);
@@ -274,21 +368,66 @@ object Cyc_io_close_output_port(void *data, object port);
 object Cyc_io_flush_output_port(void *data, object port);
 object Cyc_io_read_char(void *data, object cont, object port);
 object Cyc_io_peek_char(void *data, object cont, object port);
+object Cyc_io_char_ready(void *data, object port);
 object Cyc_write_u8(void *data, object c, object port);
 object Cyc_io_read_u8(void *data, object cont, object port);
 object Cyc_io_peek_u8(void *data, object cont, object port);
-object Cyc_write_bytevector(void *data, object bvec, object port, object start, object end);
+object Cyc_write_bytevector(void *data, object bvec, object port, object start,
+                            object end);
 object Cyc_io_read_line(void *data, object cont, object port);
 void Cyc_io_read_token(void *data, object cont, object port);
+int Cyc_have_mstreams();
 /**@}*/
 
-
 /**
  * \defgroup prim_num Numbers
  * @brief Number functions
  */
 /**@{*/
 
+/**
+ * Extract result of OP and pass it in a call to continuation `cont`
+ */
+#define return_double_op(data, cont, OP, z) \
+  int i = 0; \
+  Cyc_check_num(data, z); \
+  if (obj_is_int(z)) { \
+    i = obj_obj2int(z); \
+  } else if (type_of(z) == integer_tag) { \
+    i = (int)OP(((integer_type *)z)->value); \
+  } else if (type_of(z) == bignum_tag) { \
+    return_closcall1(data, cont, z); \
+  } else if (type_of(z) == double_tag) { \
+    make_double(d, OP(((double_type *)z)->value)); \
+    return_closcall1(data, cont, &d); \
+  } else { \
+    Cyc_rt_raise2(data, "Expected number but received", z); \
+  } \
+  return_closcall1(data, cont, obj_int2obj(i));
+
+/**
+ * Directly return result of OP to caller
+ */
+#define return_double_op_no_cps(data, ptr, OP, z) \
+  int i = 0; \
+  Cyc_check_num(data, z); \
+  if (obj_is_int(z)) { \
+    i = obj_obj2int(z); \
+  } else if (type_of(z) == integer_tag) { \
+    i = (int)OP(((integer_type *)z)->value); \
+  } else if (type_of(z) == bignum_tag) { \
+    return z; \
+  } else if (type_of(z) == double_tag) { \
+    assign_double(ptr, OP(((double_type *)z)->value)); \
+    return ptr; \
+  } else { \
+    Cyc_rt_raise2(data, "Expected number but received", z); \
+  } \
+  return obj_int2obj(i);
+
+/**
+ * Extract double and return it to caller
+ */
 #define return_inexact_double_op_no_cps(data, ptr, OP, z) \
   double unboxed; \
   Cyc_check_num(data, z); \
@@ -304,6 +443,9 @@ void Cyc_io_read_token(void *data, object cont, object port);
   assign_double(ptr, unboxed); \
   return ptr;
 
+/**
+ * Extract double and pass it to continuation cont
+ */
 #define return_inexact_double_op(data, cont, OP, z) \
   make_double(d, 0.0); \
   Cyc_check_num(data, z); \
@@ -318,6 +460,9 @@ void Cyc_io_read_token(void *data, object cont, object port);
   } \
   return_closcall1(data, cont, &d)
 
+/**
+ * Extract double or complex number and return it to caller
+ */
 #define return_inexact_double_or_cplx_op_no_cps(data, ptr, OP, CPLX_OP, z) \
   double unboxed; \
   Cyc_check_num(data, z); \
@@ -337,6 +482,9 @@ void Cyc_io_read_token(void *data, object cont, object port);
   assign_double(ptr, unboxed); \
   return ptr;
 
+/**
+ * Extract double or complex number and pass it in a call to continuation `cont`
+ */
 #define return_inexact_double_or_cplx_op(data, cont, OP, CPLX_OP, z) \
   make_double(d, 0.0); \
   Cyc_check_num(data, z); \
@@ -356,34 +504,13 @@ void Cyc_io_read_token(void *data, object cont, object port);
   } \
   return_closcall1(data, cont, &d)
 
-#define return_exact_double_op(data, cont, OP, z) \
+double round_to_nearest_even(double);
-  int i = 0; \
+void Cyc_exact(void *data, object cont, object z);
-  Cyc_check_num(data, z); \
+object Cyc_exact_no_cps(void *data, object ptr, object z);
-  if (obj_is_int(z)) { \
-    i = obj_obj2int(z); \
-  } else if (type_of(z) == integer_tag) { \
-    i = (int)OP(((integer_type *)z)->value); \
-  } else if (type_of(z) == bignum_tag) { \
-    return_closcall1(data, cont, z); \
-  } else { \
-    i = (int)OP(((double_type *)z)->value); \
-  } \
-  return_closcall1(data, cont, obj_int2obj(i))
-
-#define return_exact_double_op_no_cps(data, ptr, OP, z) \
-  int i = 0; \
-  Cyc_check_num(data, z); \
-  if (obj_is_int(z)) { \
-    i = obj_obj2int(z); \
-  } else if (type_of(z) == integer_tag) { \
-    i = (int)OP(((integer_type *)z)->value); \
-  } else if (type_of(z) == bignum_tag) { \
-    return z; \
-  } else { \
-    i = (int)OP(((double_type *)z)->value); \
-  } \
-  return obj_int2obj(i);
 
+/**
+ * Take Scheme object that is a number and return the number as a C type
+ */
 #define unbox_number(n) \
   ((obj_is_int(n) ? obj_obj2int(n) : \
                     ((type_of(n) == integer_tag) ? \
@@ -410,6 +537,7 @@ object Cyc_num_cmp_va_list(void *data, int argc,
                            va_list ns);
 void Cyc_expt(void *data, object cont, object x, object y);
 void Cyc_remainder(void *data, object cont, object num1, object num2);
+void Cyc_get_ratio(void *data, object cont, object n, int numerator);
 object Cyc_number2string2(void *data, object cont, int argc, object n, ...);
 object Cyc_integer2char(void *data, object n);
 object Cyc_sum_op(void *data, common_type * x, object y);
@@ -431,14 +559,20 @@ object Cyc_fast_list_3(object ptr, object a1, object a2, object a3);
 object Cyc_fast_list_4(object ptr, object a1, object a2, object a3, object a4);
 object Cyc_fast_vector_2(object ptr, object a1, object a2);
 object Cyc_fast_vector_3(object ptr, object a1, object a2, object a3);
-object Cyc_fast_vector_4(object ptr, object a1, object a2, object a3, object a4);
+object Cyc_fast_vector_4(object ptr, object a1, object a2, object a3,
-object Cyc_fast_vector_5(object ptr, object a1, object a2, object a3, object a4, object a5);
+                         object a4);
+object Cyc_fast_vector_5(object ptr, object a1, object a2, object a3, object a4,
+                         object a5);
 object Cyc_bit_unset(void *data, object n1, object n2);
 object Cyc_bit_set(void *data, object n1, object n2);
 object Cyc_num_op_va_list(void *data, int argc,
                           object(fn_op(void *, common_type *, object)),
                           int default_no_args, int default_one_arg, object n,
                           va_list ns, common_type * buf);
+object Cyc_num_op_args(void *data, int argc,
+                       object(fn_op(void *, common_type *, object)),
+                       int default_no_args, int default_one_arg,
+                       object * args, common_type * buf);
 void Cyc_int2bignum(int n, mp_int * bn);
 object Cyc_bignum_normalize(void *data, object n);
 int Cyc_bignum_cmp(bn_cmp_type type, object x, int tx, object y, int ty);
@@ -452,7 +586,6 @@ double MRG32k3a (double seed);
 //object Cyc_eq(object x, object y);
 object Cyc_eqv(object x, object y);
 #define Cyc_eq(x, y) (make_boolean(x == y))
-int equal(object, object);
 object equalp(object, object);
 object Cyc_has_cycle(object lst);
 object Cyc_is_list(object lst);
@@ -520,7 +653,8 @@ object Cyc_vector_ref(void *d, object v, object k);
 object Cyc_vector_set(void *d, object v, object k, object obj);
 object Cyc_vector_set_unsafe(void *d, object v, object k, object obj);
 object Cyc_vector_set_cps(void *d, object cont, object v, object k, object obj);
-object Cyc_vector_set_unsafe_cps(void *d, object cont, object v, object k, object obj);
+object Cyc_vector_set_unsafe_cps(void *d, object cont, object v, object k,
+                                 object obj);
 object Cyc_make_vector(void *data, object cont, int argc, object len, ...);
 /**@}*/
 
@@ -555,7 +689,7 @@ object Cyc_installation_dir(void *data, object cont, object type);
 object Cyc_compilation_environment(void *data, object cont, object var);
 object Cyc_command_line_arguments(void *data, object cont);
 object Cyc_system(object cmd);
-void Cyc_halt(object obj);
+void Cyc_halt(void *data, object clo, int argc, object * args);
 object __halt(object obj);
 object Cyc_io_delete_file(void *data, object filename);
 object Cyc_io_file_exists(void *data, object filename);
@@ -573,7 +707,7 @@ time_t Cyc_file_last_modified_time(char *path);
 object Cyc_spawn_thread(object thunk);
 void Cyc_start_trampoline(gc_thread_data * thd);
 void Cyc_end_thread(gc_thread_data * thd);
-void Cyc_exit_thread(gc_thread_data * thd);
+void Cyc_exit_thread(void *data, object _, int argc, object * args);
 object Cyc_thread_sleep(void *data, object timeout);
 /**@}*/
 
@@ -602,8 +736,10 @@ object copy2heap(void *data, object obj);
 #define Cyc_st_add(data, frame) \
 { \
   gc_thread_data *thd = (gc_thread_data *) data; \
+  intptr_t p1 = (intptr_t)frame; \
+  intptr_t p2 = (intptr_t)thd->stack_prev_frame; \
   /* Do not allow recursion to remove older frames */ \
-  if ((char *)frame != thd->stack_prev_frame) { \
+  if (p1 != p2) { \
     thd->stack_prev_frame = frame; \
     thd->stack_traces[thd->stack_trace_idx] = frame; \
     thd->stack_trace_idx = (thd->stack_trace_idx + 1) % MAX_STACK_TRACES; \
@@ -774,7 +910,8 @@ extern object Cyc_glo_call_cc;
  * @brief Raise and handle Scheme exceptions
  */
 /**@{*/
-object Cyc_default_exception_handler(void *data, int argc, closure _, object err);
+object Cyc_default_exception_handler(void *data, object _, int argc,
+                                     object * args);
 
 object Cyc_current_exception_handler(void *data);
 void Cyc_rt_raise(void *data, object err);
@@ -861,6 +998,7 @@ static inline object Cyc_cdr(void *data, object lis)
   Cyc_check_pair(data, lis);
   return cdr(lis);
 }
+
 // Unsafe car/cdr
 #define Cyc_car_unsafe(d, lis) car(lis)
 #define Cyc_cdr_unsafe(d, lis) cdr(lis)
@@ -875,13 +1013,15 @@ object Cyc_length(void *d, object l);
 object Cyc_length_unsafe(void *d, object l);
 object Cyc_list2vector(void *data, object cont, object l);
 object Cyc_list2string(void *d, object cont, object lst);
-object Cyc_list(void *data, int argc, object cont, ...);
 object memberp(void *data, object x, list l);
+object memvp(void *data, object x, list l);
 object memqp(void *data, object x, list l);
 list assq(void *data, object x, list l);
+list assv(void *data, object x, list l);
 list assoc(void *data, object x, list l);
 list assoc_cdr(void *data, object x, list l);
 /**@}*/
 
+void init_polyfills(void);
 
 #endif                          /* CYCLONE_RUNTIME_H */

include/cyclone/types.h

@@ -46,31 +46,13 @@ typedef void *object;
  *\ingroup objects
  */
 enum object_tag {
-        closure0_tag    = 0
+  closure0_tag = 0, closure1_tag = 1, closureN_tag = 2, macro_tag = 3   // Keep closures here for quick type checking
-      , closure1_tag    = 1
+  , boolean_tag = 4, bytevector_tag = 5, c_opaque_tag = 6, cond_var_tag =
-      , closureN_tag    = 2
+      7, cvar_tag = 8, double_tag = 9, eof_tag = 10, forward_tag =
-      , macro_tag       = 3 // Keep closures here for quick type checking
+      11, integer_tag = 12, bignum_tag = 13, mutex_tag = 14, pair_tag =
-      , boolean_tag     = 4
+      15, port_tag = 16, primitive_tag = 17, string_tag = 18, symbol_tag =
-      , bytevector_tag  = 5
+      19, vector_tag = 20, complex_num_tag = 21, atomic_tag = 22, void_tag =
-      , c_opaque_tag    = 6
+      23, record_tag = 24
-      , cond_var_tag    = 7
-      , cvar_tag        = 8
-      , double_tag      = 9
-      , eof_tag         = 10
-      , forward_tag     = 11
-      , integer_tag     = 12
-      , bignum_tag      = 13
-      , mutex_tag       = 14
-      , pair_tag        = 15
-      , port_tag        = 16 
-      , primitive_tag   = 17
-      , string_tag      = 18
-      , symbol_tag      = 19
-      , vector_tag      = 20
-      , complex_num_tag = 21
-      , atomic_tag      = 22
-      , void_tag        = 23
-      , record_tag      = 24
 };
 
 /**
@@ -176,28 +158,24 @@ typedef unsigned char tag_type;
  heaps (128, 160) are also added.
 
  32 bit x86 is starting to have trouble with just a 96 byte heap added.
-
- In the future, a better solution might be to allocate arrays (closureN's, vectors, bytevectors, and strings)
- as fixed-size chunks to prevent heap fragmentation. The advantage is then we have no fragmentation directly.
- But, an array will no longer be contiguous so they may cause other problems, and the runtime has to change
- to work with non-contiguous arrays. This would also cause a lot of problems for strings since the built-in
- functions would no longer work (EG: strlen, etc).
  */
-typedef enum { 
+
-    HEAP_SM = 0  // 32 byte objects (min gc_heap_align)
+// Type starts at 0 and ends at LAST_FIXED_SIZE_HEAP_TYPE
-  , HEAP_64
+// Presently each type contains buckets of a multiple of 32 bytes
-  , HEAP_96
+// EG: 0 ==> 32
-  , HEAP_REST    // Everything else
+//     1 ==> 64, etc
-  , HEAP_HUGE    // Huge objects, 1 per page
+typedef int gc_heap_type;
-} gc_heap_type;
 
 /** The first heap type that is not fixed-size */
 #if INTPTR_MAX == INT64_MAX
-#define LAST_FIXED_SIZE_HEAP_TYPE HEAP_96
+#define LAST_FIXED_SIZE_HEAP_TYPE 2
 #else
-#define LAST_FIXED_SIZE_HEAP_TYPE HEAP_64
+#define LAST_FIXED_SIZE_HEAP_TYPE 1
 #endif
 
+#define HEAP_REST (LAST_FIXED_SIZE_HEAP_TYPE + 1)
+#define HEAP_HUGE (HEAP_REST + 1)
+
 /** The number of `gc_heap_type`'s */
 #define NUM_HEAP_TYPES (HEAP_HUGE + 1)
 
@@ -225,7 +203,7 @@ struct gc_heap_t {
   /** Size of the heap page in bytes */
   unsigned int size;
   /** Keep empty page alive this many times before freeing */
-  unsigned int ttl; 
+  unsigned char ttl;
   /** Bump: Track remaining space; this is useful for bump&pop style allocation */
   unsigned int remaining;
   /** For fixed-size heaps, only allocate blocks of this size */
@@ -407,14 +385,14 @@ int gc_is_mutator_new(gc_thread_data *thd);
 void gc_sleep_ms(int ms);
 gc_heap *gc_heap_create(int heap_type, size_t size, gc_thread_data * thd);
 gc_heap *gc_heap_free(gc_heap * page, gc_heap * prev_page);
-void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc);
+int gc_heap_merge(gc_heap * hdest, gc_heap * hsrc);
 void gc_merge_all_heaps(gc_thread_data * dest, gc_thread_data * src);
 void gc_print_stats(gc_heap * h);
 gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data * thd);
 char *gc_copy_obj(object hp, char *obj, gc_thread_data * thd);
-void *gc_try_alloc(gc_heap * h, size_t size, char *obj,
+void *gc_try_alloc(gc_heap * h, size_t size, char *obj, gc_thread_data * thd);
+void *gc_try_alloc_slow(gc_heap * h_passed, gc_heap * h, size_t size, char *obj,
                         gc_thread_data * thd);
-void *gc_try_alloc_slow(gc_heap *h_passed, gc_heap *h, size_t size, char *obj, gc_thread_data *thd);
 void *gc_alloc(gc_heap_root * h, size_t size, char *obj, gc_thread_data * thd,
                int *heap_grown);
 void *gc_alloc_bignum(gc_thread_data * data);
@@ -422,8 +400,10 @@ size_t gc_allocated_bytes(object obj, gc_free_list * q, gc_free_list * r);
 gc_heap *gc_heap_last(gc_heap * h);
 
 void gc_heap_create_rest(gc_heap * h, gc_thread_data * thd);
-void *gc_try_alloc_rest(gc_heap * h, size_t size, char *obj, gc_thread_data * thd);
+void *gc_try_alloc_rest(gc_heap * h, size_t size, char *obj,
-void *gc_alloc_rest(gc_heap_root * hrt, size_t size, char *obj, gc_thread_data * thd, int *heap_grown);
+                        gc_thread_data * thd);
+void *gc_alloc_rest(gc_heap_root * hrt, size_t size, char *obj,
+                    gc_thread_data * thd, int *heap_grown);
 void gc_init_fixed_size_free_list(gc_heap * h);
 
 //size_t gc_heap_total_size(gc_heap * h);
@@ -460,7 +440,8 @@ void gc_post_handshake(gc_status_type s);
 void gc_wait_handshake();
 void gc_start_collector();
 void gc_mutator_thread_blocked(gc_thread_data * thd, object cont);
-void gc_mutator_thread_runnable(gc_thread_data * thd, object result, object maybe_copied);
+void gc_mutator_thread_runnable(gc_thread_data * thd, object result,
+                                object maybe_copied);
 void Cyc_make_shared_object(void *data, object k, object obj);
 #define set_thread_blocked(d, c) \
   gc_mutator_thread_blocked(((gc_thread_data *)d), (c))
@@ -527,7 +508,6 @@ void Cyc_make_shared_object(void *data, object k, object obj);
  */
 #define forward(obj) (((pair_type *) obj)->pair_car)
 
-
 /**
  * \defgroup gc_minor_mut Mutation table
  * @brief Mutation table to support the minor GC write barrier
@@ -542,7 +522,8 @@ void clear_mutations(void *data);
  * @brief Minor GC write barrier to ensure there are no references to stack objects from the heap.
  */
 /**@{*/
-object transport_stack_value(gc_thread_data *data, object var, object value, int *run_gc);
+object transport_stack_value(gc_thread_data * data, object var, object value,
+                             int *run_gc);
 /**@}*/
 
 /**@}*/
@@ -554,7 +535,8 @@ object transport_stack_value(gc_thread_data *data, object var, object value, int
  * \defgroup ffi Foreign Function Interface
  */
 /**@{*/
-object Cyc_scm_call(gc_thread_data *parent_thd, object fnc, int argc, object *args);
+object Cyc_scm_call(gc_thread_data * parent_thd, object fnc, int argc,
+                    object * args);
 object Cyc_scm_call_no_gc(gc_thread_data * parent_thd, object fnc, object arg);
 /**@}*/
 
@@ -663,10 +645,7 @@ typedef uint32_t char_type;
 /**@{*/
 
 /** Function type */
-typedef void (*function_type) ();
+typedef void (*function_type)(void *data, object clo, int argc, object * args);
-
-/** Variable-argument function type */
-typedef void (*function_type_va) (int, object, object, object, ...);
 
 /** Non-CPS function type */
 typedef object(*inline_function_type) ();
@@ -888,6 +867,7 @@ typedef struct {
   n.tag = double_tag; \
   n.value = v;
 
+/** Create a new double in the nursery using alloca */
 #define alloca_double(n,v) \
   double_type *n = alloca(sizeof(double_type)); \
   n->hdr.mark = gc_color_red; \
@@ -919,11 +899,8 @@ typedef struct {
  * and provides constants for each of the comparison operators.
  */
 typedef enum {
-    CYC_BN_LTE = -2
+  CYC_BN_LTE = -2, CYC_BN_LT = MP_LT, CYC_BN_EQ = MP_EQ, CYC_BN_GT =
-  , CYC_BN_LT = MP_LT
+      MP_GT, CYC_BN_GTE = 2
-  , CYC_BN_EQ = MP_EQ
-  , CYC_BN_GT = MP_GT
-  , CYC_BN_GTE = 2
 } bn_cmp_type;
 
 /** 
@@ -1046,6 +1023,9 @@ typedef struct {
     ((string_type *)_s)->str = alloca(sizeof(char) * (_len + 1)); \
   }
 
+/**
+ * Allocate a new bytevector, either on the stack or heap depending upon size
+ */
 #define alloc_bytevector(_data, _bv, _len) \
   if (_len >= MAX_STACK_OBJ) { \
     int heap_grown; \
@@ -1137,6 +1117,7 @@ typedef struct {
   p.str_bv_in_mem_buf_len = 0; \
   p.read_len = 1;
 
+/** Create a new input port object in the nursery */
 #define make_input_port(p,f,rl) \
   port_type p; \
   p.hdr.mark = gc_color_red; \
@@ -1170,10 +1151,22 @@ typedef struct {
 } vector_type;
 typedef vector_type *vector;
 
-typedef struct { vector_type v; object arr[2]; } vector_2_type;
+typedef struct {
-typedef struct { vector_type v; object arr[3]; } vector_3_type;
+  vector_type v;
-typedef struct { vector_type v; object arr[4]; } vector_4_type;
+  object arr[2];
-typedef struct { vector_type v; object arr[5]; } vector_5_type;
+} vector_2_type;
+typedef struct {
+  vector_type v;
+  object arr[3];
+} vector_3_type;
+typedef struct {
+  vector_type v;
+  object arr[4];
+} vector_4_type;
+typedef struct {
+  vector_type v;
+  object arr[5];
+} vector_5_type;
 
 /** Create a new vector in the nursery */
 #define make_empty_vector(v) \
@@ -1185,6 +1178,7 @@ typedef struct { vector_type v; object arr[5]; } vector_5_type;
   v.num_elements = 0; \
   v.elements = NULL;
 
+/** Create an empty vector in the nursery using alloca */
 #define alloca_empty_vector(v) \
   vector_type *v = alloca(sizeof(vector_type)); \
   v->hdr.mark = gc_color_red; \
@@ -1218,6 +1212,7 @@ typedef bytevector_type *bytevector;
   v.len = 0; \
   v.data = NULL;
 
+/** Create an empty bytevector in the nursery using alloca */
 #define alloca_empty_bytevector(v) \
   bytevector_type *v = alloca(sizeof(bytevector_type)); \
   v->hdr.mark = gc_color_red; \
@@ -1256,6 +1251,7 @@ typedef pair_type *pair;
   n.pair_car = a; \
   n.pair_cdr = d;
 
+/** Create a new pair in the nursery using alloca */
 #define alloca_pair(n,a,d) \
   pair_type *n = alloca(sizeof(pair_type)); \
   n->hdr.mark = gc_color_red; \
@@ -1265,6 +1261,15 @@ typedef pair_type *pair;
   n->pair_car = a; \
   n->pair_cdr = d;
 
+/** Create a new pair in the thread's heap */
+void *gc_alloc_pair(gc_thread_data * data, object head, object tail);
+
+/**
+ * Set members of the given pair 
+ * @param n - Pointer to a pair object
+ * @param a - Object to assign to car
+ * @param d - Object to assign to cdr
+ */
 #define set_pair(n,a,d) \
   n->hdr.mark = gc_color_red; \
   n->hdr.grayed = 0; \
@@ -1273,6 +1278,12 @@ typedef pair_type *pair;
   n->pair_car = a; \
   n->pair_cdr = d;
 
+/**
+ * Set members of the given pair, using a single expression
+ * @param n - Pointer to a pair object
+ * @param a - Object to assign to car
+ * @param d - Object to assign to cdr
+ */
 #define set_pair_as_expr(n,a,d) \
  (((pair)(n))->hdr.mark = gc_color_red, \
   ((pair)(n))->hdr.grayed = 0, \
@@ -1283,9 +1294,21 @@ typedef pair_type *pair;
   (n))
 
 //typedef list_1_type pair_type;
-typedef struct { pair_type a; pair_type b; } list_2_type;
+typedef struct {
-typedef struct { pair_type a; pair_type b; pair_type c;} list_3_type;
+  pair_type a;
-typedef struct { pair_type a; pair_type b; pair_type c; pair_type d;} list_4_type;
+  pair_type b;
+} list_2_type;
+typedef struct {
+  pair_type a;
+  pair_type b;
+  pair_type c;
+} list_3_type;
+typedef struct {
+  pair_type a;
+  pair_type b;
+  pair_type c;
+  pair_type d;
+} list_4_type;
 
 /**
  * Create a pair with a single value. 
@@ -1420,19 +1443,13 @@ typedef closure0_type *macro;
   c.fn = f; \
   c.num_args = -1;
 
+/**
+ * Create a closure0 object
+ * These objects are special and can be statically allocated as an optimization
+ */
 #define mclosure0(c, f) \
  static closure0_type c = { .hdr.mark = gc_color_red, .hdr.grayed = 0, .tag = closure0_tag, .fn = f, .num_args = -1 };  /* TODO: need a new macro that initializes num_args */
 
-/*
-#define mclosure0(c,f) \
-  closure0_type c; \
-  c.hdr.mark = gc_color_red; \
-  c.hdr.grayed = 0; \
-  c.tag = closure0_tag; \
-  c.fn = f; \
-  c.num_args = -1;
-*/
-
 #define maclosure0(c,f,na) \
   closure0_type c; \
   c.hdr.mark = gc_color_red; \
@@ -1441,6 +1458,9 @@ typedef closure0_type *macro;
   c.fn = f; \
   c.num_args = na;
 
+/**
+ * Create a closure1 object in the nursery
+ */
 #define mclosure1(c,f,a) \
   closure1_type c; \
   c.hdr.mark = gc_color_red; \
@@ -1456,8 +1476,8 @@ typedef closure0_type *macro;
 typedef struct {
   gc_header_type hdr;
   tag_type tag;
-  const char *desc;
   function_type fn;
+  const char *desc;
 } primitive_type;
 typedef primitive_type *primitive;
 
@@ -1465,7 +1485,10 @@ typedef primitive_type *primitive;
 static primitive_type name##_primitive = {primitive_tag, #desc, fnc}; \
 static const object primitive_##name = &name##_primitive
 
+/** Is x a primitive object? */
 #define prim(x) (x && ((primitive)x)->tag == primitive_tag)
+
+/** Return description of primitive object x */
 #define prim_name(x) (((primitive_type *) x)->desc)
 
 /**
@@ -1535,5 +1558,6 @@ void *gc_alloc_from_bignum(gc_thread_data *data, bignum_type *src);
 int gc_minor(void *data, object low_limit, object high_limit, closure cont,
              object * args, int num_args);
 
-void Cyc_import_shared_object(void *data, object cont, object filename, object entry_pt_fnc);
+void Cyc_import_shared_object(void *data, object cont, object filename,
+                              object entry_pt_fnc);
 #endif                          /* CYCLONE_TYPES_H */

libs/cyclone/foreign.sld

@@ -14,6 +14,7 @@
   (export
    opaque?
    opaque-null?
+   make-opaque
    
    c-code
    c-value
@@ -31,6 +32,11 @@
       "Cyc_check_opaque(data, p);
        return_closcall1(data, k, make_boolean(opaque_ptr(p) == NULL));")
 
+    (define-c make-opaque
+      "(void *data, int argc, closure _, object k)"
+      "make_c_opaque(opq, NULL);
+       return_closcall1(data, k, &opq);")
+
     ;; (c-define-type name type (pack (unpack)))
     (define-syntax c-define-type
       (er-macro-transformer
@@ -83,7 +89,6 @@
     ;;  - type - Data type of the Scheme object
     ;; Returns:
     ;;  - C code used to unbox the data
-                                        ;(define (scm->c code type)
     (define-syntax scm->c
       (er-macro-transformer
        (lambda (expr rename compare)

mstreams.c

@@ -13,24 +13,34 @@
 #include <errno.h>
 
 /* These macros are hardcoded here to support functions in this module. */
-#define closcall1(td, clo, a1) \
+#define closcall1(td, clo, buf) \
 if (obj_is_not_closure(clo)) { \
-   Cyc_apply(td, 0, (closure)(a1), clo); \
+   Cyc_apply(td, clo, 1, buf ); \
 } else { \
-   ((clo)->fn)(td, 1, clo, a1);\
+   ((clo)->fn)(td, clo, 1, buf); \
+;\
 }
 #define return_closcall1(td, clo,a1) { \
  char top; \
- if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \
  object buf[1]; buf[0] = a1;\
+ if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \
      GC(td, clo, buf, 1); \
      return; \
  } else {\
-     closcall1(td, (closure) (clo), a1); \
+     closcall1(td, (closure) (clo), buf); \
      return;\
  } \
 }
 
+int Cyc_have_mstreams()
+{
+#if CYC_HAVE_FMEMOPEN && CYC_HAVE_OPEN_MEMSTREAM
+  return 1;
+#else
+  return 0;
+#endif
+}
+
 object Cyc_heap_alloc_port(void *data, port_type * p);
 port_type *Cyc_io_open_input_string(void *data, object str)
 {
@@ -48,7 +58,8 @@ port_type *Cyc_io_open_input_string(void *data, object str)
   p->fp = fmemopen(p->str_bv_in_mem_buf, string_len(str), "r");
 #endif
   if (p->fp == NULL) {
-    Cyc_rt_raise2(data, "Unable to open input memory stream", obj_int2obj(errno));
+    Cyc_rt_raise2(data, "Unable to open input memory stream",
+                  obj_int2obj(errno));
   }
   return p;
 }
@@ -69,7 +80,8 @@ port_type *Cyc_io_open_input_bytevector(void *data, object bv)
   p->fp = fmemopen(p->str_bv_in_mem_buf, ((bytevector) bv)->len, "r");
 #endif
   if (p->fp == NULL) {
-    Cyc_rt_raise2(data, "Unable to open input memory stream", obj_int2obj(errno));
+    Cyc_rt_raise2(data, "Unable to open input memory stream",
+                  obj_int2obj(errno));
   }
   return p;
 }
@@ -85,7 +97,8 @@ port_type *Cyc_io_open_output_string(void *data)
   p->fp = open_memstream(&(p->str_bv_in_mem_buf), &(p->str_bv_in_mem_buf_len));
 #endif
   if (p->fp == NULL) {
-    Cyc_rt_raise2(data, "Unable to open output memory stream", obj_int2obj(errno));
+    Cyc_rt_raise2(data, "Unable to open output memory stream",
+                  obj_int2obj(errno));
   }
   return p;
 }
@@ -120,8 +133,8 @@ void Cyc_io_get_output_bytevector(void *data, object cont, object port)
   {
     object bv;
     alloc_bytevector(data, bv, p->str_bv_in_mem_buf_len);
-    memcpy(((bytevector)bv)->data, p->str_bv_in_mem_buf, p->str_bv_in_mem_buf_len);
+    memcpy(((bytevector) bv)->data, p->str_bv_in_mem_buf,
+           p->str_bv_in_mem_buf_len);
     return_closcall1(data, cont, bv);
   }
 }
-

scheme/base.sld

@@ -145,6 +145,7 @@
     write-string-1
     write-string-2
     flush-output-port
+    char-ready?
     peek-char
     read-char
     read-line
@@ -204,23 +205,16 @@
     write-u8
     binary-port?
     textual-port?
-
+    rationalize
 ;;;;
 ; Possibly missing functions:
-;
 ;    u8-ready?
-;
-;    ; No complex or rational numbers at this time
-;    rationalize
-;
 ;    ;; syntax-rules
 ;;;;
   )
   (inline
     square
     quotient
-    numerator
-    denominator
     truncate
     negative?
     positive?
@@ -236,6 +230,9 @@
   (begin
     ;; Features implemented by this Scheme
     (define (features) 
+      (let ((feats *other-features*))
+        (if (> (string-length (Cyc-compilation-environment 'memory-streams)) 0)
+          (set! feats (cons 'memory-streams feats)))
         (cons 
           'cyclone
           (cons
@@ -243,7 +240,7 @@
               (string-append "version-" *version-number*))
             (cons
               (string->symbol (Cyc-compilation-environment 'platform))
-            *other-features*))))
+              feats)))))
 
     (define *other-features* 
             '(r7rs 
@@ -410,7 +407,7 @@
                   (else (error "cond-expand: bad feature" x)))
                 (memq x (features))))
           (let expand ((ls (cdr expr)))
-            (cond ((null? ls))  ; (error "cond-expand: no expansions" expr)
+            (cond ((null? ls)  (error "cond-expand: no expansions" expr))
                   ((not (pair? (car ls))) (error "cond-expand: bad clause" (car ls)))
                   ((eq? 'else (caar ls)) ;(identifier->symbol (caar ls)))
                    (if (pair? (cdr ls))
@@ -676,6 +673,14 @@
       (if (null? port)
         (_write-u8 chr (current-output-port))
         (_write-u8 chr (car port))))
+    (define-c Cyc-char-ready?
+      "(void *data, int argc, closure _, object k, object port)"
+      " object rv = Cyc_io_char_ready(data, port);
+        return_closcall1(data, k, rv); ")
+    (define (char-ready? . port)
+      (if (null? port)
+        (Cyc-char-ready? (current-input-port))
+        (Cyc-char-ready? (car port))))
     (define (peek-char . port)
       (if (null? port)
         (Cyc-peek-char (current-input-port))
@@ -684,10 +689,27 @@
       (if (null? port)
         (Cyc-read-char (current-input-port))
         (Cyc-read-char (car port))))
-    (define (read-line . port)
+    (define (read-line . o)
-      (if (null? port)
+      (let* ((port (if (null? o)
-        (Cyc-read-line (current-input-port))
+                       (current-input-port)
-        (Cyc-read-line (car port))))
+                       (car o)))
+             (str (Cyc-read-line port)))
+        (cond
+          ((eof-object? str) str)
+          ((< (string-length str) 1022) str)
+          (else (_read-line str port)))))
+    ;; Helper function to handle case where a line is too
+    ;; long to be read by a single runtime I/O call
+    (define (_read-line str port)
+      (let loop ((lis (list str))
+                 (str (Cyc-read-line port)))
+        (cond
+          ((eof-object? str)
+           (apply string-append (reverse lis)))
+          ((< (string-length str) 1022)
+           (apply string-append (reverse (cons str lis))))
+          (else
+            (loop (cons str lis) (Cyc-read-line port))))))
     (define (read-string k . opts)
       (let ((port (if (null? opts)
                       (current-input-port)
@@ -831,9 +853,9 @@
                    (car fill)))
                (make
                  (lambda (n obj)
-                   (if (zero? n)
+                   (if (> n 0)
-                   '()
+                   (cons obj (make (- n 1) obj) )
-                   (cons obj (make (- n 1) obj) )))))
+                   '() ))))
       (make k x)))
     (define (list-copy ls)
       (let lp ((ls ls) (res '()))
@@ -1229,13 +1251,16 @@
     (define error-object-message car)
     (define error-object-irritants cdr)
     (define (error msg . args)
-      (raise (cons msg args)))
+      (raise-error (cons msg args)))
     (define (raise obj)
       ((Cyc-current-exception-handler) 
-        (cons 'raised (if (pair? obj) obj (list obj)))))
+        (cons 'raised obj)))
     (define (raise-continuable obj)
       ((Cyc-current-exception-handler) 
-        (cons 'continuable (if (pair? obj) obj (list obj)))))
+        (cons 'continuable obj)))
+    (define (raise-error obj)
+      ((Cyc-current-exception-handler) 
+        (cons 'error obj)))
     ;; A simpler exception handler based on the one from Bigloo:
     ;; https://www-sop.inria.fr/indes/fp/Bigloo/doc/bigloo-17.html#g20889
     ;(define (with-handler handler body)
@@ -1335,25 +1360,29 @@
 
   (define-c floor
     "(void *data, int argc, closure _, object k, object z)"
-    " return_exact_double_op(data, k, floor, z); "
+    " return_double_op(data, k, floor, z); "
     "(void *data, object ptr, object z)"
-    " return_exact_double_op_no_cps(data, ptr, floor, z);")
+    " return_double_op_no_cps(data, ptr, floor, z);")
   (define-c ceiling
     "(void *data, int argc, closure _, object k, object z)"
-    " return_exact_double_op(data, k, ceil, z); "
+    " return_double_op(data, k, ceil, z); "
     "(void *data, object ptr, object z)"
-    " return_exact_double_op_no_cps(data, ptr, ceil, z);")
+    " return_double_op_no_cps(data, ptr, ceil, z);")
   (define-c truncate
     "(void *data, int argc, closure _, object k, object z)"
-    " return_exact_double_op(data, k, (int), z); "
+    " return_double_op(data, k, trunc, z); "
     "(void *data, object ptr, object z)"
-    " return_exact_double_op_no_cps(data, ptr, (int), z);")
+    " return_double_op_no_cps(data, ptr, trunc, z);")
   (define-c round
     "(void *data, int argc, closure _, object k, object z)"
-    " return_exact_double_op(data, k, round, z); "
+    " return_double_op(data, k, round_to_nearest_even, z); "
     "(void *data, object ptr, object z)"
-    " return_exact_double_op_no_cps(data, ptr, round, z);")
+    " return_double_op_no_cps(data, ptr, round_to_nearest_even, z);")
-  (define exact truncate)
+  (define-c exact
+    "(void *data, int argc, closure _, object k, object z)"
+    " Cyc_exact(data, k, z); "
+    "(void *data, object ptr, object z)"
+    " return Cyc_exact_no_cps(data, ptr, z);")
   (define-c inexact
     "(void *data, int argc, closure _, object k, object z)"
     " return_inexact_double_or_cplx_op(data, k, (double), (double complex), z); "
@@ -1368,6 +1397,9 @@
         alloc_bignum(data, bn);
         BIGNUM_CALL(mp_abs(&bignum_value(num), &bignum_value(bn)));
         return_closcall1(data, k, bn);
+      } else if (is_object_type(num) && type_of(num) == complex_num_tag){
+        make_double(d, cabs(((complex_num_type *)num)->value));
+        return_closcall1(data, k, &d);
       } else {
         make_double(d, fabs(((double_type *)num)->value));
         return_closcall1(data, k, &d);
@@ -1382,8 +1414,14 @@
       (if (< b 0)
         (if (<= res 0) res (+ res b))
         (if (>= res 0) res (+ res b)))))
-  (define (odd? num)   (= (modulo num 2) 1))
+  (define (odd? num)
-  (define (even? num)  (= (modulo num 2) 0))
+    (if (integer? num)
+        (= (modulo num 2) 1)
+        (error "Not an integer" num)))
+  (define (even? num) 
+    (if (integer? num)
+        (= (modulo num 2) 0)
+        (error "Not an integer" num)))
   (define-c bignum?
     "(void *data, int argc, closure _, object k, object obj)"
     " return_closcall1(data, k, Cyc_is_bignum(obj)); ")
@@ -1402,10 +1440,10 @@
       (error "exact non-negative integer required" k))
     (let* ((s (if (bignum? k)
                   (bignum-sqrt k)
-                  (exact (truncate (sqrt k)))))
+                  (exact (truncate (_sqrt k)))))
            (r (- k (* s s))))
       (values s r)))
-  (define-c sqrt
+  (define-c _sqrt
     "(void *data, int argc, closure _, object k, object z)"
     " return_inexact_double_op(data, k, sqrt, z);"
     "(void *data, object ptr, object z)"
@@ -1443,6 +1481,9 @@
     "(void *data, object ptr, object z)"
     " return Cyc_is_complex(z); ")
   (define rational? number?)
+  ;; Stub, doesn't do much now because rationals are not supported
+  (define (rationalize x y)
+    (/ x y))
   (define (max first . rest) (foldl (lambda (old new) (if (> old new) old new)) first rest))
   (define (min first . rest) (foldl (lambda (old new) (if (< old new) old new)) first rest))
   ; Implementations of gcd and lcm using Euclid's algorithm
@@ -1477,11 +1518,25 @@
   ;; END gcd lcm
 
   ;; Placeholders
-  (define (denominator n) 1)
+  (define-c numerator
-  (define (numerator n) n)
+    "(void *data, int argc, closure _, object k, object n)"
+    " Cyc_get_ratio(data, k, n, 1);")
+
+  (define-c denominator
+    "(void *data, int argc, closure _, object k, object n)"
+    " Cyc_get_ratio(data, k, n, 0);")
+
+  (define-c fixnum?
+    "(void *data, int argc, closure _, object k, object obj)"
+    " return_closcall1(data, k, 
+        obj_is_int(obj) ? boolean_t : boolean_f); "
+    "(void *data, object ptr, object obj)"
+    " return obj_is_int(obj) ? boolean_t : boolean_f; ")
 
   (define (quotient x y)
-    (truncate (/ x y)))
+    (if (and (fixnum? x) (fixnum? y))
+        (exact (truncate (/ x y)))
+        (truncate (/ x y))))
 
   (define truncate-quotient quotient)
   (define truncate-remainder remainder)
@@ -2106,7 +2161,10 @@
                (make-record-marker)
                (quote ,name)
                (,(rename 'vector)
-                ,@make-fields))))
+                ,@make-fields ;; Pass field values sent to constructor
+                ,@(make-list ;; And include empty slots for any other fields
+                    (- (length (cddddr expr))
+                       (length make-fields))) ))))
   )))))
 
 (define-syntax define-values

scheme/cyclone/cgen.sld

@@ -14,6 +14,7 @@
           (scheme inexact)
           (scheme write)
           (cyclone foreign)
+          (srfi 69)
           (scheme cyclone primitives)
           (scheme cyclone transforms)
           (scheme cyclone ast)
@@ -44,6 +45,7 @@
 (define *cgen:track-call-history* #t)
 (define *cgen:use-unsafe-prims* #f)
 (define *optimize-well-known-lambdas* #f)
+(define *ref-table* #f)
 
 (define (emit line)
   (display line)
@@ -67,6 +69,8 @@
   (letrec ((next (lambda (head tail)
                    (cond
                      ((null? head) (list->string (reverse tail)))
+                     ((equal? (car head) #\?) ;; Escape ? to avoid trigraphs
+                      (next (cdr head) (cons #\? (cons #\\ tail))))
                      ((equal? (car head) #\")
                       (next (cdr head) (cons #\" (cons #\\ tail))))
                      ((equal? (car head) #\\)
@@ -91,6 +95,7 @@
 {gc_thread_data *thd;
  long stack_size = global_stack_size = STACK_SIZE;
  long heap_size = global_heap_size = HEAP_SIZE;
+ init_polyfills();
  mclosure0(clos_halt,&Cyc_halt);  // Halt if final closure is reached
  mclosure0(entry_pt,&c_entry_pt); // First function to execute
  _cyc_argc = argc;
@@ -110,7 +115,7 @@
  return 0;}")
 
 ;;; Auto-generation of C macros
-(define *c-call-max-args* 128)
+(define *c-call-max-args* 10000)
 (define *c-call-arity* (make-vector (+ 1 *c-call-max-args*) #f))
 
 (define (set-c-call-arity! arity)
@@ -118,7 +123,12 @@
     ((not (number? arity))
      (error `(Non-numeric number of arguments received ,arity)))
     ((> arity *c-call-max-args*)
-     (error "Only support up to 128 arguments. Received: " arity))
+     (error 
+       (string-append
+         "Only support up to "
+         (number->string *c-call-max-args*)
+         " arguments. Received: ")
+       arity))
     (else
       (vector-set! *c-call-arity* arity #t))))
 
@@ -145,12 +155,12 @@
      ;;"/* Check for GC, then call given continuation closure */\n"
       "#define return_closcall" n "(td, clo" args ") { \\\n"
       " char top; \\\n"
-      " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
       " object buf[" n "]; " arry-assign "\\\n"
+      " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
       "     GC(td, clo, buf, " n "); \\\n"
       "     return; \\\n"
       " } else {\\\n"
-      "     closcall" n "(td, (closure) (clo)" args "); \\\n"
+      "     closcall" n "(td, (closure) (clo), buf); \\\n"
       "     return;\\\n"
       " } \\\n"
       "}\n")))
@@ -183,13 +193,13 @@
      ;;"/* Check for GC, then call C function directly */\n"
       "#define return_direct" n "(td, _fn" args ") { \\\n"
       " char top; \\\n"
-      " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
       " object buf[" n "]; " arry-assign " \\\n"
+      " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
       "     mclosure0(c1, (function_type) _fn); \\\n"
       "     GC(td, &c1, buf, " n "); \\\n"
       "     return; \\\n"
       " } else { \\\n"
-      "     (_fn)(td, " n ", (closure)_fn" args "); \\\n"
+      "     (_fn)(td, (closure)_fn, " n ", buf); \\\n"
       " }}\n")))
 
 (define (c-macro-return-direct-with-closure num-args)
@@ -200,12 +210,12 @@
      ;;"/* Check for GC, then call C function directly */\n"
       "#define return_direct_with_clo" n "(td, clo, _fn" args ") { \\\n"
       " char top; \\\n"
-      " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
       " object buf[" n "]; " arry-assign "\\\n"
+      " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
       "     GC(td, clo, buf, " n "); \\\n"
       "     return; \\\n"
       " } else { \\\n"
-      "     (_fn)(td, " n ", (closure)(clo)" args "); \\\n"
+      "     (_fn)(td, (closure)(clo), " n ", buf); \\\n"
       " }}\n")))
 
 ;; Generate hybrid macros that can call a function directly but also receives
@@ -218,13 +228,13 @@
      ;;"/* Check for GC, then call C function directly */\n"
       "#define return_direct_with_obj" n "(td, clo, _clo_fn, _fn" args ") { \\\n"
       " char top; \\\n"
-      " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
       " object buf[" n "]; " arry-assign "\\\n"
+      " if (stack_overflow(&top, (((gc_thread_data *)data)->stack_limit))) { \\\n"
       "     mclosure1(c1, (function_type) _clo_fn, clo); \\\n"
       "     GC(td, (closure)(&c1), buf, " n "); \\\n"
       "     return; \\\n"
       " } else { \\\n"
-      "     (_fn)(td, " n ", (closure)(clo)" args "); \\\n"
+      "     (_fn)(td, (closure)(clo), " n ", buf); \\\n"
       " }}\n")))
 
 (define (c-macro-closcall num-args)
@@ -233,12 +243,12 @@
         (n-1 (number->string (if (> num-args 0) (- num-args 1) 0)))
         (wrap (lambda (s) (if (> num-args 0) s ""))))
     (string-append
-      "#define closcall" n "(td, clo" args ") \\\n"
+      "#define closcall" n "(td, clo, buf) \\\n"
         (wrap (string-append "if (obj_is_not_closure(clo)) { \\\n"
-                             "   Cyc_apply(td, " n-1 ", (closure)(a1), clo" (if (> num-args 1) (substring args 3 (string-length args)) "") "); \\\n"
+                             "   Cyc_apply(td, clo, " n ", buf ); \\\n"
                              "}"))
         (wrap " else { \\\n")
-        "   ((clo)->fn)(td, " n ", clo" args ")"
+        "   ((clo)->fn)(td, clo, " n ", buf); \\\n"
         (wrap ";\\\n}"))))
 
 (define (c-macro-n-prefix n prefix)
@@ -709,6 +719,12 @@
 (define-c string-byte-length
   "(void *data, int argc, closure _, object k, object s)"
   " return_closcall1(data, k, Cyc_string_byte_length(data, s)); ")
+; cargs TODO:
+;(define-c string-byte-length
+;  "(void *data, object clo, int argc, object *args)"
+;  " Cyc_check_argc(data, \"string-byte-length\", argc, 2);
+;    object s = args[1];
+;    return_closcall1(data, args[0], Cyc_string_byte_length(data, s)); ")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Primitives
@@ -985,10 +1001,12 @@
            ;;(trace:info `(loop ,args ,(cadr args) ,cgen-lis ,parent-args))
            (c:code
              (string-append
-              cgen-allocs ; (c:allocs->str (c:allocs cgen))
+              cgen-allocs
                "\n"
-               cgen-body ; TODO: (c:body cgen) ; TODO: re-assign function args, longer-term using temp variables
+               cgen-body
                "\n"
+               ;; Avoid unused var warning from C compiler
+               (mangle (cadr args)) " = " (mangle (cadr args)) ";"
                "continue;"))))
          
         ((eq? 'Cyc-foreign-code fun)
@@ -1083,7 +1101,10 @@
                 (this-cont (c:body cfun))
                 (cargs (c-compile-args (cdr args) append-preamble "  " this-cont ast-id trace cps?))
                 (raw-cargs (cdddr cargs)) ; Same as above but with lists instead of appended strings
-                (num-cargs (c:num-args cargs)))
+                (num-cargs (c:num-args cargs))
+                (is-cont (and (equal? (length fun) 4)
+                              (cadddr fun))))
+;(trace:error `(JAE DEBUG ,is-cont ,fun))
            (cond
              ((not cps?)
               (c:code 
@@ -1200,6 +1221,18 @@
                           (if (> num-cargs 0) "," "")
                           (c:body cargs)
                           ");"))))
+                  (is-cont ;; Compiled continuation, can make a more efficient call
+                   (c:code 
+                     (string-append
+                       (c:allocs->str (c:allocs cfun) "\n")
+                       (c:allocs->str (c:allocs cargs) "\n")
+                       "return_direct_with_clo" (number->string (c:num-args cargs))
+                       "(data,"
+                       this-cont
+                       ", (((closure)" this-cont ")->fn)"
+                       (if (> (c:num-args cargs) 0) "," "")
+                       (c:body cargs)
+                       ");")))
                   (else
                     (c:code 
                       (string-append
@@ -1286,10 +1319,15 @@
          (let ((exps (foldr
                        (lambda (expr acc)
                          ;; Join expressions; based on c:append
-                         (let ((cp1 (if (ref? expr)
+                         (let ((cp1 (cond
+                                     ((ref? expr)
                                       ;; Ignore lone ref to avoid C warning
-                                        (c:code/vars "" '())
+                                      (c:code/vars "" '()))
-                                        (c-compile-exp expr append-preamble cont ast-id trace cps?)))
+                                     ((tagged-list? '%closure expr)
+                                      ;; Discard unused func and avoid C warning
+                                      (c:code/vars "" '()))
+                                     (else
+                                        (c-compile-exp expr append-preamble cont ast-id trace cps?))))
                                (cp2 acc))
                            (c:code/vars 
                              (let ((cp1-body (c:body cp1)))
@@ -1774,6 +1812,17 @@
              (and
                (> (string-length tmp-ident) 3)
                (equal? "self" (substring tmp-ident 0 4))))
+           (formals-as-list
+             (let ((lis (string-split formals #\,)))
+               (if (null? lis)
+                   (list formals)
+                   lis)))
+           (closure-name
+             (if has-closure? 
+                 (let* ((lis formals-as-list)
+                        (var (cadr (string-split (car lis) #\space))))
+                   var)
+                 "_"))
            (has-loop?
              (or
                (adbf:calls-self? (adb:get/default (ast:lambda-id exp) (adb:make-fnc)))
@@ -1790,6 +1839,55 @@
                         arg-closure
                         (string-append arg-closure ",")))
                 formals))
+           (c-formals
+             (cond
+               (cps?
+                (string-append
+                  "(void *data, object " closure-name ", int argc, object *args)"
+                  " /* " formals* " */\n"))
+               (else
+                (string-append
+                  "(void *data, " arg-argc
+                   formals*
+                  ")"))))
+           (c-arg-unpacking ;; Unpack args array into locals
+             (cond
+               ;; TODO: how to unpack varargs
+               (cps? 
+                (let ((i 0)
+                      (cstr "")
+                      (scm-args (ast:lambda-formals->list exp))
+                      (args formals-as-list))
+                  ;; Strip off extra varargs since we will load them
+                  ;; up using a different technique
+                  (when (ast:lambda-varargs? exp)
+                    (set! args
+                      (reverse
+                       (cddr (reverse args)))))
+                  ;; Generate code to unpack args into locals w/expected names
+                  (for-each
+                    (lambda (scm-arg arg)
+                      ;; Do not declare unused variables
+                      (when (and (hash-table-ref/default 
+                                    *ref-table*
+                                    scm-arg
+                                    #f))
+                        (set! cstr (string-append 
+                                     cstr
+                                     arg
+                                     " = args["
+                                     (number->string i)
+                                     "];"
+                                     )))
+                      (set! i (+ i 1))) 
+                    (if has-closure?
+                        (cdr scm-args)
+                        scm-args)
+                    (if has-closure?
+                        (cdr args)
+                        args))
+                  cstr))
+               (else "")))
            (env-closure (lambda->env exp))
            (body    (c-compile-exp     
                         (car (ast:lambda-body exp)) ; car ==> assume single expr in lambda body after CPS
@@ -1801,25 +1899,26 @@
      (cons 
       (lambda (name)
         (string-append "static " return-type " " name 
-                       "(void *data, " arg-argc
+                       c-formals
-                        formals*
+                       " {\n"
-                       ") {\n"
+                       c-arg-unpacking
+                       "\n"
                        preamble
                        (if (ast:lambda-varargs? exp)
                          ;; Load varargs from C stack into Scheme list
+                         (let ((num-fixargs (- (length (ast:lambda-formals->list exp)) 
+                                               1
+                                               (if has-closure? 1 0))))
                            (string-append 
                             ;; DEBUGGING:
                             ;; "printf(\"%d %d\\n\", argc, "
                             ;;  (number->string (length (ast:lambda-formals->list exp))) ");"
                              "load_varargs(" 
                              (mangle (ast:lambda-varargs-var exp))
-                           ", "
+                             ", args"
-                           (mangle (ast:lambda-varargs-var exp))
+                             ", " (number->string num-fixargs)
-                           "_raw, argc - " (number->string 
+                             ", argc - " (number->string num-fixargs)
-                                         (- (length (ast:lambda-formals->list exp)) 
+                             ");\n"))
-                                            1
-                                            (if has-closure? 1 0)))
-                           ");\n");
                          "") ; No varargs, skip
                        (c:serialize
                          (c:append
@@ -1886,6 +1985,7 @@
                       required-libs
                       src-file
                       flag-set?)
+  (set! *ref-table* (analyze:cc-ast->vars input-program)) ;; Walk input program to find used variables
   (set! *global-syms* (append globals (lib:idb:ids import-db)))
   (set! *cgen:track-call-history*  (flag-set? 'track-call-history))
   (set! *cgen:use-unsafe-prims*  (flag-set? 'use-unsafe-prims))
@@ -1992,8 +2092,10 @@
          (emit*
            "static void __lambda_" 
            (number->string (car l))
+           "(void *data, object clo, int argc, object *args) ;"
+           "/*"
            (cadadr l)
-           " ;"))
+           "*/"))
         ((equal? 'precompiled-inline-lambda (caadr l))
          (emit*
            "static object __lambda_" 
@@ -2009,9 +2111,12 @@
         (else
          (emit*
            "static void __lambda_" 
-           (number->string (car l)) "(void *data, int argc, "
+           (number->string (car l)) 
+           "(void *data, object clo, int argc, object *args) ;"
+           "/*"
            (cdadr l)
-           ") ;"))))
+           "*/"
+           ))))
      lambdas)
     
     (emit "")
@@ -2030,7 +2135,6 @@
             (when (and *optimize-well-known-lambdas*
                        (adbf:well-known fnc)
                        (equal? (adbf:closure-size fnc) 1))
-              ;; (trace:error `(JAE ,(car l) ,l ,fnc))
            (let* ((params-str (cdadr l))
                   (args-str
                     (string-join
@@ -2038,14 +2142,24 @@
                         (string-split
                           (string-replace-all params-str "object" "")
                           #\,))
-                      #\,)))
+                      #\,))
+                  (unpack-args-str
+                    (string-join
+                      (cdr
+                        (string-split
+                          (string-replace-all params-str "object" "")
+                          #\,))
+                      #\;))
+                  )
              (emit*
                "static void __lambda_gc_ret_"
                (number->string (car l))
-               "(void *data, int argc,"
+               "(void *data, int argc," ; cargs TODO: update this and call below
                params-str
                ")"
                "{"
+                 ;; cargs TODO: this is broken, will fix later
+                  unpack-args-str
                   "\nobject obj = "
                   "((closure1)" (mangle (car (adbf:all-params fnc))) ")->element;\n"
                   "__lambda_"
@@ -2060,15 +2174,33 @@
     ;; Print the definitions:
     (for-each
      (lambda (l)
+;(trace:error `(JAE def ,l))
       (cond
        ((equal? 'precompiled-lambda (caadr l))
+        (cond
+         ((equal? (substring (string-replace-all (cadadr l) " " "") 0 35)
+                  (string-replace-all "(void *data, int argc, closure _, object k" " " ""))
+           ;; Backwards compatibility for define-c expressions using
+           ;; the old style of all C parameters contained directly
+           ;; in the function definition. The above code finds them
+           ;; and below we emit code that unpacks the args array into
+           ;; a series of local variables
+           (emit*
+             "static void __lambda_" 
+             (number->string (car l))
+             "(void *data, object _, int argc, object *args)"
+             " {"
+             (c:old-c-args->new-decls-from-args (cadadr l))
+             (car (cddadr l))
+             " }"))
+         (else
            (emit*
              "static void __lambda_" 
              (number->string (car l))
              (cadadr l)
              " {"
              (car (cddadr l))
-           " }"))
+             " }"))))
        ((equal? 'precompiled-inline-lambda (caadr l))
          (emit*
            "static object __lambda_" 
@@ -2086,7 +2218,7 @@
     ;; Emit inlinable function list
     (cond
       ((not program?)
-        (emit* "void c_" (lib:name->string lib-name) "_inlinable_lambdas(void *data, int argc, closure _, object cont){ ")
+        (emit* "void c_" (lib:name->string lib-name) "_inlinable_lambdas(void *data, object clo, int argc, object *args){ ")
         (let ((pairs '())
               (head-pair #f))
           (for-each
@@ -2119,23 +2251,23 @@
                    (loop (cons (string-append "make_pair(" (car cs) ", &" (car ps) ", &" (cadr cs) ");\n") code)
                          (cdr ps) 
                          (cdr cs)))))
+          (emit* "object buf[1]; object cont = args[0];");  
           (if head-pair
-              (emit* "(((closure)cont)->fn)(data, 1, cont, &" head-pair ");")
+              (emit* "buf[0] = &" head-pair "; (((closure)cont)->fn)(data, cont, 1, buf);")
-              (emit* "(((closure)cont)->fn)(data, 1, cont, NULL);"))
+              (emit* "buf[0] = NULL; (((closure)cont)->fn)(data, cont, 1, buf);"))
           (emit* " } "))))
 
     ;; Emit entry point
     (cond
       (program?
-        (emit "static void c_entry_pt_first_lambda(void *data, int argc, closure cont, object value);")
+        (emit "static void c_entry_pt_first_lambda(void *data, object clo, int argc, object *args);")
         (for-each
           (lambda (lib-name)
-            (emit* "extern void c_" (lib:name->string lib-name) "_entry_pt(void *data, int argc, closure cont, object value);"))
+            (emit* "extern void c_" (lib:name->string lib-name) "_entry_pt(void *data, object clo, int argc, object* args);"))
           required-libs)
-        (emit "static void c_entry_pt(data, argc, env,cont) void *data; int argc; closure env,cont; { "))
+        (emit "static void c_entry_pt(void *data, object clo, int argc, object *args) { "))
       (else
-        (emit* "void c_" (lib:name->string lib-name) "_entry_pt_first_lambda(data, argc, cont,value) void *data; int argc; closure cont; object value;{ ")
+        (emit* "void c_" (lib:name->string lib-name) "_entry_pt_first_lambda(void *data, object clo, int argc, object *args){ ")
-        ;; DEBUG (emit (string-append "printf(\"init " (lib:name->string lib-name) "\\n\");"))
       ))
 
     ;; Set global-changed indicator
@@ -2264,27 +2396,27 @@
             (reverse required-libs)) ;; Init each lib's dependencies 1st
           (emit* 
             ;; Start cont chain, but do not assume closcall1 macro was defined
-            "(" this-clo ".fn)(data, 0, &" this-clo ", &" this-clo ");")
+            " object buf[1]; buf[0] = &" this-clo "; "
+            "(" this-clo ".fn)(data, &" this-clo ", 1, buf);")
           (emit "}")
-          (emit "static void c_entry_pt_first_lambda(void *data, int argc, closure cont, object value) {")
+          (emit "static void c_entry_pt_first_lambda(void *data, object clo, int argc, object *args) {")
-          ;; DEBUG (emit (string-append "printf(\"init first lambda\\n\");"))
           (emit compiled-program)
           (emit ";")))
       (else
         ;; Do not use closcall1 macro as it might not have been defined
-        (emit "cont = ((closure1_type *)cont)->element;")
+        (emit "object buf[1]; buf[0] = ((closure1_type *)clo)->element;")
         (emit* 
             "(((closure)"
             (cgen:mangle-global (lib:name->symbol lib-name)) 
-            ")->fn)(data, 1, cont, cont);")
+            ")->fn)(data, buf[0], 1, buf);")
 
         (emit* "}")
-        (emit* "void c_" (lib:name->string lib-name) "_entry_pt(data, argc, cont,value) void *data; int argc; closure cont; object value;{ ")
+        (emit* "void c_" (lib:name->string lib-name) "_entry_pt(void *data, object cont, int argc, object value){ ")
         (emit* "  register_library(\""
                (lib:name->unique-string lib-name)
                "\");")
         (if (null? lib-pass-thru-exports)
-            (emit* "  c_" (lib:name->string lib-name) "_entry_pt_first_lambda(data, argc, cont,value);")
+            (emit* "  c_" (lib:name->string lib-name) "_entry_pt_first_lambda(data, cont, argc, value);")
             ;; GC to ensure objects are moved when exporting exports.
             ;; Otherwise there will be broken hearts :(
             (emit*
@@ -2296,6 +2428,35 @@
     (if program?
       (emit *c-main-function*))))
 
+;; Take an old define-c CPS function definition string such as:
+;;
+;;   "(void *data, int argc, closure _, object k, object a, object b, object c)")
+;;
+;; And convert it to a series of local variable declarations, assigning a value
+;; from our new `args` parameter.
+;;
+;; These declarations are returned as a string.
+(define (c:old-c-args->new-decls-from-args cstr)
+  (let* ((args (cdddr 
+                 (string-split
+                   (filter-invalid-chars cstr)
+                   #\,))) ;; Get scheme list of any extra arguments
+         (vars (map (lambda (a) (cadr (string-split a #\space))) args)) ;; Get identifiers of variables
+         (i 0)
+         (str ""))
+    (for-each ;; Create a set of assignments from args array to new C local variables
+      (lambda (v)
+        (set! str (string-append str "object " v " = args[" (number->string i) "];"))
+        (set! i (+ i 1)))
+      vars)
+    str))
+
+(define (filter-invalid-chars str)
+  (list->string
+    (filter
+      (lambda (c)
+        (not (member c '(#\newline #\( #\)))))
+      (string->list str))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Automatically generate blocks of code for the compiler

scheme/cyclone/common.sld

@@ -18,7 +18,7 @@
     memloc
   )
   (begin
-(define *version-number* "0.27")
+(define *version-number* "0.37.0")
 (define *version-name* "")
 (define *version* (string-append *version-number* " " *version-name* ""))
 
@@ -32,7 +32,7 @@
        @@     @@     Cyclone Scheme->C compiler
       ,@             http://justinethier.github.io/cyclone/
       '@        
-      .@             (c) 2014-2021 Justin Ethier
+      .@             (c) 2014-2025 Justin Ethier
        @@     #@     Version " *version* "
        `@@@#@@@.
         #@@@@@   
@@ -49,7 +49,7 @@
  ** This file was automatically generated by the Cyclone scheme compiler
  ** http://justinethier.github.io/cyclone/
  **
- ** (c) 2014-2021 Justin Ethier
+ ** (c) 2014-2024 Justin Ethier
  ** Version " *version* "
  **
  **/

scheme/cyclone/cps-opt-analyze-call-graph.scm

@@ -20,7 +20,8 @@
             (srfi 2)
             (srfi 69)
             )
-    ))
+    )
+  (else #f))
 
 ;; symbol -> hash-table -> boolean
 ;; Is it OK to inline code replacing ref, based on call graph data from lookup table?
@@ -261,4 +262,5 @@
     ;  (ast:ast->pp-sexp
     ;    (opt:local-var-reduction (ast:sexp->ast sexp)))
     ;)
-))
+)
+(else #f))

scheme/cyclone/cps-opt-local-var-redux.scm

@@ -14,7 +14,9 @@
             (scheme cyclone ast) 
             (scheme cyclone primitives)
             (scheme cyclone util) 
-            (scheme cyclone pretty-print))))
+            (scheme cyclone pretty-print)))
+  (else
+    #f))
 
 ;; Local variable reduction:
 ;; Reduce given sexp by replacing certain lambda calls with a let containing
@@ -434,4 +436,5 @@
       (ast:ast->pp-sexp
         (opt:local-var-reduction (ast:sexp->ast sexp)))
     )
-    ))
+    )
+  (else #f))

scheme/cyclone/cps-opt-memoize-pure-fncs.scm

@@ -18,9 +18,9 @@
             (scheme cyclone util) 
             (scheme cyclone pretty-print)
             (srfi 2)
-            (srfi 69)
+            (srfi 69)))
-            )
+  (else
-    ))
+    #f))
 
 ;; Predicate to determine if a function can be memoized
 ;; var - symbol - global name of the function
@@ -371,4 +371,5 @@
 ;;    ;  (ast:ast->pp-sexp
 ;;    ;    (opt:local-var-reduction (ast:sexp->ast sexp)))
 ;;    ;)
-))
+)
+(else #f))

scheme/cyclone/cps-optimizations.sld

@@ -20,6 +20,7 @@
           (srfi 69))
   (export
       closure-convert 
+      analyze:cc-ast->vars
       pos-in-list 
       inlinable-top-level-lambda?
       optimize-cps 
@@ -344,6 +345,12 @@
       (let ((var (adb:get/default sym (adb:make-var))))
         (fnc var)))
 
+    ;; If var found in adb pass to callback and return result, else return #f
+    (define (if-var sym callback)
+      (let* ((var (adb:get/default sym #f))
+             (result (if var (callback var) #f)))
+        result))
+
     (define (with-fnc id callback)
       (let ((fnc (adb:get/default id (adb:make-fnc))))
         (callback fnc)))
@@ -1050,7 +1057,8 @@
                     (lambda (arg)
                       (and (prim-call? arg)
                            ;; Do not inline functions that are looping over lists, seems counter-productive
-                           (not (member (car arg) '( member assoc Cyc-fast-member Cyc-fast-assoc assq assv memq memv)))
+                           ;; Or functions that may be harmful to call more than once such as system
+                           (not (member (car arg) '( member assoc Cyc-fast-member Cyc-fast-assoc assq assv memq memv system)))
                            (not (prim:cont? (car arg)))))
                     (cdr exp))
                   ;; Disallow primitives that allocate a new obj,
@@ -1657,7 +1665,7 @@
 
     ;; Full beta expansion phase, make a pass over all of the program's AST
     (define (opt:beta-expand exp)
-;(write `(DEBUG opt:beta-expand ,exp)) (newline)
+      ;(trace:info `(opt:beta-expand ,exp)) (flush-output-port)
       (cond
        ((ast:lambda? exp)
         (ast:%make-lambda
@@ -1686,6 +1694,7 @@
        (else exp)))
 
     (define (analyze-cps exp)
+      ;(trace:info `(analyze-cps ,exp))
       (analyze:find-named-lets exp)
       (analyze:find-direct-recursive-calls exp)
       (analyze:find-recursive-calls exp)
@@ -1960,7 +1969,14 @@
          ((lambda? fn)   (error `(Unexpected lambda in closure-convert ,exp)))
          (else
            (let ((f (cc fn)))
-            `((%closure-ref ,f 0)
+            `((%closure-ref ,f 0
+                            ;; Indicate if closure refers to a compiled continuation
+                            ,@(if (and (symbol? fn)
+                                       (or
+                                         (if-var fn adbv:cont?)
+                                         (if-var fn adbv:global?)))
+                                 (list #t)
+                                 (list)))
               ,f
               ,@args))))))
     (else                
@@ -2080,6 +2096,51 @@
      (else exp)))
   (scan exp #f))
 
+;;; This function walks over a Closure-converted expression and 
+;;; builds a table of all variable references. This can be used 
+;;; to determine with certainty what variables are actually used.
+;;;
+;;; Returns a hash table where each key/var is a referenced var.
+(define (analyze:cc-ast->vars sexp)
+  (define %ht (make-hash-table))
+
+  (define (add! ref)
+    (hash-table-set! %ht ref ref))
+  
+  (define (scan exp)
+    (cond
+      ((ast:lambda? exp)
+       (scan
+        `(%closure ,exp)
+         ))
+      ((const? exp) #f)
+      ((prim?  exp) #f)     
+      ((ref?   exp) (add! exp))
+      ((quote? exp) #f)
+      ((if? exp)
+       (scan (if->condition exp))
+       (scan (if->then exp))
+       (scan (if->else exp)))
+      ((tagged-list? '%closure exp)
+       (let* ((lam (closure->lam exp))
+              (body (car (ast:lambda-body lam))))
+         (scan body)
+         (for-each scan (closure->fv exp))))
+      ;; Global definition
+      ((define? exp)
+       (scan (car (define->exp exp))))
+      ((define-c? exp)
+       #f)
+      
+      ;; Application:
+      ((app? exp)
+       (for-each scan exp))
+      (else
+        (error "unknown exp in analyze-cc-vars " exp))))
+
+  (for-each scan sexp)
+  %ht)
+
 ;; Find any top-level functions that call themselves directly
 (define (analyze:find-direct-recursive-calls exp)
   ;; Verify the continuation is simple and there is no closure allocation
@@ -2170,11 +2231,17 @@
       (scan (if->then exp) def-sym)
       (scan (if->else exp) def-sym))
      ((app? exp)
-      (when (equal? (car exp) def-sym)
+      ;(trace:info `(analyze:find-recursive-calls scan app ,exp))
+      (cond
+        ((equal? (car exp) def-sym)
          (trace:info `("recursive call" ,exp))
          (with-var! def-sym (lambda (var)
-          (adbv:set-self-rec-call! var #t)))
+           (adbv:set-self-rec-call! var #t))))
-        ))
+        (else
+          (for-each
+            (lambda (e)
+              (scan e def-sym))
+            exp))))
      (else #f)))
 
   ;; TODO: probably not good enough, what about recursive functions that are not top-level??

scheme/cyclone/libraries.sld

@@ -1,22 +1,16 @@
 ;;;; Cyclone Scheme
 ;;;; https://github.com/justinethier/cyclone
 ;;;;
-;;;; Copyright (c) 2014-2016, Justin Ethier
+;;;; Copyright (c) 2014-2021, Justin Ethier
 ;;;; All rights reserved.
 ;;;;
-;;;; This module implements r7rs libraries. In our compiler, these are used to
+;;;; This module implements r7rs libraries. 
-;;;; encapsulate C modules.
 ;;;;
-;;;; Initially, this a quicky-and-dirty (for now) implementation of r7rs libraries.
+;;;; Internally, our compiler uses libraries to encapsulate C modules.
-;;;;
-;;;; TODO: go through functions and ensure consistent naming conventions.
-;;;;   probably should also clean up some of the function names, this is
-;;;;   not a very clean or nice API at the moment.
 ;;;;
 (define-library (scheme cyclone libraries)
   (import (scheme base)
-          ;; Debug only 
+          ;(scheme write) ;; Debug only 
-          (scheme write)
           (scheme read)
           (scheme process-context)
           (scheme cyclone util)
@@ -78,6 +72,50 @@
   )
   (begin
 
+;; Alias friendlier names to SRFI libraries
+(define *srfi-aliases*
+  '( ;; Red Edition
+     ((scheme list)       (srfi 1))
+     ((scheme vector)     (srfi 133))
+     ((scheme sort)       (srfi 132))
+     ((scheme set)        (srfi 113))
+     ((scheme charset)    (srfi 14))
+     ;((scheme hash-table) (srfi 125))
+     ((scheme hash-table) (srfi 69)) ;; May upgrade this later
+     ((scheme ilist)      (srfi 116))
+     ((scheme rlist)      (srfi 101))
+     ((scheme ideque)     (srfi 134))
+     ;((scheme text)       (srfi 135))
+     ((scheme text)       (srfi 152)) ;; May replace with 135 later
+     ((scheme generator)  (srfi 121))
+     ((scheme lseq)       (srfi 127))
+     ((scheme stream)     (srfi 41))
+     ((scheme box)        (srfi 111))
+     ((scheme list-queue) (srfi 117))
+     ((scheme ephemeron)  (srfi 124))
+     ((scheme comparator) (srfi 128))
+     ;; Other SRFI's in Cyclone core
+     ((cyclone and-let*)      (srfi 2))
+     ((cyclone receive)       (srfi 8))
+     ((cyclone threads)       (srfi 18))
+     ((cyclone random)        (srfi 27))
+     ((cyclone format)        (srfi 28))
+     ((cyclone integer-bits)  (srfi 60))
+     ((cyclone socket)        (srfi 106))
+     ((cyclone fixnum)        (srfi 143))
+     ;; Other SRFI's in Winds packages
+     ((cyclone hooks)         (srfi 173))
+     ((cyclone chain)         (srfi 197))
+     ((cyclone assumptions)   (srfi 145))
+     ((cyclone cut)           (srfi 26)) ))
+
+(define (lib:rename-aliases import)
+  (let ((conv (assoc import *srfi-aliases*)))
+    (if conv 
+        (%lib:list->import-set (cadr conv))
+        import)))
+;; END aliases
+
 (define (library? ast)
   (tagged-list? 'define-library ast))
  
@@ -91,12 +129,19 @@
 ;; Convert a raw list to an import set. For example, a list might be
 ;; (srfi 18) containing the number 18. An import set contains only symbols
 ;; or sub-lists.
+;;
+;; This is also a convenient time to do any name conversions from an
+;; alias to the actual library.
 (define (lib:list->import-set lis)
+  (lib:rename-aliases
+    (%lib:list->import-set lis)))
+
+(define (%lib:list->import-set lis)
   (map
     (lambda (atom)
       (cond
         ((pair? atom)
-         (lib:list->import-set atom))
+         (%lib:list->import-set atom))
         ((number? atom)
          (string->symbol (number->string atom)))
         (else atom)))
@@ -241,10 +286,13 @@
 ;obviously also need to expand cond-expand in cases where the code reads sld files to track down library dependencies
 
 ;; Take given define-library expression and cond-expand all declarations
-(define (lib:cond-expand expr expander)
+(define (lib:cond-expand filepath expr expander)
+  ;; parametrize include, and include-ci during expand, inside
+  ;; expander.
+  (parameterize ((current-expand-filepath filepath))
     (let ((name (cadr expr))
           (decls (lib:cond-expand-decls (cddr expr) expander)))
-    `(define-library ,name ,@decls)))
+      `(define-library ,name ,@decls))))
 
 (define (lib:cond-expand-decls decls expander)
   (reverse
@@ -417,7 +465,7 @@
          (fp (open-input-file dir))
          (lib (read-all fp))
          (lib* (if expander
-                   (list (lib:cond-expand (car lib) expander))
+                   (list (lib:cond-expand dir (car lib) expander))
                    lib))
          (imports (lib:imports (car lib*))))
     (close-input-port fp)
@@ -440,7 +488,7 @@
          (fp (open-input-file dir))
          (lib (read-all fp))
          (lib* (if expander
-                   (list (lib:cond-expand (car lib) expander))
+                   (list (lib:cond-expand dir (car lib) expander))
                    lib))
          (options (lib:c-linker-options (car lib*))))
     (close-input-port fp)
@@ -460,7 +508,7 @@
          (fp (open-input-file dir))
          (lib (read-all fp))
          (lib* (if expander
-                   (list (lib:cond-expand (car lib) expander))
+                   (list (lib:cond-expand dir (car lib) expander))
                    lib))
          (options (lib:c-compiler-options (car lib*))))
     (close-input-port fp)
@@ -481,7 +529,7 @@
          (fp (open-input-file dir))
          (lib (read-all fp))
          (lib* (if expander
-                   (list (lib:cond-expand (car lib) expander))
+                   (list (lib:cond-expand dir (car lib) expander))
                    lib))
          (exports (lib:exports (car lib*))))
     (close-input-port fp)

scheme/cyclone/pass-validate-syntax.scm

@@ -14,7 +14,8 @@
       (scheme base)
       (scheme read)
       (scheme cyclone pretty-print)
-      (scheme cyclone util))))
+      (scheme cyclone util)))
+   (else #f))
 ;;
 ;; TODO: call this from cyclone.scm after it works, probably after "resolve macros"
 
@@ -59,7 +60,9 @@
   (define (search exp vars)
     (cond-expand
       (program
-        (pretty-print `(search ,exp ,vars))(newline))) ;; Debugging
+        (pretty-print `(search ,exp ,vars))(newline)) ;; Debugging
+      (else
+        #f))
     (cond
       ;((ast:lambda? exp) 'TODO)
       ((const? exp) #f)
@@ -111,4 +114,5 @@
     ;(if 1 2 3 4)
     
      (let ((sexp (read-all (open-input-file "validation.scm"))))
-      (validate-keyword-syntax sexp))))
+      (validate-keyword-syntax sexp)))
+  (else #f))

scheme/cyclone/primitives.sld

@@ -87,7 +87,6 @@
          Cyc-stdout
          Cyc-stdin
          Cyc-stderr
-         Cyc-list
          Cyc-if
          Cyc-foreign-code
          Cyc-foreign-value
@@ -531,7 +530,6 @@
          ((eq? p 'Cyc-stdout)            "Cyc_stdout")
          ((eq? p 'Cyc-stdin)             "Cyc_stdin")
          ((eq? p 'Cyc-stderr)            "Cyc_stderr")
-         ((eq? p 'Cyc-list)              "Cyc_list")
          ((eq? p 'Cyc-if)                "Cyc_if")
          ((eq? p 'Cyc-foreign-code)      "UNDEF")
          ((eq? p 'Cyc-foreign-value)     "UNDEF")
@@ -667,9 +665,9 @@
          ((eq? p 'Cyc-fast-member)  "memberp")
          ((eq? p 'Cyc-fast-assoc)   "assoc")
          ((eq? p 'assq)          "assq")
-         ((eq? p 'assv)          "assq")
+         ((eq? p 'assv)          "assv")
          ((eq? p 'memq)          "memqp")
-         ((eq? p 'memv)          "memqp")
+         ((eq? p 'memv)          "memvp")
          ((eq? p 'boolean?)      "Cyc_is_boolean")
          ((eq? p 'char?)         "Cyc_is_char")
          ((eq? p 'null?)         "Cyc_is_null")
@@ -706,7 +704,6 @@
     (define (prim/data-arg? p)
      (or
       (memq p '(
-        Cyc-list
         Cyc-foreign-code
         Cyc-foreign-value
         Cyc-fast-plus
@@ -963,7 +960,6 @@
                          set-cdr!
                          vector-set!
                          set-global!
-                         Cyc-list
                          Cyc-read-char Cyc-peek-char 
                          symbol->string list->string substring string-append string->number
                          make-bytevector
@@ -994,7 +990,6 @@
                            bytevector
                            bytevector-append
                            make-vector
-                           Cyc-list
                            = > < >= <=
                            + - * /))))
 

scheme/cyclone/transforms.sld

@@ -597,6 +597,7 @@ if (acc) {
                ;; global may still be init'd to NULL if the order is incorrect in the "top level"
                ;; initialization code.
                (symbol? (car (define->exp (car top-lvl)))) ;; TODO: put these at the end of top-lvl???
+               (vector? (car (define->exp (car top-lvl))))
                (and (list? (car (define->exp (car top-lvl))))
                     (not (lambda? (car (define->exp (car top-lvl)))))))
              (loop (cdr top-lvl)

scheme/cyclone/util.sld

@@ -93,7 +93,8 @@
     string-replace-all
     take
     drop
-    filter)
+    filter
+    current-expand-filepath)
   (inline
     env:frame-values
     env:frame-variables
@@ -113,6 +114,8 @@
   )
   (begin
 
+(define current-expand-filepath (make-parameter #f))
+
 (define (tagged-list? tag exp)
   (if (pair? exp)
       (equal? (car exp) tag)

scheme/eval.sld

@@ -89,17 +89,26 @@
       ((analyze exp *global-environment* rename-env '()) *global-environment*)
       ((analyze exp (car env) rename-env '()) (car env))))
 
+;; Called from the C runtime to support apply
 (define (eval-from-c exp . _env)
   (let ((env (if (null? _env) *global-environment* (car _env))))
     (eval (wrapc exp) env)))
 
-;; Expressions received from C code are already evaluated, but sometimes too much so.
+;; Helper function for eval-from-c
-;; Try to wrap 
+;; 
+;; Expressions received from C code are already evaluated, 
+;; however any quoted expressions will have the quotes
+;; stripped off. This is a problem for expressions that
+;; aren't self evaluating - like (1 2) - so we re-quote
+;; the expressions here so a subsequent eval will work.
+;;
 (define (wrapc exp)
   (cond 
     ((application? exp)
      (cond
-       ((compound-procedure? (car exp))
+       ((or (primitive-procedure? (car exp)) 
+            (compound-procedure? (car exp))
+            (procedure? (car exp)))
         (cons 
           (car exp)
           (map 
@@ -611,19 +620,19 @@
                   #f))
          (expand 
            (lambda (macro-op)
-             ;(define use-env (env:extend-environment '() '() '()))
              (if (Cyc-macro? macro-op)
                ;; Compiled macro, call directly
-               (let ((expanded
+               (let* ((expanded (_expand exp a-env rename-env '() local-renamed))
-                        (macro:expand exp (list 'macro macro-op) a-env rename-env local-renamed)))
+                      (cleaned (macro:cleanup expanded rename-env)))
-                 (analyze expanded 
+                 (analyze cleaned
                           a-env
                           rename-env
                           local-renamed))
                ;; Interpreted macro, build expression and eval
-               (let* ((expanded (macro:expand exp (list 'macro macro-op) a-env rename-env local-renamed)))
+               (let* ((expanded (_expand exp a-env rename-env '() local-renamed))
+                      (cleaned (macro:cleanup expanded rename-env)))
                  (analyze
-                   expanded
+                   cleaned
                    a-env
                    rename-env
                    local-renamed))))))
@@ -636,14 +645,9 @@
 ;(display "/* ")
 ;(write (list exp))
 ;(display "*/ ")
-       (let ((fncs 
+       (let ((fncs (Cyc-map-loop-1 (lambda (expr) 
-               ;; Our map starts from the end, we reverse
-               ;; so everything is evaluated in order, then
-               ;; reverse again so results are in order
-               (reverse
-                 (map (lambda (expr) 
                                       (analyze expr a-env rename-env local-renamed))
-                      (reverse (cdr exp))))))
+                                   (cdr exp))))
          (lambda (env)
            (foldl (lambda (fnc _) (fnc env)) #f fncs))))
       ;; compiled macro
@@ -917,6 +921,10 @@
 ;(newline)
 ;(display "*/ ")
          (cond 
+           ((and (pair? expr) ;; Improper list
+                 (not (list? expr)))
+            (cons (clean (car expr) bv)
+                  (clean (cdr expr) bv)))
            ((const? expr)      expr)
            ((null? expr)       expr)
            ((quote? expr)      
@@ -978,8 +986,14 @@
 ;TODO: modify this whole section to use macros:get-env instead of *defined-macros*. macro:get-env becomes the mac-env. any new scopes need to extend that env, and an env parameter needs to be added to (expand). any macros defined with define-syntax use that env as their mac-env (how to store that)?
 ; expand : exp -> exp
 
-(define (expand exp env rename-env)
+(define (expand exp . opts)
-  (_expand exp env rename-env '() '()))
+  (let ((env (if (> (length opts) 0) 
+                 (car opts)
+                 *global-environment*))
+        (rename-env (if (> (length opts) 1) 
+                        (cadr opts) 
+                        (env:extend-environment '() '() '()))))
+    (_expand exp env rename-env '() '())))
 
 ;; Internal implementation of expand
 ;; exp - Expression to expand

scheme/inexact.sld

@@ -69,7 +69,6 @@
             (/ (c-log z1) (c-log z2*)))))
     (define-inexact-op c-log "log"   "clog")
     (define-inexact-op exp   "exp"   "cexp")
-    (define-inexact-op sqrt  "sqrt"  "csqrt")
     (define-inexact-op sin   "sin"   "csin")
     (define-inexact-op cos   "cos"   "ccos")
     (define-inexact-op tan   "tan"   "ctan")
@@ -93,4 +92,58 @@
                         (* (if (eqv? y -0.0) -1 1)
                            (if (eqv? x -0.0) 3.141592653589793 x))
                         (atan1 (/ y x))))))))
+
+ (define-c
+   sqrt
+   "(void *data, int argc, closure _, object k, object z)"
+   " double complex result;
+     Cyc_check_num(data, z);
+     if (obj_is_int(z)) {
+       result = csqrt(obj_obj2int(z));
+     } else if (type_of(z) == integer_tag) {
+       result = csqrt(((integer_type *)z)->value);
+     } else if (type_of(z) == bignum_tag) {
+       result = csqrt(mp_get_double(&bignum_value(z)));
+     } else if (type_of(z) == complex_num_tag) {
+       result = csqrt(complex_num_value(z));
+     } else {
+       result = csqrt(((double_type *)z)->value);
+     }
+   
+     if (cimag(result) == 0.0) {
+       if (obj_is_int(z) && creal(result) == round(creal(result))) {
+         return_closcall1(data, k, obj_int2obj(creal(result)));
+       }
+       make_double(d, creal(result));
+       return_closcall1(data, k, &d);
+     } else {
+       complex_num_type cn;
+       assign_complex_num((&cn), result);
+       return_closcall1(data, k, &cn);
+     } "
+   "(void *data, object ptr, object z)"
+   " double complex result;
+     Cyc_check_num(data, z);
+     if (obj_is_int(z)) {
+       result = csqrt(obj_obj2int(z));
+     } else if (type_of(z) == integer_tag) {
+       result = csqrt(((integer_type *)z)->value);
+     } else if (type_of(z) == bignum_tag) {
+       result = csqrt(mp_get_double(&bignum_value(z)));
+     } else if (type_of(z) == complex_num_tag) {
+       result = csqrt(complex_num_value(z));
+     } else {
+       result = csqrt(((double_type *)z)->value);
+     }
+  
+     if (cimag(result) == 0.0) {
+       if (obj_is_int(z) && creal(result) == round(creal(result))) {
+         return obj_int2obj(creal(result));
+       }
+       assign_double(ptr, creal(result));
+     } else {
+       assign_complex_num(ptr, result);
+     }
+     return ptr;
+     ")
 ))

scheme/read.sld

@@ -9,6 +9,7 @@
 (define-library (scheme read)
   (import (scheme base)
           (scheme cyclone common)
+          (scheme cyclone util)
           ;(scheme write)
           (scheme char))
   (export
@@ -31,17 +32,37 @@
 (define-syntax include
   (er-macro-transformer
    (lambda (expr rename compare)
-     (apply
+
-      append
+     (define (dirname filename)
-      (cons
+       (let loop ((index (string-length filename)))
-        '(begin)
+         (if (zero? index)
-         (map
+             ""
-          (lambda (filename)
+             (let ((index (- index 1)))
+               (if (char=? (string-ref filename index) #\/)
+                   (substring filename 0 index)
+                   (loop index))))))
+
+     (define (massage filename)
+       (cond
+        ;; may happen in the REPL
+        ((not (current-expand-filepath)) filename)
+        ;; absolute filename
+        ((char=? (string-ref filename 0) #\/) filename)
+        ;; otherwise, open the file relative to the library that is
+        ;; expanded
+        (else (let ((target (string-append (dirname (current-expand-filepath)) "/" filename)))
+                ;; if the target exists use, otherwise fallback to the
+                ;; backward compatible behavior.
+                (if (file-exists? target)
+                    target
+                    filename)))))
+
+     `(begin
+        ,@(let ((filename (massage (cadr expr))))
             (call-with-port
               (open-input-file filename)
               (lambda (port)
-                (read-all/source port filename))))
+                (read-all/source port filename))))))))
-          (cdr expr)))))))
 
 (define-syntax include-ci
   (er-macro-transformer
@@ -116,8 +137,11 @@
   " Cyc_io_read_token(data, k, port);")
 
 (define-c read-error
-  "(void *data, int argc, closure _, object k, object port, object filename, object msg)"
+  "(void *data, object _, int argc, object *args)"
-  " char buf[1024];
+  " object port = args[1];
+    object filename = args[2];
+    object msg = args[3];
+    char buf[1024];
     port_type *p;
     Cyc_check_port(data, port);
     Cyc_check_str(data, msg);
@@ -155,6 +179,12 @@
   "(void *data, object ptr, object opq)"
   " return(Cyc_is_string(opaque_ptr(opq)));")
 
+(define-c Cyc-opaque->string
+  "(void *data, int argc, closure _, object k, object opq)"
+  " return_closcall1(data, k, opaque_ptr(opq));"
+  "(void *data, object ptr, object opq)"
+  " return(opaque_ptr(opq));")
+
 (define-c Cyc-opaque-unsafe-string->number
   "(void *data, int argc, closure _, object k, object opq)"
   " Cyc_string2number_(data, k, opaque_ptr(opq));")
@@ -202,7 +232,10 @@
       ((Cyc-opaque? token)
        (cond
          ((Cyc-opaque-unsafe-string? token)
-          (Cyc-opaque-unsafe-string->number token))
+          (let ((rv (Cyc-opaque-unsafe-string->number token)))
+            (if rv
+                rv
+                (error "Invalid numeric syntax" (Cyc-opaque->string token)))))
          ;; Open paren, start read loop
          ((Cyc-opaque-unsafe-eq? token #\()
           (let ((line-num (get-line-num fp))
@@ -261,7 +294,10 @@
                                    (substring t 0 end)
                                    (substring t end (- len 1))))
                      (real (string->number real-str))
-                     (imag (string->number imag-str))
+                     (imag (cond
+                             ((equal? "+" imag-str) 1)  ;; Special case, +i w/no number
+                             ((equal? "-" imag-str) -1) ;; Special case, -i
+                             (else (string->number imag-str))))
                     )
                 (Cyc-make-rect real imag)))
              (else

scheme/repl.sld

@@ -20,9 +20,9 @@
     (define (repl)
       (with-handler
         (lambda (obj)
-          (display "Error: ")
           (cond
             ((error-object? obj)
+             (display "Error: ")
              (display (error-object-message obj))
              (if (not (null? (error-object-irritants obj)))
                  (display ": "))
@@ -31,27 +31,19 @@
                  (write o)
                  (display " "))
                (error-object-irritants obj)))
-            ((pair? obj)
-             (when (string? (car obj))
-               (display (car obj))
-               (if (not (null? (cdr obj)))
-                   (display ": "))
-               (set! obj (cdr obj)))
-             (for-each
-               (lambda (o)
-                 (write o)
-                 (display " "))
-               obj))
             (else
+              (display "Error: ")
               (display obj)))
           (newline)
           (repl))
         (display "cyclone> ")
-        (let ((c (eval (read))))
+        (flush-output-port)
-          (cond
+        (let ((obj (read)))
-            ((not (eof-object? c))
+          (if (eof-object? obj)
-             (write c)
+              (newline) ;; Quick way to exit REPL
+              (let ((c (eval obj)))
+                (if (eof-object? c)
+                    (display "<EOF>")
+                    (write c))
                 (newline)
-             (repl))
+                (repl))))))))
-            (else 
-              (display "\n"))))))))

scheme/time.sld

@@ -26,21 +26,6 @@
         make_double(box, 0.0);
         clock_gettime(CLOCK_MONOTONIC, &now);
         long long jiffy = (now.tv_sec)*1000000LL + now.tv_nsec/1000; // nano->microseconds
-        /* Future consideration:
-        mp_int bn_tmp, bn_tmp2, bn_tmp3;
-        mp_init(&bn_tmp);
-        mp_init(&bn_tmp2);
-        mp_init(&bn_tmp3);
-        Cyc_int2bignum(tv.tv_sec, &bn_tmp);
-        Cyc_int2bignum(1000000LL, &bn_tmp2);
-        Cyc_int2bignum(tv.tv_usec, &bn_tmp3);
-        alloc_bignum(data, box);
-        mp_mul(&bn_tmp, &bn_tmp2, &bn_tmp);
-        mp_add(&bn_tmp, &bn_tmp3, &bignum_value(box)); 
-        mp_clear(&bn_tmp);
-        mp_clear(&bn_tmp2);
-        mp_clear(&bn_tmp3);
-        */
         double_value(&box) = jiffy;
         return_closcall1(data, k, &box); ")
     (define-c jiffies-per-second

scripts/check-c-formatting.sh

@@ -0,0 +1,16 @@
+#!/bin/bash
+
+FORMAT_CMD="indent -linux -l80 -i2 -nut"
+FILE=$1
+TMP=$(mktemp)
+
+$FORMAT_CMD $FILE -o $TMP
+
+diff $FILE $TMP > /dev/null
+#ret=$?
+#
+#if [[ $ret -eq 0 ]]; then
+#    echo "passed."
+#else
+#    echo "failed."
+#fi

scripts/convert-doc-index.scm

@@ -48,7 +48,7 @@
   (when (not (eof-object? line))
     (with-handler
       (lambda (obj)
-        (display `(Error processing line ,line details ,obj)))
+        (display `(Error processing line ,line details ,obj) (current-error-port)))
       (display (convert-line line))
       (newline))
         

scripts/generate-doc-index.sh

@@ -2,7 +2,7 @@
 # Cyclone Scheme
 # https://github.com/justinethier/cyclone
 #
-# Copyright (c) 2014-2016, Justin Ethier
+# Copyright (c) 2014-2022, Justin Ethier
 # All rights reserved.
 #
 # Generate a sorted list of functions/variables from the API documentation.
@@ -18,3 +18,30 @@ grep -r "^- \[" docs/api/srfi/* | ./scripts/convert-doc-index >> $TMP
 grep -r "^\[" docs/api/srfi/* | ./scripts/convert-doc-index >> $TMP
 grep -r "^\[" docs/api/cyclone/* | ./scripts/convert-doc-index >> $TMP
 sort $TMP | ./scripts/alphabetize > $API
+
+# --------------------------------------------------------------------------------
+# Index with SEXP format (needed by Winds)
+# The sed command bellow transforms...
+
+#                                        ; newline
+#- - -                                   ; hyphens used as sections divs
+#[`abs`](api/scheme/base.md#abs)         ; Markdown link
+#[`acos`](api/scheme/inexact.md#acos)    ; Markdown link
+
+# ...into...
+
+#((abs (scheme base))                     ; ((definition1 library-that-contains-it)
+# (acos (scheme inexact)))                ;  (definition2 library-that-contains-it))
+
+API_SEXP=api-index.scm
+sed -e '/^-\|^$/d'           \
+    -e 's/\[`/(/'            \
+    -e 's/`\](api\// (/'     \
+    -e 's/.md.*$/))/'        \
+    -e 's/\// /g'            \
+    -e 's/[[:space:]]\+/ /g' $API > $API_SEXP
+
+# Add extra opening and closing parentheses
+sed -e '1s/^/(/'             \
+    -e '$s/$/)/'             \
+    -i $API_SEXP

srfi/106.sld

@@ -388,7 +388,7 @@
 #ifdef AI_V4MAPPED
       return_closcall1(data, k, obj_int2obj(AI_V4MAPPED)); 
 #else
-      Cyc_rt_raise_msg(data, \"AI_V4MAPPED is not available on this platform\");
+      return_closcall1(data, k, obj_int2obj(0)); 
 #endif
       ")
     (define *ai-all* (ai-all))
@@ -398,7 +398,7 @@
 #ifdef AI_ALL
       return_closcall1(data, k, obj_int2obj(AI_ALL)); 
 #else
-      Cyc_rt_raise_msg(data, \"AI_ALL is not available on this platform\");
+      return_closcall1(data, k, obj_int2obj(0)); 
 #endif
       ")
     (make-const ai-addrconfig  "AI_ADDRCONFIG" )

srfi/143.sld

@@ -36,9 +36,6 @@
     fxbit-field-rotate fxbit-field-reverse
   )
   (inline
-    fx-width
-    fx-greatest
-    fx-least
     fixnum?
     fx=?  fx<? fx>? fx<=? fx>=?
     fxzero? fxpositive? fxnegative? fxodd? fxeven?
@@ -50,15 +47,15 @@
     fxarithmetic-shift 
     fxarithmetic-shift-left fxarithmetic-shift-right
     fxbit-count 
-    fxif fxbit-set? fxcopy-bit
+    fxif fxcopy-bit
     fxfirst-set-bit 
     fxbit-field
     mask
   )
   (begin
-    (define (fx-width) 31)
+    (define fx-width 31)
-    (define (fx-greatest) 1073741823)
+    (define fx-greatest 1073741823)
-    (define (fx-least)   -1073741824)
+    (define fx-least   -1073741824)
 
     (define-syntax bin-num-op
       (er-macro-transformer
@@ -161,16 +158,22 @@
          return_closcall1(data, k, obj_int2obj(count));")
 
     (define (fxlength  i)
+      (exact 
         (ceiling (/ (log (if (fxnegative? i)
                              (fxneg i)
                              (fx+ 1 i)))
-                  (log 2))))
+                    (log 2)))))
 
     (define (fxif mask n0 n1)
       (fxior (fxand mask n0)
              (fxand (fxnot mask) n1)))
 
-    (define-c fxbit-set?
+    (define (fxbit-set? index i)
+      (or (%fxbit-set? index i)
+          (and (negative? i)
+               (>= index (fxlength i)))))
+
+    (define-c %fxbit-set?
        "(void* data, int argc, closure _, object k, object index, object i)"
        " Cyc_check_fixnum(data, index);
          Cyc_check_fixnum(data, i);

srfi/18.sld

@@ -73,6 +73,8 @@
         ;; - specific
         ;; - internal
         ;; - end of thread cont (or #f for default)
+        ;; - end-result - Result of thread that terminates successfully
+        ;; - internal thread context at termination, e.g. parameterised objects
         (vector 
           'cyc-thread-obj 
           thunk 
@@ -80,6 +82,8 @@
           name-str 
           #f 
           #f
+          #f
+          #f
           #f)))
 
     (define (thread-name t) (vector-ref t 3))
@@ -96,7 +100,7 @@
       (%get-thread-data))
 
     (define *primordial-thread*
-      (vector 'cyc-thread-obj #f #f "main thread" #f #f))
+      (vector 'cyc-thread-obj #f #f "main thread" #f #f #f #f))
 
     (define-c %current-thread
       "(void *data, int argc, closure _, object k)"
@@ -116,23 +120,55 @@
         make_c_opaque(co, td);
         return_closcall1(data, k, &co); ")
 
+    (define-c %end-thread!
+      "(void *data, int argc, closure _, object k, object ret)"
+      " gc_thread_data *d = data;
+        vector_type *v = d->scm_thread_obj;
+        v->elements[7] = ret;     // Store thread result
+        Cyc_end_thread(d);
+        return_closcall1(data, k, boolean_f);")
+
     (define (thread-start! t)
       ;; Initiate a GC prior to running the thread, in case
       ;; it contains any closures on the "parent" thread's stack
       (let* ((thunk (vector-ref t 1)) 
              (thread-params (cons t (lambda ()
                                       (vector-set! t 5 #f)
-                                      (thunk)))))
+                                      (let ((r (thunk))) (%end-thread! r))))))
         (vector-set! t 5 (%get-thread-data)) ;; Temporarily make parent thread
                                              ;; data available for child init
         (Cyc-minor-gc)
         (Cyc-spawn-thread! thread-params)
-        ))
+        t))
 
     (define (thread-yield!) (thread-sleep! 1))
-    (define-c thread-terminate!
+
-      "(void *data, int argc, closure _, object k)"
+    (define-c %thread-terminate!
-      " Cyc_end_thread(data); ")
+      "(void *data, int argc, closure _, object k, object thread_data_opaque)"
+      " gc_thread_data *td;
+        if (thread_data_opaque == boolean_f) {
+          /* primordial thread */
+          __halt(boolean_f);
+        } else {
+          td = (gc_thread_data *)(opaque_ptr(thread_data_opaque));
+          if (td == data) {
+            Cyc_end_thread(td);
+          } else {
+            pthread_cancel(td->thread_id);
+          }
+        }
+        return_closcall1(data, k, boolean_t);")
+    (define (thread-terminate! t)
+      (cond
+       ((and (thread? t)
+             (or (Cyc-opaque? (vector-ref t 2)) (equal? *primordial-thread* t)))
+        (begin
+         (Cyc-minor-gc)
+         (vector-set! t 5 (%get-thread-data)) ;; remember calling thread
+         (%thread-terminate! (vector-ref t 2))
+         #t))
+       (else
+        #f))) ;; TODO: raise an error instead?
 
     ;; TODO: not good enough, need to return value from thread
     ;; TODO: perhaps not an ideal solution using a loop/polling below, but good
@@ -151,9 +187,13 @@
         }
         return_thread_runnable(data, boolean_t);")
     (define (thread-join! t)
-      (if (and (thread? t) (Cyc-opaque? (vector-ref t 2)))
+      (cond
+       ((and (thread? t) (Cyc-opaque? (vector-ref t 2)))
         (%thread-join! (vector-ref t 2))
-        #f))
+        (Cyc-minor-gc)
+        (vector-ref t 7))
+       (else
+        #f))) ;; TODO: raise an error instead?
 
     (define-c thread-sleep!
       "(void *data, int argc, closure _, object k, object timeout)"

test-lib.c

@@ -0,0 +1,51 @@
+#include <stdio.h>
+#include <assert.h>
+#include "include/cyclone/types.h"
+#include "include/cyclone/runtime.h"
+#include "include/cyclone/runtime-main.h"
+
+/* Future considerations:
+int main(int argc, char **argv, char **envp)
+{gc_thread_data *thd;
+ long stack_size = global_stack_size = STACK_SIZE;
+ long heap_size = global_heap_size = HEAP_SIZE;
+ init_polyfills();
+ mclosure0(clos_halt,&Cyc_halt);  // Halt if final closure is reached
+ mclosure0(entry_pt,&c_entry_pt); // First function to execute
+ _cyc_argc = argc;
+ _cyc_argv = argv;
+ set_env_variables(envp);
+ gc_initialize();
+ thd = malloc(sizeof(gc_thread_data));
+ gc_thread_data_init(thd, 0, (char *) &stack_size, stack_size);
+ thd->gc_cont = &entry_pt;
+ thd->gc_args[0] = &clos_halt;
+ thd->gc_num_args = 1;
+ thd->thread_id = pthread_self();
+ gc_add_mutator(thd);
+ Cyc_heap_init(heap_size);
+ thd->thread_state = CYC_THREAD_STATE_RUNNABLE;
+ Cyc_start_trampoline(thd);
+ return 0;}
+ */
+
+void test_exact() {
+  common_type ptr;
+  make_double(d, 42.5);
+  assert(obj_int2obj(42) == Cyc_exact_no_cps(NULL, &ptr, obj_int2obj(42)));
+  object result = Cyc_exact_no_cps(NULL, &ptr, &d);
+  assert( result == obj_int2obj(43));
+
+  // TODO: unit tests for below as examples:
+  //void Cyc_exact(void *data, object cont, object z)
+}
+
+int main(){
+  assert(boolean_t == boolean_t);
+  assert(boolean_t != boolean_f);
+
+  test_exact();
+
+  printf("All tests passed successfully!\n");
+  return 0;
+}

tests/base.scm

@@ -0,0 +1,217 @@
+;;;; Cyclone Scheme
+;;;; https://github.com/justinethier/cyclone
+;;;;
+;;;; Copyright (c) 2014-2021, Justin Ethier
+;;;; All rights reserved.
+;;;;
+;;;; This module contains unit tests for threading / SRFI 18.
+;;;;
+
+(import 
+  (scheme base)
+  (scheme eval)
+  (scheme inexact)
+  (scheme write)
+  (cyclone test))
+
+
+(define vec #(1 2))
+
+(test-group
+  "vector literals"
+  (test #(1 2) vec)
+  (test vec (vector 1 2))
+)
+
+(test-group
+  "strings"
+  (test "??>" "??>")
+)
+
+(test-group
+  "make-list"
+  (test '() (make-list -2))
+)
+
+(test-group
+  "apply"
+  (test '(5 1 2) (eval '(apply cons '(5 (1 2)))))
+  (test '(5 1 2) (apply cons '(5 (1 2))))
+)
+
+(cond-expand
+  (memory streams
+    (test-group
+      "I/O"
+      (define p (open-input-string "one\ntwo\n"))
+      (test #\o (read-char p))
+      (test "ne" (read-line p))
+      (test "two" (read-line p))
+      (test (eof-object) (read-line p))
+      (define p (open-input-string "one\ntwo\n"))
+      (test "one" (read-line p))
+      (test #\t (read-char p))
+      (test #\w (read-char p))
+      (test "o" (read-line p))
+    )
+  )
+  (else #f)
+)
+
+(test-group
+  "rationals"
+  (test 3.0 (numerator (/ 6 4)))
+  (test 2.0 (denominator (/ 6 4)))
+  (test 3.0 (expt 81 1/4))
+  (test #t
+    (< 1.0e+40 
+       (/ 33333333333333333333333333333333333333333 3.0)
+       1.2e+40))
+)
+
+(test-group
+  "numeric operations - floor, truncate, "
+  (test -1 (truncate -1))
+  (test -1.0 (truncate -1.0))
+  (test -1.0 (truncate -1.1))
+  (test -1.0 (truncate -1.1))
+  (test +inf.0 (truncate +inf.0))
+
+  (test (values 2 1) (floor/ 5 2))
+  (test (values -3 1) (floor/ -5 2))
+  (test (values -3 -1) (floor/ 5 -2))
+  (test (values 2 -1) (floor/ -5 -2))
+  (test (values 2 1) (truncate/ 5 2))
+  (test (values -2 -1) (truncate/ -5 2))
+  (test (values -2 1) (truncate/ 5 -2))
+  (test (values 2 -1) (truncate/ -5 -2))
+  (test (values 2.0 -1.0) (truncate/ -5.0 -2))
+
+  (test 4 (gcd 32 -36))
+  (test 0 (gcd))
+  (test 288 (lcm 32 -36))
+  (test 288.0 (lcm 32.0 -36))
+  (test 1 (lcm))
+
+  (test -5.0 (floor -4.3))
+  (test -4.0 (ceiling -4.3))
+  (test -4.0 (truncate -4.3))
+  (test -4.0 (round -4.3))
+  (test 3.0  (floor 3.5))
+  (test 4.0  (ceiling 3.5))
+  (test 3.0  (truncate 3.5))
+  (test 4.0  (round 3.5))
+  (test 2.0  (round 2.5))
+  (test -4.0 (round -3.5))
+  (test -2.0 (round -2.5))
+  (test 4.0  (round 7/2)) ;; Rationals not supported, so result is inexact
+  (test 7    (round 7))
+
+  (test 3.0 (numerator (/ 6 4))) ;; Inexact because we don't support rationals yet
+  (test 2.0 (denominator (/ 6 4))) ;; Inexact because we don't support rationals yet
+  (test 2.0 (denominator (inexact (/ 6 4))))
+)
+
+(test-group
+  "sqrt"
+  (test 1i (sqrt -1))
+  (test 1i (sqrt -1.0))
+  (test +i (sqrt -1.0))
+  (test 2 (sqrt 4))
+  (test 2.0 (sqrt 4.0))
+  (test 2i (sqrt -4.0))
+  (test #t (complex? (sqrt -1)))
+  (test #t (complex? (sqrt -i)))
+)
+
+(test-group
+  "exact"
+  (test -1 (exact -1))
+  (test -1 (exact -1.0))
+  (test -1 (exact -1.1))
+  (test -1 (exact -1.1))
+  (test 1.0+1.0i (exact 1.1+1.2i))
+  ;(test #t (bignum? (exact 111111111111111111111111111.0)))
+  ;(test #t (bignum? (exact -111111111111111111111111111.0)))
+  ;(test +inf.0 (exact +inf.0))
+)
+
+(test-group
+  "records"
+  (define-record-type employee
+     (make-employee name title)
+     employee?
+     (name get-name)
+     (title get-title)
+     (test get-test set-test!)) ;; Uninitialized by constructor
+  (define e (make-employee "test-name" "job 1"))
+
+  (test #f (get-test e))
+  (set-test! e 'test-field)
+  (test 'test-field (get-test e))
+)
+
+(test-group
+  "assoc"
+  (define a 0.0)
+  (test '(0.0) (assoc a (list (list a))))
+  (test '(0.0) (assoc 0.0 (list (list a))))
+  (test '(0.0) (assv a (list (list a))))
+  (test '(0.0) (assv 0.0 (list (list a))))
+  (test '(0.0) (assq a (list (list a))))
+  (test #f (assq 0.0 (list (list a))))
+)
+
+(test-group
+  "member"
+  (define m 0.0)
+  (test '(0.0) (member m (list m)))
+  (test '(0.0) (member 0.0 (list m)))
+  (test '(0.0) (memv m (list m)))
+  (test '(0.0) (memv 0.0 (list m)))
+  (test '(0.0) (memq m (list m)))
+  (test #f (memq 0.0 (list m)))
+)
+
+(test-group
+  "exception handling"
+  (define (capture-output thunk)
+    (let ((output-string (open-output-string)))
+      (parameterize ((current-output-port output-string))
+        (thunk))
+      (let ((result (get-output-string output-string)))
+       (close-output-port output-string)
+       result)))
+  (test
+    "should be a number65"
+    (capture-output
+      (lambda ()
+        (with-exception-handler
+          (lambda (con)
+            (cond
+              ((string? con)
+               (display con))
+              (else
+               (display "a warning has been issued")))
+            42)
+          (lambda ()
+            (display
+              (+ (raise-continuable "should be a number")
+                 23)))))))
+  (test
+    "condition: an-error"
+    (capture-output
+      (lambda ()
+        (call-with-current-continuation
+          (lambda (k)
+            (with-exception-handler
+              (lambda (x)
+                (display "condition: ")
+                (write x)
+                (k "exception"))
+              (lambda ()
+                (+ 1 (raise 'an-error)))))))))
+)
+
+(test-exit)
+

tests/c-compiler-options.scm

@@ -0,0 +1,9 @@
+;; Simple test to prevent regressions of top-level c-compiler-options 
+(import (scheme base)
+        (scheme write)
+        (cyclone foreign))
+
+(c-compiler-options "-I/tmp")
+
+(display "hello")
+

tests/test.scm

@@ -0,0 +1,26 @@
+;;;; Cyclone Scheme
+;;;; https://github.com/justinethier/cyclone
+;;;;
+;;;; Copyright (c) 2014-2021, Justin Ethier
+;;;; All rights reserved.
+;;;;
+;;;; This module contains unit tests for (cyclone test)
+;;;;
+
+(import 
+  (scheme base)
+  (cyclone test))
+
+(test-group
+  "assert"
+  (test-assert #t)
+)
+
+(test-group
+  "not"
+  (test-not #f)
+)
+
+(test-exit)
+
+

tests/threading.scm

@@ -0,0 +1,22 @@
+;;;; Cyclone Scheme
+;;;; https://github.com/justinethier/cyclone
+;;;;
+;;;; Copyright (c) 2014-2021, Justin Ethier
+;;;; All rights reserved.
+;;;;
+;;;; This module contains unit tests for threading / SRFI 18.
+;;;;
+
+(import 
+  (scheme base)
+  (srfi 18)
+  (cyclone test))
+
+
+(test-group
+  "thread-join!"
+  (let ((t (thread-start! (make-thread (lambda () (expt 2 100))))))
+    (test (expt 2 100) (thread-join! t)))
+)
+
+(test-exit)

tests/unit-tests.scm

@@ -35,6 +35,49 @@
 (set-cdr! l '(c b)) ; Above seems to break if it replaces this line
 (assert:equal "list? on circular list" (list? l) #t)
 
+;; Circular data structures
+(define v1 (vector #f))
+(define v2 (vector v1))
+(vector-set! v1 0 v2)
+(cond-expand
+  (memory-streams
+   (let ((fp (open-output-string)))
+     (display v1 fp)
+     (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
+(assert:equal "equality on circular vectors" (equal? v1 v2) #t)
+(newline)
+
+(define v1 (vector 1 2 3))
+(define v2 (vector 1 v1 3))
+(vector-set! v1 1 v2)
+(cond-expand
+ (memory-streams
+  (let ((fp (open-output-string)))
+    (write v1 fp)
+    (assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
+(assert:equal "equality on circular vectors, test 2" (equal? v1 v2) #t)
+(newline)
+
+(define l1 (list #f))
+(define l2 (list l1))
+(set-cdr! l1 l2)
+(cond-expand
+  (memory-streams
+   (let ((fp (open-output-string)))
+     (display l1 fp)
+     (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
+(assert:equal "equality on circular lists" (equal? l1 l2) #f)
+
+(define l1 (list 1 2 3))
+(define l2 (list 1 l1 3))
+(set-cdr! (cdr l1) l2)
+(cond-expand
+  (memory-streams
+   (let ((fp (open-output-string)))
+     (write l1 fp)
+     (assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
+(assert:equal "equality on circular lists, test 2" (equal? l1 l2) #f)
+
 ;; Adder example
 (define (make-adder x)
   (lambda (y) (+ x  y)))
@@ -378,6 +421,13 @@
   (x kar set-kar!)
   (y kdr))
 
+(define-record-type <point>
+  (point x y)
+  point?
+  (x get-x set-x!)
+  (y get-y set-y!)
+  (z get-z set-z!))
+
 (assert:equal "Records predicate (t)" (pare? (kons 1 2)) #t)
 (assert:equal "Records predicate (f)" (pare? (cons 1 2)) #f)
 (assert:equal "Records kar" (kar (kons 1 2)) 1)
@@ -389,6 +439,11 @@
   3)
 (assert:equal "Record type predicate (t)" (record? (kons 1 2)) #t)
 (assert:equal "Record type predicate (f)" (record? (cons 1 2)) #f)
+
+(assert:equal "Record type field not in constructor (f)" (get-z (point 1 2)) #f)
+(let ((p (point 1 2)))
+  (set-z! p 99)
+  (assert:equal "Record type get field not in constructor" (get-z p) 99))
 ;; END records
 
 ;; Lazy evaluation