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

@@ -21,7 +21,7 @@ jobs:
             
     - name: upload deb
       if: matrix.arch == '64'
-      uses: actions/upload-artifact@v1
+      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,43 @@
 # 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

Dockerfile

@@ -4,7 +4,7 @@ MAINTAINER justin.ethier@gmail.com
 
 ARG DEBIAN_FRONTEND=noninteractive
 
-ENV CYCLONE_VERSION v0.35.0
+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
 

Makefile

@@ -9,10 +9,10 @@ include Makefile.config
 # 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 -A .
-CYCLONE_LOCAL = ./cyclone -A . -A libs -COPT '-Iinclude' -CLNK '-L.'
+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
@@ -130,12 +130,31 @@ uninstall :
 tags :
 	ctags -R *
 
-indent : gc.c runtime.c ffi.c mstreams.c $(HEADER_DIR)/*.h
-	$(INDENT_CMD) gc.c
-	$(INDENT_CMD) runtime.c
-	$(INDENT_CMD) ffi.c
-	$(INDENT_CMD) mstreams.c
-	$(INDENT_CMD) $(HEADER_DIR)/*.h
+format : gc.c runtime.c ffi.c hashset.c mstreams.c ck-polyfill.c ck-polyfill.h $(HEADER_DIR)/*.h
+	$(FORMAT_CMD) $(HEADER_DIR)/hashset.h
+	$(FORMAT_CMD) $(HEADER_DIR)/runtime.h
+	$(FORMAT_CMD) $(HEADER_DIR)/runtime-main.h
+	$(FORMAT_CMD) $(HEADER_DIR)/types.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
@@ -153,7 +172,7 @@ api-doc :
 
 # Helper rules (of interest to people hacking on this makefile)
 
-.PHONY: clean full bench bootstrap tags indent debug test doc api-doc
+.PHONY: clean full bench bootstrap tags format test-format debug test doc api-doc
 
 $(TESTS) : %: %.scm cyclone libs
 	$(CYCLONE_LOCAL) -I . $<
@@ -336,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

@@ -91,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)
-CYC_PLATFORM_HAS_FMEMOPEN := $(shell echo "main(){char *buf; fmemopen(&buf, 0, \"r\");}" | $(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_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

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)
@@ -152,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.
-
-- 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.
+- 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.
 
 # License
 

ck-polyfill.c

@@ -27,8 +27,9 @@ 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)
+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)
 {
   (*hs).hs = simple_hashset_create();
   if (pthread_mutex_init(&((*hs).lock), NULL) != 0) {
@@ -38,7 +39,7 @@ bool ck_hs_init(ck_hs_t *hs, unsigned int mode, ck_hs_hash_cb_t *hash_func,
   return true;
 }
 
-void *ck_hs_get(ck_hs_t *_hs, unsigned long hash, const void *key)
+void *ck_hs_get(ck_hs_t * _hs, unsigned long hash, const void *key)
 {
   void *result = NULL;
   int index = -1;
@@ -46,7 +47,7 @@ void *ck_hs_get(ck_hs_t *_hs, unsigned long hash, const void *key)
 
   pthread_mutex_lock(&((*_hs).lock));
 
-  index = simple_hashset_is_member(set, (symbol_type *)key);
+  index = simple_hashset_is_member(set, (symbol_type *) key);
   if (index > 0) {
     result = (void *)(set->items[index].item);
   }
@@ -55,7 +56,7 @@ void *ck_hs_get(ck_hs_t *_hs, unsigned long hash, const void *key)
   return result;
 }
 
-bool ck_hs_put(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, index;
@@ -65,7 +66,7 @@ bool ck_hs_put(ck_hs_t *_hs, unsigned long hash, const void *key)
 
   //index = simple_hashset_is_member(hs, (symbol_type *)key);
   //if (index == 0) {
-    rv = simple_hashset_add(hs, (symbol_type *)key);
+  rv = simple_hashset_add(hs, (symbol_type *) key);
   if (rv >= 0) {
     result = true;
   }
@@ -77,7 +78,7 @@ bool ck_hs_put(ck_hs_t *_hs, unsigned long hash, const void *key)
 
 // CK Array section
 bool
-ck_array_init(ck_array_t *array, unsigned int mode,
+ck_array_init(ck_array_t * array, unsigned int mode,
               struct ck_malloc *allocator, unsigned int initial_length)
 {
   (*array).hs = hashset_create();
@@ -101,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
-ck_array_put_unique(ck_array_t *array, void *pointer)
+int ck_array_put_unique(ck_array_t * array, void *pointer)
 {
   pthread_mutex_lock(&(array->lock));
   hashset_add(array->hs, pointer);
@@ -121,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
-ck_array_remove(ck_array_t *array, void *pointer){
+bool ck_array_remove(ck_array_t * array, void *pointer)
+{
   pthread_mutex_lock(&(array->lock));
   hashset_remove(array->hs, pointer);
   pthread_mutex_unlock(&(array->lock));
@@ -138,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
@@ -164,7 +164,7 @@ bool ck_pr_cas_ptr(void *target, void *old_value, void *new_value)
 {
   bool result = false;
   pthread_mutex_lock(&glock);
-  if ( *(void **)target == old_value ) {
+  if (*(void **)target == old_value) {
     *(void **)target = new_value;
     result = true;
   }
@@ -173,7 +173,7 @@ bool ck_pr_cas_ptr(void *target, void *old_value, void *new_value)
   // *(void **)v = set;                                                             
 }
 
-bool ck_pr_cas_8(uint8_t *target, uint8_t old_value, uint8_t new_value)
+bool ck_pr_cas_8(uint8_t * target, uint8_t old_value, uint8_t new_value)
 {
   bool result = false;
   pthread_mutex_lock(&glock);
@@ -185,36 +185,32 @@ bool ck_pr_cas_8(uint8_t *target, uint8_t old_value, uint8_t new_value)
   return result;
 }
 
-void
-ck_pr_add_ptr(void *target, uintptr_t delta)
+void ck_pr_add_ptr(void *target, uintptr_t delta)
 {
   pthread_mutex_lock(&glock);
-  size_t value = (size_t) target;
-  size_t d = (size_t) delta;
+  size_t value = (size_t)target;
+  size_t d = (size_t)delta;
   size_t result = value + d;
   *(void **)target = (void *)result;
   // *(void **)v = set;                                                             
   pthread_mutex_unlock(&glock);
 }
 
-void
-ck_pr_add_int(int *target, int delta)
+void ck_pr_add_int(int *target, int delta)
 {
   pthread_mutex_lock(&glock);
   (*target) += delta;
   pthread_mutex_unlock(&glock);
 }
 
-void
-ck_pr_add_8(uint8_t *target, uint8_t delta)
+void ck_pr_add_8(uint8_t * target, uint8_t delta)
 {
   pthread_mutex_lock(&glock);
   (*target) += delta;
   pthread_mutex_unlock(&glock);
 }
 
-void *
-ck_pr_load_ptr(const void *target)
+void *ck_pr_load_ptr(const void *target)
 {
   void *result;
   pthread_mutex_lock(&glock);
@@ -223,8 +219,7 @@ ck_pr_load_ptr(const void *target)
   return result;
 }
 
-int
-ck_pr_load_int(const int *target)
+int ck_pr_load_int(const int *target)
 {
   int result;
   pthread_mutex_lock(&glock);
@@ -233,8 +228,7 @@ ck_pr_load_int(const int *target)
   return result;
 }
 
-uint8_t
-ck_pr_load_8(const uint8_t *target)
+uint8_t ck_pr_load_8(const uint8_t * target)
 {
   uint8_t result;
   pthread_mutex_lock(&glock);
@@ -250,13 +244,13 @@ 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* str, size_t len) {
+size_t hash_function(const char *str, size_t len)
+{
   unsigned long hash = 5381;
   int c;
 
@@ -269,7 +263,8 @@ size_t hash_function(const char* str, size_t len) {
 
 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;
@@ -279,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;
@@ -302,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;
 
@@ -315,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);
     }
@@ -337,25 +335,28 @@ 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);
   }
 }
 
-int simple_hashset_add(simple_hashset_t set, symbol_type* key)
+int simple_hashset_add(simple_hashset_t set, symbol_type * key)
 {
   size_t key_len = strlen(key->desc);
   size_t hash = set->hash_func(key->desc, key_len);
@@ -364,7 +365,7 @@ int simple_hashset_add(simple_hashset_t set, symbol_type* key)
   return rv;
 }
 
-int simple_hashset_is_member(simple_hashset_t set, symbol_type* key)
+int simple_hashset_is_member(simple_hashset_t set, symbol_type * key)
 {
   size_t key_len = strlen(key->desc);
   size_t hash = set->hash_func(key->desc, key_len);
@@ -379,5 +380,3 @@ int simple_hashset_is_member(simple_hashset_t set, symbol_type* key)
   }
   return 0;
 }
-
-

ck-polyfill.h

@@ -17,14 +17,14 @@ struct ck_malloc {
 ///////////////////////////////////////////////////////////////////////////////
 // Simple hashset (hashset with string support)
     /* hash function */
-    typedef size_t(*hash_func_t)(const char*, size_t);
+typedef size_t (*hash_func_t)(const char *, size_t);
 
-    struct simple_hashset_item_st {
+struct simple_hashset_item_st {
   size_t hash;
-        symbol_type* item;
-    };
+  symbol_type *item;
+};
 
-    struct simple_hashset_st {
+struct simple_hashset_st {
   size_t nbits;
   size_t mask;
 
@@ -34,26 +34,25 @@ struct ck_malloc {
   size_t n_deleted_items;
 
   hash_func_t hash_func;
-    };
+};
 //    struct simple_hashset_st;
-    typedef struct simple_hashset_st *simple_hashset_t;
+typedef struct simple_hashset_st *simple_hashset_t;
 
-
-    struct hashmap_st;
-    typedef struct hashmap_st *hashmap_t;
+struct hashmap_st;
+typedef struct hashmap_st *hashmap_t;
 
     /*
      * HASHSET FUNCTIONS
      */
 
     /* create hashset instance */
-    simple_hashset_t simple_hashset_create(void);
+simple_hashset_t simple_hashset_create(void);
 
     /* destroy hashset instance */
-    void simple_hashset_destroy(simple_hashset_t set);
+void simple_hashset_destroy(simple_hashset_t set);
 
     /* set hash function */
-    void simple_hashset_set_hash_function(simple_hashset_t set, hash_func_t func);
+void simple_hashset_set_hash_function(simple_hashset_t set, hash_func_t func);
 
     /* add item into the hashset.
      *
@@ -62,13 +61,13 @@ struct ck_malloc {
      *
      * returns zero if the item already in the set and non-zero otherwise
      */
-    int simple_hashset_add(simple_hashset_t set, symbol_type* key);
+int simple_hashset_add(simple_hashset_t set, symbol_type * key);
 
     /* check if existence of the item
      *
      * returns non-zero if the item exists and zero otherwise
      */
-    int simple_hashset_is_member(simple_hashset_t set, symbol_type* key);
+int simple_hashset_is_member(simple_hashset_t set, symbol_type * key);
 
 static inline uint64_t MurmurHash64A(const void *key, int len, uint64_t seed)
 {
@@ -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 *);
@@ -150,7 +150,7 @@ typedef struct ck_array_iterator ck_array_iterator_t;
 //      returns false if the creation failed. Failure may occur due to internal
 //      memory allocation failures or invalid arguments.
 bool
-ck_array_init(ck_array_t *array, unsigned int mode,
+ck_array_init(ck_array_t * array, unsigned int mode,
               struct ck_malloc *allocator, unsigned int initial_length);
 
 // DESCRIPTION
@@ -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
-ck_array_put_unique(ck_array_t *array, void *pointer);
+int 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
-ck_array_remove(ck_array_t *array, void *pointer);
-
+bool 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
-ck_array_commit(ck_array_t *array);
-
+bool ck_array_commit(ck_array_t * array);
 
   // TODO:
 
@@ -213,33 +208,23 @@ ck_array_commit(ck_array_t *array);
 
 ///////////////////////////////////////////////////////////////////////////////
 // CK PR section
-bool
-ck_pr_cas_ptr(void *target, void *old_value, void *new_value);
+bool ck_pr_cas_ptr(void *target, void *old_value, void *new_value);
 
-bool
-ck_pr_cas_int(int *target, int old_value, int new_value);
+bool ck_pr_cas_int(int *target, int old_value, int new_value);
 
-bool
-ck_pr_cas_8(uint8_t *target, uint8_t old_value, uint8_t new_value);
+bool 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
-ck_pr_add_ptr(void *target, uintptr_t delta);
+void ck_pr_add_int(int *target, int delta);
 
-void
-ck_pr_add_int(int *target, int delta);
+void ck_pr_add_8(uint8_t * target, uint8_t delta);
 
-void
-ck_pr_add_8(uint8_t *target, uint8_t delta);
+void *ck_pr_load_ptr(const void *target);
 
-void *
-ck_pr_load_ptr(const void *target);
+int ck_pr_load_int(const int *target);
 
-int
-ck_pr_load_int(const int *target);
-
-uint8_t
-ck_pr_load_8(const uint8_t *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

@@ -295,6 +295,8 @@
             (when (recompile? lib-dep append-dirs prepend-dirs)
               (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)))))
@@ -736,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) '()))
@@ -857,7 +859,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)))))
          ;; Only read C compiler options from module being compiled
          (cc-opts*
           (cond
@@ -986,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 

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/api/scheme/cyclone/libraries.md

@@ -182,7 +182,24 @@ libraries can be initialized properly in sequence.
 
     (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).
+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
 

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

@@ -13,14 +13,15 @@
 #include <ck_pr.h>
 #include <unistd.h>
 
-void *Cyc_init_thread(object thread_and_thunk, int argc, object *args);
+void *Cyc_init_thread(object thread_and_thunk, int argc, object * args);
 
 /**
  * After the Scheme call finishes, we wind down the GC / Heap used
  * 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(void *data, object _, int argc, object *args)
+static void Cyc_return_from_scm_call(void *data, object _, int argc,
+                                     object * args)
 {
   gc_thread_data *thd = data;
   object result = args[0];
@@ -41,12 +42,13 @@ static void Cyc_return_from_scm_call(void *data, object _, int argc, object *arg
  * 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(void *data, object _, int argc, object *args)
+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);
 }
 
@@ -58,7 +60,8 @@ static void Cyc_after_scm_call(void *data, object _, int argc, object *args)
  * 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;
@@ -72,7 +75,7 @@ object Cyc_scm_call(gc_thread_data *parent_thd, object fnc, int argc, object *ar
 
   make_c_opaque(co_parent_thd, parent_thd);
   make_c_opaque(co_this_thd, &local);
-  mclosure0(after, (function_type)Cyc_after_scm_call); 
+  mclosure0(after, (function_type) Cyc_after_scm_call);
 
   make_empty_vector(vec);
   vec.num_elements = 7;
@@ -105,7 +108,8 @@ 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, object _, int argc, object *args)
+static void no_gc_after_call_scm(gc_thread_data * thd, object _, int argc,
+                                 object * args)
 {
   object result = args[0];
   thd->gc_cont = result;
@@ -115,11 +119,11 @@ static void no_gc_after_call_scm(gc_thread_data *thd, object _, int argc, object
 /**
  * Call into Scheme function
  */
-static void no_gc_call_scm(gc_thread_data *thd, object fnc, object obj)
+static void no_gc_call_scm(gc_thread_data * thd, object fnc, object obj)
 {
-  mclosure0(after, (function_type)no_gc_after_call_scm); 
-  object buf[2] = {&after, obj};
-  ((closure)fnc)->fn(thd, fnc, 2, buf);
+  mclosure0(after, (function_type) no_gc_after_call_scm);
+  object buf[2] = { &after, obj };
+  ((closure) fnc)->fn(thd, fnc, 2, buf);
 }
 
 /**
@@ -134,12 +138,12 @@ static void no_gc_call_scm(gc_thread_data *thd, object fnc, object obj)
  * or re-allocated (EG: malloc) before returning it
  * to the C layer.
  */
-object Cyc_scm_call_no_gc(gc_thread_data *parent_thd, object fnc, object arg)
+object Cyc_scm_call_no_gc(gc_thread_data * parent_thd, object fnc, object arg)
 {
   long stack_size = 100000;
   char *stack_base = (char *)&stack_size;
   char *stack_traces[MAX_STACK_TRACES];
-  gc_thread_data thd = {0};
+  gc_thread_data thd = { 0 };
   jmp_buf jmp;
   thd.jmp_start = &jmp;
   thd.stack_start = stack_base;
@@ -184,5 +188,5 @@ object Cyc_scm_call_no_gc(gc_thread_data *parent_thd, object fnc, object arg)
     no_gc_call_scm(&thd, fnc, arg);
   }
 
-  return(thd.gc_cont);
+  return (thd.gc_cont);
 }

gc.c

@@ -55,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;
@@ -111,7 +112,7 @@ static mark_buffer *mark_buffer_init(unsigned initial_size)
   return mb;
 }
 
-static void *mark_buffer_get(mark_buffer *mb, unsigned i) // TODO: macro?
+static void *mark_buffer_get(mark_buffer * mb, unsigned i)      // TODO: macro?
 {
   while (i >= mb->buf_len) {
     // Not on this page, try the next one
@@ -126,7 +127,7 @@ static void *mark_buffer_get(mark_buffer *mb, unsigned i) // TODO: macro?
   return mb->buf[i];
 }
 
-static void mark_buffer_set(mark_buffer *mb, unsigned i, void *obj)
+static void mark_buffer_set(mark_buffer * mb, unsigned i, void *obj)
 {
   // Find index i
   while (i >= mb->buf_len) {
@@ -141,7 +142,7 @@ static void mark_buffer_set(mark_buffer *mb, unsigned i, void *obj)
   mb->buf[i] = obj;
 }
 
-static void mark_buffer_free(mark_buffer *mb)
+static void mark_buffer_free(mark_buffer * mb)
 {
   mark_buffer *next;
   while (mb) {
@@ -157,44 +158,48 @@ static void mark_buffer_free(mark_buffer *mb)
 #if GC_DEBUG_TRACE
 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,
+  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,
+  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};
+static double allocated_heap_counts[4] = { 0, 0, 0, 0 };
 
 void print_allocated_obj_counts()
 {
   int i;
   fprintf(stderr, "Allocated sizes:\n");
   fprintf(stderr, "Size, Allocations\n");
-  for (i = 0; i < NUM_ALLOC_SIZES; i++){
-    fprintf(stderr, "%d, %lf\n", 32 + (i*32), allocated_size_counts[i]);
+  for (i = 0; i < NUM_ALLOC_SIZES; i++) {
+    fprintf(stderr, "%d, %lf\n", 32 + (i * 32), allocated_size_counts[i]);
   }
   fprintf(stderr, "Allocated objects:\n");
   fprintf(stderr, "Tag, Allocations\n");
-  for (i = 0; i < 25; i++){
+  for (i = 0; i < 25; i++) {
     fprintf(stderr, "%d, %lf\n", i, allocated_obj_counts[i]);
   }
   fprintf(stderr, "Allocated heaps:\n");
   fprintf(stderr, "Heap, Allocations\n");
-  for (i = 0; i < 4; i++){
+  for (i = 0; i < 4; i++) {
     fprintf(stderr, "%d, %lf\n", i, allocated_heap_counts[i]);
   }
 }
 
-void gc_log(FILE *stream, const char *format, ...)
+void gc_log(FILE * stream, const char *format, ...)
 {
   va_list vargs;
   time_t rawtime;
-  struct tm * timeinfo;
-  time ( &rawtime );
-  timeinfo = localtime ( &rawtime );
+  struct tm *timeinfo;
+  time(&rawtime);
+  timeinfo = localtime(&rawtime);
 
   fprintf(stream, "%.2d:%.2d:%.2d - ",
           timeinfo->tm_hour, timeinfo->tm_min, timeinfo->tm_sec);
@@ -310,7 +315,7 @@ void gc_remove_mutator(gc_thread_data * thd)
  * @param thd Thread data object of the m
  * @return A true value if the mutator is active, 0 otherwise.
  */
-int gc_is_mutator_active(gc_thread_data *thd)
+int gc_is_mutator_active(gc_thread_data * thd)
 {
   ck_array_iterator_t iterator;
   gc_thread_data *m;
@@ -327,7 +332,7 @@ int gc_is_mutator_active(gc_thread_data *thd)
  * @param thd Thread data object of the m
  * @return A true value if the mutator is found, 0 otherwise.
  */
-int gc_is_mutator_new(gc_thread_data *thd)
+int gc_is_mutator_new(gc_thread_data * thd)
 {
   ck_array_iterator_t iterator;
   gc_thread_data *m;
@@ -371,9 +376,10 @@ 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){
+  for (; h; h = h->next) {
     if (h->is_unswept == 1) {   // Assume all free prior to sweep
       free_size += h->size;
     } else {
@@ -392,7 +398,7 @@ uint64_t gc_heap_free_size(gc_heap *h) {
  * @return Pointer to the newly allocated heap page, or NULL
  *         if the allocation failed.
  */
-gc_heap *gc_heap_create(int heap_type, size_t size, gc_thread_data *thd)
+gc_heap *gc_heap_create(int heap_type, size_t size, gc_thread_data * thd)
 {
   gc_free_list *free, *next;
   gc_heap *h;
@@ -456,18 +462,18 @@ gc_heap *gc_heap_create(int heap_type, size_t size, gc_thread_data *thd)
  *          Assumes that there is no data currently on the heap page!
  * @param   h     Heap page to initialize
  */
-void gc_init_fixed_size_free_list(gc_heap *h)
+void gc_init_fixed_size_free_list(gc_heap * h)
 {
   // for this flavor, just layer a free list on top of unitialized memory
   gc_free_list *next;
   //int i = 0;
   size_t remaining = h->size - (h->size % h->block_size) - h->block_size;       // Starting at first one so skip it
-  next = h->free_list = (gc_free_list *)h->data;
+  next = h->free_list = (gc_free_list *) h->data;
   //printf("data start = %p\n", h->data);
   //printf("data end = %p\n", h->data + h->size);
   while (remaining >= h->block_size) {
     //printf("%d init remaining=%d next = %p\n", i++, remaining, next);
-    next->next = (gc_free_list *)(((char *) next) + h->block_size);
+    next->next = (gc_free_list *) (((char *)next) + h->block_size);
     next = next->next;
     remaining -= h->block_size;
   }
@@ -479,11 +485,11 @@ void gc_init_fixed_size_free_list(gc_heap *h)
  * @brief Diagnostic function to print all free lists on a fixed-size heap page
  * @param h Heap page to output
  */
-void gc_print_fixed_size_free_list(gc_heap *h)
+void gc_print_fixed_size_free_list(gc_heap * h)
 {
   gc_free_list *f = h->free_list;
   fprintf(stderr, "printing free list:\n");
-  while(f) {
+  while (f) {
     fprintf(stderr, "%p\n", f);
     f = f->next;
   }
@@ -494,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) {
@@ -509,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 &&
-        color != thd->gc_trace_color) { //gc_color_clear) 
+    if (color != thd->gc_alloc_color && color != thd->gc_trace_color) { //gc_color_clear) 
       // Run any finalizers
       if (type_of(p) == mutex_tag) {
 #if GC_DEBUG_VERBOSE
@@ -534,20 +541,19 @@ static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd)
 #if GC_DEBUG_VERBOSE
         fprintf(stderr, "mp_clear from sweep\n");
 #endif
-        mp_clear(&(((bignum_type *)p)->bn));
+        mp_clear(&(((bignum_type *) p)->bn));
       } else if (type_of(p) == c_opaque_tag && opaque_collect_ptr(p)) {
 #if GC_DEBUG_VERBOSE
         fprintf(stderr, "free opaque pointer %p from sweep\n", opaque_ptr(p));
 #endif
-        free( opaque_ptr(p) );
+        free(opaque_ptr(p));
       }
 
       // Free block
       freed += h->block_size;
       if (next == NULL) {
         next = h->free_list = p;
-      }
-      else {
+      } else {
         next->next = p;
         next = next->next;
       }
@@ -562,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;
     }
@@ -589,7 +594,7 @@ static size_t gc_convert_heap_page_to_free_list(gc_heap *h, gc_thread_data *thd)
  * memory slots to the heap. It is only called by the collector thread after
  * the heap has been traced to identify live objects.
  */
-static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
+static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data * thd)
 {
   short heap_is_empty;
   object p, end;
@@ -617,12 +622,13 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
     size_t remaining = h->size - (h->size % h->block_size);     // - h->block_size; // Remove first one??
     char *data_end = h->data + remaining;
     heap_is_empty = 1;          // Base case is an empty heap
-    end = (object)data_end;
+    end = (object) data_end;
     p = h->data;
     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);
@@ -638,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 && 
-          mark(p) != thd->gc_trace_color) { //gc_color_clear) 
+      if (mark(p) != thd->gc_alloc_color && 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));
@@ -667,7 +672,7 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
 #if GC_DEBUG_VERBOSE
           fprintf(stderr, "mp_clear from sweep\n");
 #endif
-          mp_clear(&(((bignum_type *)p)->bn));
+          mp_clear(&(((bignum_type *) p)->bn));
         }
 
         // free p
@@ -682,12 +687,12 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
           // note if this is the case, either there is no free_list (see above case) or 
           // the free list is after p, which is handled now. these are the only situations
           // where there is no q
-          s = (gc_free_list *)p;
+          s = (gc_free_list *) p;
           s->next = h->free_list;
           q = h->free_list = p;
           //printf("sweep reclaimed remaining=%d, %p, assign h->free_list which was %p\n", remaining, p, h->free_list);
         } else {
-          s = (gc_free_list *)p;
+          s = (gc_free_list *) p;
           s->next = r;
           q->next = s;
           //printf("sweep reclaimed remaining=%d, %p, q=%p, r=%p\n", remaining, p, q, r);
@@ -731,14 +736,15 @@ static gc_heap *gc_sweep_fixed_size(gc_heap * h, gc_thread_data *thd)
  * @param   prev_page   Previous page in the heap
  * @return  Previous page if successful, NULL otherwise
  */
-gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page)
+gc_heap *gc_heap_free(gc_heap * page, gc_heap * prev_page)
 {
   // At least for now, do not free first page
   if (prev_page == NULL || page == NULL) {
     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;
@@ -751,19 +757,22 @@ gc_heap *gc_heap_free(gc_heap *page, gc_heap *prev_page)
  * @param h Heap to inspect. The caller should acquire any necessary locks.
  * @return A truthy value if the heap is empty, 0 otherwise.
  */
-static int gc_is_heap_empty(gc_heap *h) 
+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;
@@ -792,13 +801,14 @@ void gc_print_stats(gc_heap * h)
       if (f->size > free_max)
         free_max = f->size;
     }
-    if (free == 0){ // No free chunks
+    if (free == 0) {            // No free chunks
       free_min = 0;
     }
     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);
   }
 }
 
@@ -814,9 +824,9 @@ void gc_print_stats(gc_heap * h)
  */
 char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
 {
-  #if GC_DEBUG_TRACE
+#if GC_DEBUG_TRACE
   allocated_obj_counts[type_of(obj)]++;
-  #endif
+#endif
 
   switch (type_of(obj)) {
   case closureN_tag:{
@@ -827,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:{
@@ -866,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:{
@@ -893,21 +905,21 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
       hp->tok_end = ((port_type *) obj)->tok_end;
       hp->tok_buf = ((port_type *) obj)->tok_buf;
       hp->tok_buf_len = ((port_type *) obj)->tok_buf_len;
-      hp->mem_buf = ((port_type *)obj)->mem_buf;
-      hp->mem_buf_len = ((port_type *)obj)->mem_buf_len;
-      hp->str_bv_in_mem_buf = ((port_type *)obj)->str_bv_in_mem_buf;
-      hp->str_bv_in_mem_buf_len = ((port_type *)obj)->str_bv_in_mem_buf_len;
-      hp->read_len = ((port_type *)obj)->read_len;
+      hp->mem_buf = ((port_type *) obj)->mem_buf;
+      hp->mem_buf_len = ((port_type *) obj)->mem_buf_len;
+      hp->str_bv_in_mem_buf = ((port_type *) obj)->str_bv_in_mem_buf;
+      hp->str_bv_in_mem_buf_len = ((port_type *) obj)->str_bv_in_mem_buf_len;
+      hp->read_len = ((port_type *) obj)->read_len;
       return (char *)hp;
     }
   case bignum_tag:{
       bignum_type *hp = dest;
       mark(hp) = thd->gc_alloc_color;
       type_of(hp) = bignum_tag;
-      ((bignum_type *)hp)->bn.used = ((bignum_type *)obj)->bn.used;
-      ((bignum_type *)hp)->bn.alloc = ((bignum_type *)obj)->bn.alloc;
-      ((bignum_type *)hp)->bn.sign = ((bignum_type *)obj)->bn.sign;
-      ((bignum_type *)hp)->bn.dp = ((bignum_type *)obj)->bn.dp;
+      ((bignum_type *) hp)->bn.used = ((bignum_type *) obj)->bn.used;
+      ((bignum_type *) hp)->bn.alloc = ((bignum_type *) obj)->bn.alloc;
+      ((bignum_type *) hp)->bn.sign = ((bignum_type *) obj)->bn.sign;
+      ((bignum_type *) hp)->bn.dp = ((bignum_type *) obj)->bn.dp;
       return (char *)hp;
     }
   case cvar_tag:{
@@ -935,7 +947,7 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
       atomic_type *hp = dest;
       mark(hp) = thd->gc_alloc_color;
       type_of(hp) = atomic_tag;
-      hp->obj = ((atomic_type *)obj)->obj; // TODO: should access via CK atomic operations, though this may not be needed at all since we alloc directly on heap
+      hp->obj = ((atomic_type *) obj)->obj;     // TODO: should access via CK atomic operations, though this may not be needed at all since we alloc directly on heap
       return (char *)hp;
     }
   case macro_tag:{
@@ -1010,7 +1022,7 @@ char *gc_copy_obj(object dest, char *obj, gc_thread_data * thd)
  * increasing size using the Fibonnaci Sequence until reaching the
  * max size.
  */
-gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data *thd)
+gc_heap *gc_grow_heap(gc_heap * h, size_t size, gc_thread_data * thd)
 {
   size_t new_size;
   gc_heap *h_last = h, *h_new;
@@ -1049,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,
-            new_size);
+    fprintf(stderr, "Growing heap %d new page size = %zu\n", h->type, new_size);
 #endif
   }
   h_last = gc_heap_last(h_last);        // Ensure we don't unlink any heaps
@@ -1074,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,
-                   gc_thread_data * thd)
+void *gc_try_alloc(gc_heap * h, size_t size, char *obj, gc_thread_data * thd)
 {
   gc_free_list *f1, *f2, *f3;
 
@@ -1093,11 +1103,11 @@ void *gc_try_alloc(gc_heap * h, size_t size, char *obj,
 
       if (h->type != HEAP_HUGE) {
         // Copy object into heap now to avoid any uninitialized memory issues
-        #if GC_DEBUG_TRACE
+#if GC_DEBUG_TRACE
         if (size < (32 * NUM_ALLOC_SIZES)) {
           allocated_size_counts[(size / 32) - 1]++;
         }
-        #endif
+#endif
         gc_copy_obj(f2, obj, thd);
         // Done after sweep now instead of with each allocation
         h->free_size -= size;
@@ -1115,12 +1125,12 @@ void *gc_try_alloc(gc_heap * h, size_t size, char *obj,
  * @param h   Heap we are starting from (assume first in the chain)
  * @return    Count of heaps that have not been swept yet.
  */
-int gc_num_unswept_heaps(gc_heap *h)
+int gc_num_unswept_heaps(gc_heap * h)
 {
   int count = 0;
   while (h) {
     if (h->is_unswept == 1      /*|| 
-        gc_is_heap_empty(h)*/) {
+                                   gc_is_heap_empty(h) */ ) {
       count++;
     }
     h = h->next;
@@ -1128,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");
@@ -1137,10 +1148,11 @@ 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();
+  long long tstamp = hrt_get_current();
 #endif
   gc_heap *h_start = h, *h_prev;
   void *result = NULL;
@@ -1168,8 +1180,8 @@ long long tstamp = hrt_get_current();
       //}
       gc_heap *keep = gc_sweep(h, thd); // Clean up garbage objects
 #ifdef CYC_HIGH_RES_TIMERS
-fprintf(stderr, "sweep heap %p \n", h);
-hrt_log_delta("gc sweep", tstamp);
+      fprintf(stderr, "sweep heap %p \n", h);
+      hrt_log_delta("gc sweep", tstamp);
 #endif
       h_passed->num_unswept_children--;
       if (!keep) {
@@ -1215,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;
 
@@ -1232,11 +1245,11 @@ static void *gc_try_alloc_fixed_size(gc_heap * h, size_t size, char *obj, gc_thr
 
   if (result) {
     // Copy object into heap now to avoid any uninitialized memory issues
-      #if GC_DEBUG_TRACE
+#if GC_DEBUG_TRACE
     if (size < (32 * NUM_ALLOC_SIZES)) {
       allocated_size_counts[(size / 32) - 1]++;
     }
-      #endif
+#endif
     gc_copy_obj(result, obj, thd);
 
     h->free_size -= size;
@@ -1245,10 +1258,11 @@ 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();
+  long long tstamp = hrt_get_current();
 #endif
   gc_heap *h_start = h, *h_prev;
   void *result = NULL;
@@ -1272,8 +1286,8 @@ long long tstamp = hrt_get_current();
       unsigned int h_size = h->size;
       gc_heap *keep = gc_sweep_fixed_size(h, thd);      // Clean up garbage objects
 #ifdef CYC_HIGH_RES_TIMERS
-fprintf(stderr, "sweep fixed size heap %p size %lu \n", h, size);
-hrt_log_delta("gc sweep fixed size", tstamp);
+      fprintf(stderr, "sweep fixed size heap %p size %lu \n", h, size);
+      hrt_log_delta("gc sweep fixed size", tstamp);
 #endif
       h_passed->num_unswept_children--;
       if (!keep) {
@@ -1313,7 +1327,7 @@ hrt_log_delta("gc sweep fixed size", tstamp);
  * @param data  The mutator's thread data object
  * @return Pointer to a heap object for the bignum
  */
-void *gc_alloc_bignum(gc_thread_data *data)
+void *gc_alloc_bignum(gc_thread_data * data)
 {
   int heap_grown, result;
   bignum_type *bn;
@@ -1322,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",
-                     mp_error_to_string(result));
+    fprintf(stderr, "Error initializing number %s", mp_error_to_string(result));
     exit(1);
   }
   return bn;
@@ -1338,13 +1352,13 @@ void *gc_alloc_bignum(gc_thread_data *data)
  * @param src   The bignum instance to copy to the heap
  * @return Pointer to the heap object
  */
-void *gc_alloc_from_bignum(gc_thread_data *data, bignum_type *src)
+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
@@ -1365,7 +1379,8 @@ 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 * (LAST_FIXED_SIZE_HEAP_TYPE + 1))) {
     heap_type = (size - 1) / 32;
@@ -1399,12 +1414,13 @@ void *gc_alloc(gc_heap_root * hrt, size_t size, char *obj, gc_thread_data * thd,
     h->is_full = 1;
     result = try_alloc_slow(h_passed, h, size, obj, thd);
 #if GC_DEBUG_VERBOSE
-fprintf(stderr, "slow alloc of %p\n", result);
+    fprintf(stderr, "slow alloc of %p\n", result);
 #endif
     if (result) {
       // Check if we need to start a major collection
       if (heap_type != HEAP_HUGE &&
-         (h_passed->num_unswept_children < GC_COLLECT_UNDER_UNSWEPT_HEAP_COUNT)) {
+          (h_passed->num_unswept_children <
+           GC_COLLECT_UNDER_UNSWEPT_HEAP_COUNT)) {
         gc_start_major_collection(thd);
       }
     } else {
@@ -1416,7 +1432,7 @@ fprintf(stderr, "slow alloc of %p\n", result);
       *heap_grown = 1;
       result = try_alloc_slow(h_passed, last, size, obj, thd);
 #if GC_DEBUG_VERBOSE
-fprintf(stderr, "slowest alloc of %p\n", result);
+      fprintf(stderr, "slowest alloc of %p\n", result);
 #endif
       if (result) {
         // We had to allocate memory, start a major collection ASAP!
@@ -1444,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,
-          size, obj, type_of(obj), mark(((object) result)),
+  fprintf(stderr,
+          "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)) {
@@ -1566,7 +1583,7 @@ void gc_collector_sweep()
  * memory slots to the heap. It is only called by the allocator to free up space
  * after the heap has been traced to identify live objects.
  */
-gc_heap *gc_sweep(gc_heap * h, gc_thread_data *thd)
+gc_heap *gc_sweep(gc_heap * h, gc_thread_data * thd)
 {
   size_t freed, size;
   object p, end;
@@ -1590,7 +1607,7 @@ gc_heap *gc_sweep(gc_heap * h, gc_thread_data *thd)
 
   //for (; h; prev_h = h, h = h->next)       // All heaps
 #if GC_DEBUG_TRACE
-    fprintf(stderr, "sweep heap %p, size = %zu\n", h, (size_t) h->size);
+  fprintf(stderr, "sweep heap %p, size = %zu\n", h, (size_t)h->size);
 #endif
 #if GC_DEBUG_VERBOSE
   {
@@ -1640,14 +1657,12 @@ gc_heap *gc_sweep(gc_heap * h, gc_thread_data *thd)
     // - 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.
-      if (//mark(p) != markColor &&
-          mark(p) != thd->gc_alloc_color && 
-          mark(p) != thd->gc_trace_color) { //gc_color_clear) 
+    if (                        //mark(p) != markColor &&
+         mark(p) != thd->gc_alloc_color && 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,
-                type_of(p),
-                mark(p),
-                thd->gc_alloc_color, thd->gc_trace_color);
+      fprintf(stderr,
+              "sweep is freeing unmarked obj: %p with tag %d mark %d - alloc color %d trace color %d\n",
+              p, type_of(p), mark(p), thd->gc_alloc_color, thd->gc_trace_color);
 #endif
       //mark(p) = gc_color_blue;        // Needed?
       if (type_of(p) == mutex_tag) {
@@ -1672,7 +1687,7 @@ gc_heap *gc_sweep(gc_heap * h, gc_thread_data *thd)
 #if GC_DEBUG_VERBOSE
         fprintf(stderr, "mp_clear from sweep\n");
 #endif
-          mp_clear(&(((bignum_type *)p)->bn));
+        mp_clear(&(((bignum_type *) p)->bn));
       }
       // free p
       if (((((char *)q) + q->size) == (char *)p) && (q != h->free_list)) {
@@ -1841,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));
+    }
   }
 }
 
@@ -1883,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
@@ -1893,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);
 
@@ -1957,11 +2020,11 @@ void gc_mut_cooperate(gc_thread_data * thd, int buf_len)
 #endif
 
   // If we have finished tracing, clear any "full" bits on the heap
-  if(ck_pr_cas_8(&(thd->gc_done_tracing), 1, 0)) {
+  if (ck_pr_cas_8(&(thd->gc_done_tracing), 1, 0)) {
     int heap_type, unswept;
     gc_heap *h_tmp, *h_head;
 #if GC_DEBUG_VERBOSE
-fprintf(stdout, "done tracing, cooperator is clearing full bits\n");
+    fprintf(stdout, "done tracing, cooperator is clearing full bits\n");
 #endif
     for (heap_type = 0; heap_type < NUM_HEAP_TYPES; heap_type++) {
       h_head = h_tmp = thd->heap->heap[heap_type];
@@ -2010,7 +2073,8 @@ fprintf(stdout, "done tracing, cooperator is clearing full bits\n");
     int heap_type, over_gc_collection_threshold = 0;
 
     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]);
+      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;
@@ -2020,9 +2084,12 @@ fprintf(stdout, "done tracing, cooperator is clearing full bits\n");
               heap_type,
               thd->cached_heap_free_sizes[heap_type],
               thd->cached_heap_total_sizes[heap_type]);
-      if (thd->cached_heap_free_sizes[heap_type] > thd->cached_heap_total_sizes[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_total_sizes[heap_type]);
+      if (thd->cached_heap_free_sizes[heap_type] >
+          thd->cached_heap_total_sizes[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_total_sizes[heap_type]);
         exit(1);
       }
 #endif
@@ -2036,11 +2103,11 @@ fprintf(stdout, "done tracing, cooperator is clearing full bits\n");
          // Separate huge heap threshold since these are typically allocated as whole pages
          (thd->heap_num_huge_allocations > 100)
         )) {
-  #if GC_DEBUG_TRACE
+#if GC_DEBUG_TRACE
       fprintf(stderr,
               "Less than %f%% of the heap is free, initiating collector\n",
               100.0 * GC_COLLECTION_THRESHOLD);
-  #endif
+#endif
       ck_pr_cas_int(&gc_stage, STAGE_RESTING, STAGE_CLEAR_OR_MARKING);
     }
   }
@@ -2069,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 ||
-                              mark(obj) == gc_color_purple)) {     // TODO: sync??
+  if (is_object_type(obj) && (mark(obj) == gc_color_clear || 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
@@ -2096,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++;
   }
 }
@@ -2119,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,
-            type_of(parent), obj, mark(obj), gc_color_clear);
+    fprintf(stderr,
+            "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
@@ -2175,8 +2243,8 @@ void gc_mark_black(object obj)
         }
         break;
       }
-    case atomic_tag: {
-        atomic_type *a = (atomic_type *)obj;
+    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);
@@ -2283,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();
@@ -2403,9 +2472,10 @@ 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");            
-            #endif
+#if GC_DEBUG_TRACE
+            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,
                          0);
@@ -2551,8 +2621,7 @@ static pthread_t collector_thread;
  */
 void gc_start_collector()
 {
-  if (pthread_create
-      (&collector_thread, NULL, collector_main, NULL)) {
+  if (pthread_create(&collector_thread, NULL, collector_main, NULL)) {
     fprintf(stderr, "Error creating collector thread\n");
     exit(1);
   }
@@ -2589,7 +2658,6 @@ void gc_mark_globals(object globals, object global_table)
   }
 }
 
-
 /////////////////////////////////////////////
 // END tri-color marking section
 /////////////////////////////////////////////
@@ -2626,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 = 
-      vpbuffer_realloc(thd->mutations, &(thd->mutation_buflen));
+  thd->mutations = vpbuffer_realloc(thd->mutations, &(thd->mutation_buflen));
   thd->globals_changed = 1;
   thd->param_objs = NULL;
   thd->exception_handler_stack = NULL;
@@ -2717,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;
 }
 
 /**
@@ -2730,18 +2815,50 @@ void gc_heap_merge(gc_heap *hdest, gc_heap *hsrc)
  *
  * Assumes appropriate locks are already held.
  */
-void gc_merge_all_heaps(gc_thread_data *dest, gc_thread_data *src)
+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])));
     }
@@ -2783,15 +2900,15 @@ void Cyc_apply_from_buf(void *data, int argc, object prim, object * buf);
  * @param obj   Object to copy
  * @param thd   Thread data object for the applicable mutator
  */
-void gc_recopy_obj(object obj, gc_thread_data *thd) 
+void gc_recopy_obj(object obj, gc_thread_data * thd)
 {
   // Temporarily change obj type so we can copy it
   object fwd = forward(obj);
   tag_type tag = type_of(fwd);
   type_of(obj) = tag;
-  #if GC_DEBUG_TRACE
+#if GC_DEBUG_TRACE
   fprintf(stderr, "\n!!! Recopying object %p with tag %d !!!\n\n", obj, tag);
-  #endif
+#endif
   gc_copy_obj(fwd, obj, thd);   // Copy it again
   type_of(obj) = forward_tag;   // Restore forwarding pointer tag on stack obj
 }
@@ -2808,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.
@@ -2849,7 +2967,7 @@ void gc_mutator_thread_runnable(gc_thread_data * thd, object result, object mayb
       thd->gc_args[0] = result;
       Cyc_apply_from_buf(thd, 2, thd->gc_cont, thd->gc_args);
     } else {
-      object buf[1] = {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

@@ -9,20 +9,20 @@
 #include <limits.h>
 
 #ifdef LTM_NO_FILE
-#  warning LTM_NO_FILE has been deprecated, use MP_NO_FILE.
-#  define MP_NO_FILE
+#warning LTM_NO_FILE has been deprecated, use MP_NO_FILE.
+#define MP_NO_FILE
 #endif
 
 #ifndef MP_NO_FILE
-#  include <stdio.h>
+#include <stdio.h>
 #endif
 
 #ifdef MP_8BIT
-#  ifdef _MSC_VER
-#    pragma message("8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version.")
-#  else
-#    warning "8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version."
-#  endif
+#ifdef _MSC_VER
+#pragma message("8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version.")
+#else
+#warning "8-bit (MP_8BIT) support is deprecated and will be dropped completely in the next version."
+#endif
 #endif
 
 #ifdef __cplusplus
@@ -31,7 +31,7 @@ extern "C" {
 
 /* MS Visual C++ doesn't have a 128bit type for words, so fall back to 32bit MPI's (where words are 64bit) */
 #if (defined(_MSC_VER) || defined(__LLP64__) || defined(__e2k__) || defined(__LCC__)) && !defined(MP_64BIT)
-#   define MP_32BIT
+#define MP_32BIT
 #endif
 
 /* detect 64-bit mode if possible */
@@ -41,19 +41,19 @@ extern "C" {
     defined(__sparcv9) || defined(__sparc_v9__) || defined(__sparc64__) || \
     defined(__ia64) || defined(__ia64__) || defined(__itanium__) || defined(_M_IA64) || \
     defined(__LP64__) || defined(_LP64) || defined(__64BIT__)
-#   if !(defined(MP_64BIT) || defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
-#      if defined(__GNUC__) && !defined(__hppa)
+#if !(defined(MP_64BIT) || defined(MP_32BIT) || defined(MP_16BIT) || defined(MP_8BIT))
+#if defined(__GNUC__) && !defined(__hppa)
 /* we support 128bit integers only via: __attribute__((mode(TI))) */
-#         define MP_64BIT
-#      else
+#define MP_64BIT
+#else
 /* otherwise we fall back to MP_32BIT even on 64bit platforms */
-#         define MP_32BIT
-#      endif
-#   endif
+#define MP_32BIT
+#endif
+#endif
 #endif
 
 #ifdef MP_DIGIT_BIT
-#   error Defining MP_DIGIT_BIT is disallowed, use MP_8/16/31/32/64BIT
+#error Defining MP_DIGIT_BIT is disallowed, use MP_8/16/31/32/64BIT
 #endif
 
 /* some default configurations.
@@ -66,36 +66,36 @@ extern "C" {
  */
 
 #ifdef MP_8BIT
-typedef uint8_t              mp_digit;
-typedef uint16_t             private_mp_word;
-#   define MP_DIGIT_BIT 7
+  typedef uint8_t mp_digit;
+  typedef uint16_t private_mp_word;
+#define MP_DIGIT_BIT 7
 #elif defined(MP_16BIT)
-typedef uint16_t             mp_digit;
-typedef uint32_t             private_mp_word;
-#   define MP_DIGIT_BIT 15
+  typedef uint16_t mp_digit;
+  typedef uint32_t private_mp_word;
+#define MP_DIGIT_BIT 15
 #elif defined(MP_64BIT)
 /* for GCC only on supported platforms */
-typedef uint64_t mp_digit;
+  typedef uint64_t mp_digit;
 #if defined(__GNUC__)
-typedef unsigned long        private_mp_word __attribute__((mode(TI)));
+  typedef unsigned long private_mp_word __attribute__((mode(TI)));
 #endif
-#   define MP_DIGIT_BIT 60
+#define MP_DIGIT_BIT 60
 #else
-typedef uint32_t             mp_digit;
-typedef uint64_t             private_mp_word;
-#   ifdef MP_31BIT
+  typedef uint32_t mp_digit;
+  typedef uint64_t private_mp_word;
+#ifdef MP_31BIT
 /*
  * This is an extension that uses 31-bit digits.
  * Please be aware that not all functions support this size, especially s_mp_mul_digs_fast
  * will be reduced to work on small numbers only:
  * Up to 8 limbs, 248 bits instead of up to 512 limbs, 15872 bits with MP_28BIT.
  */
-#      define MP_DIGIT_BIT 31
-#   else
+#define MP_DIGIT_BIT 31
+#else
 /* default case is 28-bit digits, defines MP_28BIT as a handy macro to test */
-#      define MP_DIGIT_BIT 28
-#      define MP_28BIT
-#   endif
+#define MP_DIGIT_BIT 28
+#define MP_28BIT
+#endif
 #endif
 
 /* mp_word is a private type */
@@ -116,48 +116,48 @@ typedef uint64_t             private_mp_word;
 #define LTM_PRIME_2MSB_ON  (MP_DEPRECATED_PRAGMA("LTM_PRIME_2MSB_ON has been deprecated, use MP_PRIME_2MSB_ON") MP_PRIME_2MSB_ON)
 
 #ifdef MP_USE_ENUMS
-typedef enum {
+  typedef enum {
     MP_ZPOS = 0,                /* positive */
     MP_NEG = 1                  /* negative */
-} mp_sign;
-typedef enum {
+  } mp_sign;
+  typedef enum {
     MP_LT = -1,                 /* less than */
     MP_EQ = 0,                  /* equal */
     MP_GT = 1                   /* greater than */
-} mp_ord;
-typedef enum {
+  } mp_ord;
+  typedef enum {
     MP_NO = 0,
     MP_YES = 1
-} mp_bool;
-typedef enum {
+  } mp_bool;
+  typedef enum {
     MP_OKAY = 0,                /* no error */
     MP_ERR = -1,                /* unknown error */
     MP_MEM = -2,                /* out of mem */
     MP_VAL = -3,                /* invalid input */
     MP_ITER = -4,               /* maximum iterations reached */
     MP_BUF = -5                 /* buffer overflow, supplied buffer too small */
-} mp_err;
-typedef enum {
+  } mp_err;
+  typedef enum {
     MP_LSB_FIRST = -1,
     MP_MSB_FIRST = 1
-} mp_order;
-typedef enum {
+  } mp_order;
+  typedef enum {
     MP_LITTLE_ENDIAN = -1,
     MP_NATIVE_ENDIAN = 0,
     MP_BIG_ENDIAN = 1
-} mp_endian;
+  } mp_endian;
 #else
-typedef int mp_sign;
+  typedef int mp_sign;
 #define MP_ZPOS       0         /* positive integer */
 #define MP_NEG        1         /* negative */
-typedef int mp_ord;
+  typedef int mp_ord;
 #define MP_LT        -1         /* less than */
 #define MP_EQ         0         /* equal to */
 #define MP_GT         1         /* greater than */
-typedef int mp_bool;
+  typedef int mp_bool;
 #define MP_YES        1
 #define MP_NO         0
-typedef int mp_err;
+  typedef int mp_err;
 #define MP_OKAY       0         /* no error */
 #define MP_ERR        -1        /* unknown error */
 #define MP_MEM        -2        /* out of mem */
@@ -165,10 +165,10 @@ typedef int mp_err;
 #define MP_RANGE      (MP_DEPRECATED_PRAGMA("MP_RANGE has been deprecated in favor of MP_VAL") MP_VAL)
 #define MP_ITER       -4        /* maximum iterations reached */
 #define MP_BUF        -5        /* buffer overflow, supplied buffer too small */
-typedef int mp_order;
+  typedef int mp_order;
 #define MP_LSB_FIRST -1
 #define MP_MSB_FIRST  1
-typedef int mp_endian;
+  typedef int mp_endian;
 #define MP_LITTLE_ENDIAN  -1
 #define MP_NATIVE_ENDIAN  0
 #define MP_BIG_ENDIAN     1
@@ -177,11 +177,8 @@ typedef int mp_endian;
 /* tunable cutoffs */
 
 #ifndef MP_FIXED_CUTOFFS
-extern int
-KARATSUBA_MUL_CUTOFF,
-KARATSUBA_SQR_CUTOFF,
-TOOM_MUL_CUTOFF,
-TOOM_SQR_CUTOFF;
+  extern int
+   KARATSUBA_MUL_CUTOFF, KARATSUBA_SQR_CUTOFF, TOOM_MUL_CUTOFF, TOOM_SQR_CUTOFF;
 #endif
 
 /* define this to use lower memory usage routines (exptmods mostly) */
@@ -189,14 +186,14 @@ TOOM_SQR_CUTOFF;
 
 /* default precision */
 #ifndef MP_PREC
-#   ifndef MP_LOW_MEM
-#      define PRIVATE_MP_PREC 32        /* default digits of precision */
-#   elif defined(MP_8BIT)
-#      define PRIVATE_MP_PREC 16        /* default digits of precision */
-#   else
-#      define PRIVATE_MP_PREC 8         /* default digits of precision */
-#   endif
-#   define MP_PREC (MP_DEPRECATED_PRAGMA("MP_PREC is an internal macro") PRIVATE_MP_PREC)
+#ifndef MP_LOW_MEM
+#define PRIVATE_MP_PREC 32      /* default digits of precision */
+#elif defined(MP_8BIT)
+#define PRIVATE_MP_PREC 16      /* default digits of precision */
+#else
+#define PRIVATE_MP_PREC 8       /* default digits of precision */
+#endif
+#define MP_PREC (MP_DEPRECATED_PRAGMA("MP_PREC is an internal macro") PRIVATE_MP_PREC)
 #endif
 
 /* size of comba arrays, should be at least 2 * 2**(BITS_PER_WORD - BITS_PER_DIGIT*2) */
@@ -204,9 +201,9 @@ TOOM_SQR_CUTOFF;
 #define MP_WARRAY (MP_DEPRECATED_PRAGMA("MP_WARRAY is an internal macro") PRIVATE_MP_WARRAY)
 
 #if defined(__GNUC__) && __GNUC__ >= 4
-#   define MP_NULL_TERMINATED __attribute__((sentinel))
+#define MP_NULL_TERMINATED __attribute__((sentinel))
 #else
-#   define MP_NULL_TERMINATED
+#define MP_NULL_TERMINATED
 #endif
 
 /*
@@ -225,23 +222,23 @@ TOOM_SQR_CUTOFF;
  * tommath.h, disabling the warnings.
  */
 #ifndef MP_WUR
-#  if defined(__GNUC__) && __GNUC__ >= 4
-#     define MP_WUR __attribute__((warn_unused_result))
-#  else
-#     define MP_WUR
-#  endif
+#if defined(__GNUC__) && __GNUC__ >= 4
+#define MP_WUR __attribute__((warn_unused_result))
+#else
+#define MP_WUR
+#endif
 #endif
 
 #if defined(__GNUC__) && (__GNUC__ * 100 + __GNUC_MINOR__ >= 405)
-#  define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x)))
-#  define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s)
-#  define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s)
+#define MP_DEPRECATED(x) __attribute__((deprecated("replaced by " #x)))
+#define PRIVATE_MP_DEPRECATED_PRAGMA(s) _Pragma(#s)
+#define MP_DEPRECATED_PRAGMA(s) PRIVATE_MP_DEPRECATED_PRAGMA(GCC warning s)
 #elif defined(_MSC_VER) && _MSC_VER >= 1500
-#  define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x))
-#  define MP_DEPRECATED_PRAGMA(s) __pragma(message(s))
+#define MP_DEPRECATED(x) __declspec(deprecated("replaced by " #x))
+#define MP_DEPRECATED_PRAGMA(s) __pragma(message(s))
 #else
-#  define MP_DEPRECATED(s)
-#  define MP_DEPRECATED_PRAGMA(s)
+#define MP_DEPRECATED(s)
+#define MP_DEPRECATED_PRAGMA(s)
 #endif
 
 #define DIGIT_BIT   (MP_DEPRECATED_PRAGMA("DIGIT_BIT macro is deprecated, MP_DIGIT_BIT instead") MP_DIGIT_BIT)
@@ -250,193 +247,204 @@ TOOM_SQR_CUTOFF;
 #define SIGN(m)     (MP_DEPRECATED_PRAGMA("SIGN macro is deprecated, use z->sign instead") (m)->sign)
 
 /* the infamous mp_int structure */
-typedef struct  {
+  typedef struct {
     int used, alloc;
     mp_sign sign;
     mp_digit *dp;
-} mp_int;
+  } mp_int;
 
 /* 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 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;
 
 /* error code to char* string */
-const char *mp_error_to_string(mp_err code) MP_WUR;
+  const char *mp_error_to_string(mp_err code) MP_WUR;
 
 /* ---> init and deinit bignum functions <--- */
 /* init a bignum */
-mp_err mp_init(mp_int *a) MP_WUR;
+  mp_err mp_init(mp_int * a) MP_WUR;
 
 /* free a bignum */
-void mp_clear(mp_int *a);
+  void mp_clear(mp_int * a);
 
 /* init a null terminated series of arguments */
-mp_err mp_init_multi(mp_int *mp, ...) MP_NULL_TERMINATED MP_WUR;
+  mp_err mp_init_multi(mp_int * mp, ...) MP_NULL_TERMINATED MP_WUR;
 
 /* clear a null terminated series of arguments */
-void mp_clear_multi(mp_int *mp, ...) MP_NULL_TERMINATED;
+  void mp_clear_multi(mp_int * mp, ...) MP_NULL_TERMINATED;
 
 /* exchange two ints */
-void mp_exch(mp_int *a, mp_int *b);
+  void mp_exch(mp_int * a, mp_int * b);
 
 /* shrink ram required for a bignum */
-mp_err mp_shrink(mp_int *a) MP_WUR;
+  mp_err mp_shrink(mp_int * a) MP_WUR;
 
 /* grow an int to a given size */
-mp_err mp_grow(mp_int *a, int size) MP_WUR;
+  mp_err mp_grow(mp_int * a, int size) MP_WUR;
 
 /* init to a given number of digits */
-mp_err mp_init_size(mp_int *a, int size) MP_WUR;
+  mp_err mp_init_size(mp_int * a, int size) MP_WUR;
 
 /* ---> Basic Manipulations <--- */
 #define mp_iszero(a) (((a)->used == 0) ? MP_YES : MP_NO)
-mp_bool mp_iseven(const mp_int *a) MP_WUR;
-mp_bool mp_isodd(const mp_int *a) MP_WUR;
+  mp_bool mp_iseven(const mp_int * a) MP_WUR;
+  mp_bool mp_isodd(const mp_int * a) MP_WUR;
 #define mp_isneg(a)  (((a)->sign != MP_ZPOS) ? MP_YES : MP_NO)
 
 /* set to zero */
-void mp_zero(mp_int *a);
+  void mp_zero(mp_int * a);
 
 /* get and set doubles */
-double mp_get_double(const mp_int *a) MP_WUR;
-mp_err mp_set_double(mp_int *a, double b) MP_WUR;
+  double mp_get_double(const mp_int * a) MP_WUR;
+  mp_err mp_set_double(mp_int * a, double b) MP_WUR;
 
 /* get integer, set integer and init with integer (int32_t) */
-int32_t mp_get_i32(const mp_int *a) MP_WUR;
-void mp_set_i32(mp_int *a, int32_t b);
-mp_err mp_init_i32(mp_int *a, int32_t b) MP_WUR;
+  int32_t mp_get_i32(const mp_int * a) MP_WUR;
+  void mp_set_i32(mp_int * a, int32_t b);
+  mp_err mp_init_i32(mp_int * a, int32_t b) MP_WUR;
 
 /* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint32_t) */
 #define mp_get_u32(a) ((uint32_t)mp_get_i32(a))
-void mp_set_u32(mp_int *a, uint32_t b);
-mp_err mp_init_u32(mp_int *a, uint32_t b) MP_WUR;
+  void mp_set_u32(mp_int * a, uint32_t b);
+  mp_err mp_init_u32(mp_int * a, uint32_t b) MP_WUR;
 
 /* get integer, set integer and init with integer (int64_t) */
-int64_t mp_get_i64(const mp_int *a) MP_WUR;
-void mp_set_i64(mp_int *a, int64_t b);
-mp_err mp_init_i64(mp_int *a, int64_t b) MP_WUR;
+  int64_t mp_get_i64(const mp_int * a) MP_WUR;
+  void mp_set_i64(mp_int * a, int64_t b);
+  mp_err mp_init_i64(mp_int * a, int64_t b) MP_WUR;
 
 /* get integer, set integer and init with integer, behaves like two complement for negative numbers (uint64_t) */
 #define mp_get_u64(a) ((uint64_t)mp_get_i64(a))
-void mp_set_u64(mp_int *a, uint64_t b);
-mp_err mp_init_u64(mp_int *a, uint64_t b) MP_WUR;
+  void mp_set_u64(mp_int * a, uint64_t b);
+  mp_err mp_init_u64(mp_int * a, uint64_t b) MP_WUR;
 
 /* get magnitude */
-uint32_t mp_get_mag_u32(const mp_int *a) MP_WUR;
-uint64_t mp_get_mag_u64(const mp_int *a) MP_WUR;
-unsigned long mp_get_mag_ul(const mp_int *a) MP_WUR;
-unsigned long long mp_get_mag_ull(const mp_int *a) MP_WUR;
+  uint32_t mp_get_mag_u32(const mp_int * a) MP_WUR;
+  uint64_t mp_get_mag_u64(const mp_int * a) MP_WUR;
+  unsigned long mp_get_mag_ul(const mp_int * a) MP_WUR;
+  unsigned long long mp_get_mag_ull(const mp_int * a) MP_WUR;
 
 /* get integer, set integer (long) */
-long mp_get_l(const mp_int *a) MP_WUR;
-void mp_set_l(mp_int *a, long b);
-mp_err mp_init_l(mp_int *a, long b) MP_WUR;
+  long mp_get_l(const mp_int * a) MP_WUR;
+  void mp_set_l(mp_int * a, long b);
+  mp_err mp_init_l(mp_int * a, long b) MP_WUR;
 
 /* get integer, set integer (unsigned long) */
 #define mp_get_ul(a) ((unsigned long)mp_get_l(a))
-void mp_set_ul(mp_int *a, unsigned long b);
-mp_err mp_init_ul(mp_int *a, unsigned long b) MP_WUR;
+  void mp_set_ul(mp_int * a, unsigned long b);
+  mp_err mp_init_ul(mp_int * a, unsigned long b) MP_WUR;
 
 /* get integer, set integer (long long) */
-long long mp_get_ll(const mp_int *a) MP_WUR;
-void mp_set_ll(mp_int *a, long long b);
-mp_err mp_init_ll(mp_int *a, long long b) MP_WUR;
+  long long mp_get_ll(const mp_int * a) MP_WUR;
+  void mp_set_ll(mp_int * a, long long b);
+  mp_err mp_init_ll(mp_int * a, long long b) MP_WUR;
 
 /* get integer, set integer (unsigned long long) */
 #define mp_get_ull(a) ((unsigned long long)mp_get_ll(a))
-void mp_set_ull(mp_int *a, unsigned long long b);
-mp_err mp_init_ull(mp_int *a, unsigned long long b) MP_WUR;
+  void mp_set_ull(mp_int * a, unsigned long long b);
+  mp_err mp_init_ull(mp_int * a, unsigned long long b) MP_WUR;
 
 /* set to single unsigned digit, up to MP_DIGIT_MAX */
-void mp_set(mp_int *a, mp_digit b);
-mp_err mp_init_set(mp_int *a, mp_digit b) MP_WUR;
+  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_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_init_ul) mp_err mp_init_set_int(mp_int *a, unsigned long b) MP_WUR;
+   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_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_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;
+  mp_err mp_copy(const mp_int * a, mp_int * b) MP_WUR;
 
 /* inits and copies, a = b */
-mp_err mp_init_copy(mp_int *a, const mp_int *b) MP_WUR;
+  mp_err mp_init_copy(mp_int * a, const mp_int * b) MP_WUR;
 
 /* trim unused digits */
-void mp_clamp(mp_int *a);
-
+  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,
-                                        int endian, size_t nails, const mp_int *op) MP_WUR;
+   MP_DEPRECATED(mp_pack) mp_err mp_export(void *rop, size_t *countp, int order,
+                                           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,
-      size_t size, int endian, size_t nails,
+   MP_DEPRECATED(mp_unpack) mp_err mp_import(mp_int * rop, size_t count,
+                                             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,
-                 size_t nails, const void *op) MP_WUR;
+  mp_err mp_unpack(mp_int * rop, size_t count, mp_order order, size_t size,
+                   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_endian endian, size_t nails, const mp_int *op) MP_WUR;
+  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_endian endian, size_t nails,
+                 const mp_int * op) MP_WUR;
 
 /* ---> digit manipulation <--- */
 
 /* right shift by "b" digits */
-void mp_rshd(mp_int *a, int b);
+  void mp_rshd(mp_int * a, int b);
 
 /* left shift by "b" digits */
-mp_err mp_lshd(mp_int *a, int b) MP_WUR;
+  mp_err mp_lshd(mp_int * a, int b) MP_WUR;
 
 /* c = a / 2**b, implemented as c = a >> b */
-mp_err mp_div_2d(const mp_int *a, int b, mp_int *c, mp_int *d) MP_WUR;
+  mp_err mp_div_2d(const mp_int * a, int b, mp_int * c, mp_int * d) MP_WUR;
 
 /* b = a/2 */
-mp_err mp_div_2(const mp_int *a, mp_int *b) MP_WUR;
+  mp_err mp_div_2(const mp_int * a, mp_int * b) MP_WUR;
 
 /* a/3 => 3c + d == a */
-mp_err mp_div_3(const mp_int *a, mp_int *c, mp_digit *d) MP_WUR;
+  mp_err mp_div_3(const mp_int * a, mp_int * c, mp_digit * d) MP_WUR;
 
 /* c = a * 2**b, implemented as c = a << b */
-mp_err mp_mul_2d(const mp_int *a, int b, mp_int *c) MP_WUR;
+  mp_err mp_mul_2d(const mp_int * a, int b, mp_int * c) MP_WUR;
 
 /* b = a*2 */
-mp_err mp_mul_2(const mp_int *a, mp_int *b) MP_WUR;
+  mp_err mp_mul_2(const mp_int * a, mp_int * b) MP_WUR;
 
 /* c = a mod 2**b */
-mp_err mp_mod_2d(const mp_int *a, int b, mp_int *c) MP_WUR;
+  mp_err mp_mod_2d(const mp_int * a, int b, mp_int * c) MP_WUR;
 
 /* computes a = 2**b */
-mp_err mp_2expt(mp_int *a, int b) MP_WUR;
+  mp_err mp_2expt(mp_int * a, int b) MP_WUR;
 
 /* Counts the number of lsbs which are zero before the first zero bit */
-int mp_cnt_lsb(const mp_int *a) MP_WUR;
+  int mp_cnt_lsb(const mp_int * a) MP_WUR;
 
 /* I Love Earth! */
 
 /* makes a pseudo-random mp_int of a given size */
-mp_err mp_rand(mp_int *a, int digits) MP_WUR;
+  mp_err mp_rand(mp_int * a, int digits) MP_WUR;
 /* makes a pseudo-random small int of a given size */
-MP_DEPRECATED(mp_rand) mp_err mp_rand_digit(mp_digit *r) MP_WUR;
+   MP_DEPRECATED(mp_rand) mp_err mp_rand_digit(mp_digit * r) MP_WUR;
 /* use custom random data source instead of source provided the platform */
-void mp_rand_source(mp_err(*source)(void *out, size_t size));
+  void mp_rand_source(mp_err(*source) (void *out, size_t size));
 
 #ifdef MP_PRNG_ENABLE_LTM_RNG
-#  warning MP_PRNG_ENABLE_LTM_RNG has been deprecated, use mp_rand_source instead.
+#warning MP_PRNG_ENABLE_LTM_RNG has been deprecated, use mp_rand_source instead.
 /* A last resort to provide random data on systems without any of the other
  * 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 void (*ltm_rng_callback)(void);
+  extern unsigned long (*ltm_rng)(unsigned char *out, unsigned long outlen,
+                                  void(*callback)(void));
+  extern void (*ltm_rng_callback)(void);
 #endif
 
 /* ---> binary operations <--- */
@@ -445,225 +453,250 @@ extern void (*ltm_rng_callback)(void);
  * if the bit is 1, MP_NO if it is 0 and MP_VAL
  * in case of error
  */
-MP_DEPRECATED(s_mp_get_bit) int mp_get_bit(const mp_int *a, int b) MP_WUR;
+   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_err mp_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_err mp_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_err mp_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;
+  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_err mp_signed_rsh(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 <--- */
 
 /* b = -a */
-mp_err mp_neg(const mp_int *a, mp_int *b) MP_WUR;
+  mp_err mp_neg(const mp_int * a, mp_int * b) MP_WUR;
 
 /* b = |a| */
-mp_err mp_abs(const mp_int *a, mp_int *b) MP_WUR;
+  mp_err mp_abs(const mp_int * a, mp_int * b) MP_WUR;
 
 /* compare a to b */
-mp_ord mp_cmp(const mp_int *a, const mp_int *b) MP_WUR;
+  mp_ord mp_cmp(const mp_int * a, const mp_int * b) MP_WUR;
 
 /* compare |a| to |b| */
-mp_ord mp_cmp_mag(const mp_int *a, const mp_int *b) MP_WUR;
+  mp_ord mp_cmp_mag(const mp_int * a, const mp_int * b) MP_WUR;
 
 /* c = a + b */
-mp_err mp_add(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+  mp_err mp_add(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
 
 /* c = a - b */
-mp_err mp_sub(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+  mp_err mp_sub(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
 
 /* c = a * b */
-mp_err mp_mul(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+  mp_err mp_mul(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
 
 /* b = a*a  */
-mp_err mp_sqr(const mp_int *a, mp_int *b) 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;
+  mp_err mp_mod(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
 
 /* Increment "a" by one like "a++". Changes input! */
-mp_err mp_incr(mp_int *a) MP_WUR;
+  mp_err mp_incr(mp_int * a) MP_WUR;
 
 /* Decrement "a" by one like "a--". Changes input! */
-mp_err mp_decr(mp_int *a) MP_WUR;
+  mp_err mp_decr(mp_int * a) MP_WUR;
 
 /* ---> single digit functions <--- */
 
 /* compare against a single digit */
-mp_ord mp_cmp_d(const mp_int *a, mp_digit b) MP_WUR;
+  mp_ord mp_cmp_d(const mp_int * a, mp_digit b) MP_WUR;
 
 /* c = a + b */
-mp_err mp_add_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
+  mp_err mp_add_d(const mp_int * a, mp_digit b, mp_int * c) MP_WUR;
 
 /* c = a - b */
-mp_err mp_sub_d(const mp_int *a, mp_digit b, mp_int *c) MP_WUR;
+  mp_err mp_sub_d(const mp_int * a, mp_digit b, mp_int * c) MP_WUR;
 
 /* c = a * b */
-mp_err mp_mul_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;
+  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;
+  mp_err mp_sqrmod(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
 
 /* c = 1/a (mod b) */
-mp_err mp_invmod(const mp_int *a, const mp_int *b, mp_int *c) MP_WUR;
+  mp_err mp_invmod(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
 
 /* c = (a, b) */
-mp_err mp_gcd(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;
+  mp_err mp_lcm(const mp_int * a, const mp_int * b, mp_int * c) MP_WUR;
 
 /* finds one of the b'th root of a, such that |c|**b <= |a|
  *
  * 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_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR;
+  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_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;
+  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;
+  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;
+  mp_err mp_kronecker(const mp_int * a, const mp_int * p, int *c) MP_WUR;
 
 /* used to setup the Barrett reduction for a given modulus b */
-mp_err mp_reduce_setup(mp_int *a, const mp_int *b) MP_WUR;
+  mp_err mp_reduce_setup(mp_int * a, const mp_int * b) MP_WUR;
 
 /* Barrett Reduction, computes a (mod b) with a precomputed value c
  *
  * Assumes that 0 < x <= m*m, note if 0 > x > -(m*m) then you can merely
  * compute the reduction as -1 * mp_reduce(mp_abs(x)) [pseudo code].
  */
-mp_err mp_reduce(mp_int *x, const mp_int *m, const mp_int *mu) MP_WUR;
+  mp_err mp_reduce(mp_int * x, const mp_int * m, const mp_int * mu) MP_WUR;
 
 /* setups the montgomery reduction */
-mp_err mp_montgomery_setup(const mp_int *n, mp_digit *rho) MP_WUR;
+  mp_err mp_montgomery_setup(const mp_int * n, mp_digit * rho) MP_WUR;
 
 /* computes a = B**n mod b without division or multiplication useful for
  * normalizing numbers in a Montgomery system.
  */
-mp_err mp_montgomery_calc_normalization(mp_int *a, const mp_int *b) 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;
+  mp_bool mp_dr_is_modulus(const mp_int * a) MP_WUR;
 
 /* sets the value of "d" required for mp_dr_reduce */
-void mp_dr_setup(const mp_int *a, mp_digit *d);
+  void mp_dr_setup(const mp_int * a, mp_digit * d);
 
 /* reduces a modulo n using the Diminished Radix method */
-mp_err mp_dr_reduce(mp_int *x, const mp_int *n, mp_digit k) MP_WUR;
+  mp_err mp_dr_reduce(mp_int * x, const mp_int * n, mp_digit k) MP_WUR;
 
 /* returns true if a can be reduced with mp_reduce_2k */
-mp_bool mp_reduce_is_2k(const mp_int *a) MP_WUR;
+  mp_bool mp_reduce_is_2k(const mp_int * a) MP_WUR;
 
 /* determines k value for 2k reduction */
-mp_err mp_reduce_2k_setup(const mp_int *a, mp_digit *d) MP_WUR;
+  mp_err mp_reduce_2k_setup(const mp_int * a, mp_digit * d) MP_WUR;
 
 /* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
-mp_err mp_reduce_2k(mp_int *a, const mp_int *n, mp_digit d) MP_WUR;
+  mp_err mp_reduce_2k(mp_int * a, const mp_int * n, mp_digit d) MP_WUR;
 
 /* returns true if a can be reduced with mp_reduce_2k_l */
-mp_bool mp_reduce_is_2k_l(const mp_int *a) MP_WUR;
+  mp_bool mp_reduce_is_2k_l(const mp_int * a) MP_WUR;
 
 /* determines k value for 2k reduction */
-mp_err mp_reduce_2k_setup_l(const mp_int *a, mp_int *d) MP_WUR;
+  mp_err mp_reduce_2k_setup_l(const mp_int * a, mp_int * d) MP_WUR;
 
 /* reduces a modulo b where b is of the form 2**p - k [0 <= a] */
-mp_err mp_reduce_2k_l(mp_int *a, const mp_int *n, const 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 <--- */
 
 /* number of primes */
 #ifdef MP_8BIT
-#  define PRIVATE_MP_PRIME_TAB_SIZE 31
+#define PRIVATE_MP_PRIME_TAB_SIZE 31
 #else
-#  define PRIVATE_MP_PRIME_TAB_SIZE 256
+#define PRIVATE_MP_PRIME_TAB_SIZE 256
 #endif
 #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
  */
-int mp_prime_rabin_miller_trials(int size) MP_WUR;
+  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
@@ -679,14 +712,14 @@ mp_err mp_prime_frobenius_underwood(const mp_int *N, mp_bool *result) MP_WUR;
  *
  * Sets result to 1 if probably prime, 0 otherwise
  */
-mp_err mp_prime_is_prime(const mp_int *a, int t, mp_bool *result) MP_WUR;
+  mp_err mp_prime_is_prime(const mp_int * a, int t, mp_bool * result) MP_WUR;
 
 /* finds the next prime after the number "a" using "t" trials
  * of Miller-Rabin.
  *
  * bbs_style = 1 means the prime must be congruent to 3 mod 4
  */
-mp_err mp_prime_next_prime(mp_int *a, int t, int bbs_style) MP_WUR;
+  mp_err mp_prime_next_prime(mp_int * a, int t, int bbs_style) MP_WUR;
 
 /* makes a truly random prime of a given size (bytes),
  * call with bbs = 1 if you want it to be congruent to 3 mod 4
@@ -712,49 +745,69 @@ 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,
-      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;
+   MP_DEPRECATED(mp_prime_rand) mp_err mp_prime_random_ex(mp_int * a, int t,
+                                                          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 */
-mp_err mp_log_u32(const mp_int *a, uint32_t base, uint32_t *c) MP_WUR;
+  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_ex(const mp_int *a, mp_digit b, mp_int *c, int fast) MP_WUR;
+  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_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;
+  int mp_count_bits(const mp_int * a) MP_WUR;
 
+   MP_DEPRECATED(mp_ubin_size) int mp_unsigned_bin_size(const mp_int *
+                                                        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_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_ubin_size) int mp_unsigned_bin_size(const mp_int *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_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_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;
 
-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_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;
 
-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;
+  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;
 
-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_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_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;
+  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_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
-mp_err mp_fread(mp_int *a, int radix, FILE *stream) MP_WUR;
-mp_err mp_fwrite(const mp_int *a, int radix, FILE *stream) MP_WUR;
+  mp_err mp_fread(mp_int * a, int radix, FILE * stream) MP_WUR;
+  mp_err mp_fwrite(const mp_int * a, int radix, FILE * stream) MP_WUR;
 #endif
 
 #define mp_read_raw(mp, str, len) (MP_DEPRECATED_PRAGMA("replaced by mp_read_signed_bin") mp_read_signed_bin((mp), (str), (len)))
@@ -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 *data, object clo, int argc, object *args);
+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
@@ -231,7 +230,8 @@ 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 
@@ -274,8 +274,8 @@ 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, object cont, int argc, object *args);
-void dispatch_apply_va(void *data, object clo, int argc, object *args);
+void Cyc_apply(void *data, object cont, int argc, object * args);
+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);
@@ -288,7 +288,7 @@ void dispatch(void *data, int argc, function_type func, object clo, object cont,
  */
 /**@{*/
 object Cyc_string_cmp(void *data, object str1, object str2);
-void dispatch_string_91append(void *data, object clo, int _argc, object *args);
+void dispatch_string_91append(void *data, object clo, int _argc, object * args);
 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);
@@ -342,12 +342,12 @@ object Cyc_set_cvar(object var, object value);
  */
 /**@{*/
 object Cyc_display(void *data, object, FILE * port);
-void dispatch_display_va(void *data, object clo, int argc, object *args);
+void dispatch_display_va(void *data, object clo, int argc, object * args);
 object Cyc_display_va(void *data, int argc, object x, ...);
 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, object clo, int argc, object *args);
+void dispatch_write_va(void *data, object clo, int argc, object * args);
 object Cyc_write_va(void *data, int argc, object x, ...);
 object Cyc_write_va_list(void *data, object x, object opts);
 port_type Cyc_stdout(void);
@@ -372,19 +372,59 @@ 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
  */
@@ -464,39 +504,9 @@ int Cyc_have_mstreams();
   } \
   return_closcall1(data, cont, &d)
 
-/**
- * Extract exact or double number and pass it in a call to continuation `cont`
- */
-#define return_exact_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 { \
-    i = (int)OP(((double_type *)z)->value); \
-  } \
-  return_closcall1(data, cont, obj_int2obj(i))
-
-/**
- * Directly return exact or double number to caller
- */
-#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);
+double round_to_nearest_even(double);
+void Cyc_exact(void *data, object cont, object z);
+object Cyc_exact_no_cps(void *data, object ptr, object z);
 
 /**
  * Take Scheme object that is a number and return the number as a C type
@@ -549,8 +559,10 @@ 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_5(object ptr, object a1, object a2, object a3, object a4, object a5);
+object Cyc_fast_vector_4(object ptr, object a1, object a2, object a3,
+                         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,
@@ -560,13 +572,12 @@ object Cyc_num_op_va_list(void *data, int argc,
 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 * 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);
 void Cyc_make_rectangular(void *data, object k, object r, object i);
-double MRG32k3a (double seed);
+double MRG32k3a(double seed);
 /**@}*/
 /**
  * \defgroup prim_eq Equality and type predicates
@@ -642,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, ...);
 /**@}*/
 
@@ -677,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(void *data, object clo, int argc, object *args);
+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);
@@ -695,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(void *data, object _, int argc, object *args);
+void Cyc_exit_thread(void *data, object _, int argc, object * args);
 object Cyc_thread_sleep(void *data, object timeout);
 /**@}*/
 
@@ -898,7 +910,8 @@ extern object Cyc_glo_call_cc;
  * @brief Raise and handle Scheme exceptions
  */
 /**@{*/
-object Cyc_default_exception_handler(void *data, object _, int argc, object *args);
+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);
@@ -939,7 +952,7 @@ object register_library(const char *name);
 /**@{*/
 extern list global_table;
 void add_global(const char *identifier, object * glo);
-void Cyc_set_globals_changed(gc_thread_data *thd);
+void Cyc_set_globals_changed(gc_thread_data * thd);
 /**@}*/
 
 /**
@@ -961,9 +974,9 @@ void Cyc_set_globals_changed(gc_thread_data *thd);
 #define Cyc_utf8_encode_char(dest, dest_size, char_value) \
   Cyc_utf8_encode(dest, dest_size, &char_value, 1)
 
-int Cyc_utf8_encode(char *dest, int sz, uint32_t *src, int srcsz);
-int Cyc_utf8_count_code_points(uint8_t* s);
-uint32_t Cyc_utf8_validate_stream(uint32_t *state, char *str, size_t len); 
+int Cyc_utf8_encode(char *dest, int sz, uint32_t * src, int srcsz);
+int Cyc_utf8_count_code_points(uint8_t * s);
+uint32_t Cyc_utf8_validate_stream(uint32_t * state, char *str, size_t len);
 uint32_t Cyc_utf8_validate(char *str, size_t len);
 /**@}*/
 
@@ -985,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)

include/cyclone/types.h

@@ -46,31 +46,13 @@ typedef void *object;
  *\ingroup objects
  */
 enum object_tag {
-        closure0_tag    = 0
-      , closure1_tag    = 1
-      , closureN_tag    = 2
-      , macro_tag       = 3 // Keep closures here for quick type checking
-      , boolean_tag     = 4
-      , bytevector_tag  = 5
-      , c_opaque_tag    = 6
-      , 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
+  closure0_tag = 0, closure1_tag = 1, closureN_tag = 2, macro_tag = 3   // Keep closures here for quick type checking
+  , boolean_tag = 4, bytevector_tag = 5, c_opaque_tag = 6, 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
 };
 
 /**
@@ -398,29 +380,31 @@ void gc_initialize(void);
 void gc_add_new_unrunning_mutator(gc_thread_data * thd);
 void gc_add_mutator(gc_thread_data * thd);
 void gc_remove_mutator(gc_thread_data * thd);
-int gc_is_mutator_active(gc_thread_data *thd);
-int gc_is_mutator_new(gc_thread_data *thd);
+int gc_is_mutator_active(gc_thread_data * thd);
+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);
-void gc_merge_all_heaps(gc_thread_data *dest, gc_thread_data *src);
+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);
+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);
+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);
+void *gc_alloc_bignum(gc_thread_data * data);
 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_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);
+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_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);
 //size_t gc_heap_total_free_size(gc_heap *h);
@@ -429,7 +413,7 @@ void gc_init_fixed_size_free_list(gc_heap *h);
 void gc_request_mark_globals(void);
 void gc_mark_globals(object globals, object global_table);
 //size_t gc_sweep(gc_heap * h, size_t * sum_freed_ptr, gc_thread_data *thd);
-gc_heap *gc_sweep(gc_heap * h, gc_thread_data *thd);
+gc_heap *gc_sweep(gc_heap * h, gc_thread_data * thd);
 void gc_thr_grow_move_buffer(gc_thread_data * d);
 void gc_thread_data_init(gc_thread_data * thd, int mut_num, char *stack_base,
                          long stack_size);
@@ -456,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))
@@ -523,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
@@ -538,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);
 /**@}*/
 
 /**@}*/
@@ -550,8 +535,9 @@ 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_no_gc(gc_thread_data *parent_thd, object fnc, object arg);
+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);
 /**@}*/
 
 /**
@@ -659,10 +645,10 @@ typedef uint32_t char_type;
 /**@{*/
 
 /** Function type */
-typedef void (*function_type) (void *data, object clo, int argc, object *args);
+typedef void (*function_type)(void *data, object clo, int argc, object * args);
 
 /** Non-CPS function type */
-typedef object (*inline_function_type) ();
+typedef object(*inline_function_type) ();
 
 /**
  * @brief C-variable integration type - wrapper around a Cyclone object pointer
@@ -913,11 +899,8 @@ typedef struct {
  * and provides constants for each of the comparison operators.
  */
 typedef enum {
-    CYC_BN_LTE = -2
-  , CYC_BN_LT = MP_LT
-  , CYC_BN_EQ = MP_EQ
-  , CYC_BN_GT = MP_GT
-  , CYC_BN_GTE = 2
+  CYC_BN_LTE = -2, CYC_BN_LT = MP_LT, CYC_BN_EQ = MP_EQ, CYC_BN_GT =
+      MP_GT, CYC_BN_GTE = 2
 } bn_cmp_type;
 
 /** 
@@ -1168,10 +1151,22 @@ typedef struct {
 } vector_type;
 typedef vector_type *vector;
 
-typedef struct { vector_type v; object arr[2]; } 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;
+typedef struct {
+  vector_type v;
+  object arr[2];
+} 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) \
@@ -1266,6 +1261,9 @@ 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
@@ -1296,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 { 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;
+typedef struct {
+  pair_type a;
+  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. 
@@ -1527,7 +1537,7 @@ struct vpbuffer_t {
 };
 
 vpbuffer *vp_create(void);
-void vp_add(vpbuffer *v, void *obj);
+void vp_add(vpbuffer * v, void *obj);
 
 /* Utility functions */
 void **vpbuffer_realloc(void **buf, int *len);
@@ -1536,10 +1546,10 @@ void vpbuffer_free(void **buf);
 
 /* Bignum utility functions */
 int Cyc_bignum_cmp(bn_cmp_type type, object x, int tx, object y, int ty);
-void Cyc_int2bignum(int n, mp_int *bn);
+void Cyc_int2bignum(int n, mp_int * bn);
 
 /* Remaining GC prototypes that require objects to be defined */
-void *gc_alloc_from_bignum(gc_thread_data *data, bignum_type *src);
+void *gc_alloc_from_bignum(gc_thread_data * data, bignum_type * src);
 
 /**
  * Do a minor GC
@@ -1548,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 */

mstreams.c

@@ -41,7 +41,7 @@ int Cyc_have_mstreams()
 #endif
 }
 
-object Cyc_heap_alloc_port(void *data, port_type *p);
+object Cyc_heap_alloc_port(void *data, port_type * p);
 port_type *Cyc_io_open_input_string(void *data, object str)
 {
   // Allocate port on the heap so the location of mem_buf does not change
@@ -49,7 +49,7 @@ port_type *Cyc_io_open_input_string(void *data, object str)
   make_input_port(sp, NULL, CYC_IO_BUF_LEN);
 
   Cyc_check_str(data, str);
-  p = (port_type *)Cyc_heap_alloc_port(data, &sp);
+  p = (port_type *) Cyc_heap_alloc_port(data, &sp);
   errno = 0;
 #if CYC_HAVE_FMEMOPEN
   p->str_bv_in_mem_buf = malloc(sizeof(char) * (string_len(str) + 1));
@@ -57,8 +57,9 @@ port_type *Cyc_io_open_input_string(void *data, object str)
   memcpy(p->str_bv_in_mem_buf, string_str(str), string_len(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));
+  if (p->fp == NULL) {
+    Cyc_rt_raise2(data, "Unable to open input memory stream",
+                  obj_int2obj(errno));
   }
   return p;
 }
@@ -70,16 +71,17 @@ port_type *Cyc_io_open_input_bytevector(void *data, object bv)
   make_input_port(sp, NULL, CYC_IO_BUF_LEN);
 
   Cyc_check_bvec(data, bv);
-  p = (port_type *)Cyc_heap_alloc_port(data, &sp);
+  p = (port_type *) Cyc_heap_alloc_port(data, &sp);
   errno = 0;
 #if CYC_HAVE_FMEMOPEN
-  p->str_bv_in_mem_buf = malloc(sizeof(char) * ((bytevector)bv)->len);
-  p->str_bv_in_mem_buf_len = ((bytevector)bv)->len;
-  memcpy(p->str_bv_in_mem_buf, ((bytevector)bv)->data, ((bytevector)bv)->len);
-  p->fp = fmemopen(p->str_bv_in_mem_buf, ((bytevector)bv)->len, "r");
+  p->str_bv_in_mem_buf = malloc(sizeof(char) * ((bytevector) bv)->len);
+  p->str_bv_in_mem_buf_len = ((bytevector) bv)->len;
+  memcpy(p->str_bv_in_mem_buf, ((bytevector) bv)->data, ((bytevector) bv)->len);
+  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));
+  if (p->fp == NULL) {
+    Cyc_rt_raise2(data, "Unable to open input memory stream",
+                  obj_int2obj(errno));
   }
   return p;
 }
@@ -89,20 +91,21 @@ port_type *Cyc_io_open_output_string(void *data)
   // Allocate port on the heap so the location of mem_buf does not change
   port_type *p;
   make_port(sp, NULL, 0);
-  p = (port_type *)Cyc_heap_alloc_port(data, &sp);
+  p = (port_type *) Cyc_heap_alloc_port(data, &sp);
   errno = 0;
 #if CYC_HAVE_OPEN_MEMSTREAM
   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));
+  if (p->fp == NULL) {
+    Cyc_rt_raise2(data, "Unable to open output memory stream",
+                  obj_int2obj(errno));
   }
   return p;
 }
 
 void Cyc_io_get_output_string(void *data, object cont, object port)
 {
-  port_type *p = (port_type *)port;
+  port_type *p = (port_type *) port;
   Cyc_check_port(data, port);
   if (p->fp) {
     fflush(p->fp);
@@ -112,14 +115,14 @@ void Cyc_io_get_output_string(void *data, object cont, object port)
   }
   {
     make_string_with_len(s, p->str_bv_in_mem_buf, p->str_bv_in_mem_buf_len);
-    s.num_cp = Cyc_utf8_count_code_points((uint8_t *)string_str(&s));
+    s.num_cp = Cyc_utf8_count_code_points((uint8_t *) string_str(&s));
     return_closcall1(data, cont, &s);
   }
 }
 
 void Cyc_io_get_output_bytevector(void *data, object cont, object port)
 {
-  port_type *p = (port_type *)port;
+  port_type *p = (port_type *) port;
   Cyc_check_port(data, port);
   if (p->fp) {
     fflush(p->fp);
@@ -130,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

@@ -205,15 +205,10 @@
     write-u8
     binary-port?
     textual-port?
-
+    rationalize
 ;;;;
 ; Possibly missing functions:
-;
 ;    u8-ready?
-;
-;    ; No complex or rational numbers at this time
-;    rationalize
-;
 ;    ;; syntax-rules
 ;;;;
   )
@@ -412,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))
@@ -694,10 +689,27 @@
       (if (null? port)
         (Cyc-read-char (current-input-port))
         (Cyc-read-char (car port))))
-    (define (read-line . port)
-      (if (null? port)
-        (Cyc-read-line (current-input-port))
-        (Cyc-read-line (car port))))
+    (define (read-line . o)
+      (let* ((port (if (null? o)
+                       (current-input-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)
@@ -1239,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)
@@ -1345,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);")
-  (define exact truncate)
+    " return_double_op_no_cps(data, ptr, round_to_nearest_even, z);")
+  (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); "
@@ -1378,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);
@@ -1392,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 (even? num)  (= (modulo num 2) 0))
+  (define (odd? num)
+    (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)); ")
@@ -1412,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)"
@@ -1453,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
@@ -1495,8 +1526,17 @@
     "(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)

scheme/cyclone/common.sld

@@ -18,7 +18,7 @@
     memloc
   )
   (begin
-(define *version-number* "0.35.0")
+(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-2022 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-2022 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

@@ -1665,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
@@ -1694,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)
@@ -2230,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

@@ -286,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
@@ -462,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)
@@ -485,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)
@@ -505,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)
@@ -526,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/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.
-;; Try to wrap 
+;; Helper function for eval-from-c
+;; 
+;; 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 

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
-      (cons
-        '(begin)
-         (map
-          (lambda (filename)
+
+     (define (dirname filename)
+       (let loop ((index (string-length filename)))
+         (if (zero? index)
+             ""
+             (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))))
-          (cdr expr)))))))
+                (read-all/source port filename))))))))
 
 (define-syntax include-ci
   (er-macro-transformer
@@ -158,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));")
@@ -205,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))
@@ -264,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,18 +31,8 @@
                  (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))

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

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?
@@ -56,9 +53,9 @@
     mask
   )
   (begin
-    (define (fx-width) 31)
-    (define (fx-greatest) 1073741823)
-    (define (fx-least)   -1073741824)
+    (define fx-width 31)
+    (define fx-greatest 1073741823)
+    (define fx-least   -1073741824)
 
     (define-syntax bin-num-op
       (er-macro-transformer
@@ -161,10 +158,11 @@
          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)

srfi/18.sld

@@ -74,6 +74,7 @@
         ;; - 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 
@@ -82,6 +83,7 @@
           #f 
           #f
           #f
+          #f
           #f)))
 
     (define (thread-name t) (vector-ref t 3))
@@ -98,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)"
@@ -118,13 +120,21 @@
         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)
@@ -132,9 +142,33 @@
         t))
 
     (define (thread-yield!) (thread-sleep! 1))
-    (define-c thread-terminate!
-      "(void *data, object _, int argc, object *args)"
-      " Cyc_end_thread(data); ")
+
+    (define-c %thread-terminate!
+      "(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
@@ -156,6 +190,7 @@
       (cond
        ((and (thread? t) (Cyc-opaque? (vector-ref t 2)))
         (%thread-join! (vector-ref t 2))
+        (Cyc-minor-gc)
         (vector-ref t 7))
        (else
         #f))) ;; TODO: raise an error instead?

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

@@ -9,6 +9,9 @@
 
 (import 
   (scheme base)
+  (scheme eval)
+  (scheme inexact)
+  (scheme write)
   (cyclone test))
 
 
@@ -31,6 +34,14 @@
 )
 
 (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))
@@ -42,12 +53,87 @@
       (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
@@ -87,5 +173,45 @@
   (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)