Add some machinery to generate C

This is towards making a distribution that allows building from C,
rather than having to build from the Idris source, to make it easier to
install.

Makefile

@@ -26,7 +26,7 @@ VALID_IDRIS_VERSION_REGEXP = "1.3.2.*"
 
 -include custom.mk
 
-.PHONY: ttimp idris2 prelude test base clean lib_clean check_version
+.PHONY: ttimp idris2 prelude test base clean lib_clean check_version idris2c dist/idris2.c
 
 all: idris2 libs test
 
@@ -93,3 +93,9 @@ install-libs: libs
 	make -C libs/base install IDRIS2=../../idris2
 	make -C libs/network install IDRIS2=../../idris2 IDRIS2_VERSION=${IDRIS2_VERSION}
 	make -C libs/contrib install IDRIS2=../../idris2
+
+dist/idris2.c:
+	idris --build idris2-mkc.ipkg
+	cat idris2.c dist/rts/idris_main.c > dist/idris2.c
+
+idris2c: dist/idris2.c

dist/build.sh

@@ -0,0 +1,2 @@
+make -C rts
+clang idris2.c -o idris2 -I rts -L rts -lidris_rts -lpthread -lgmp -lm

dist/config.mk

@@ -0,0 +1,29 @@
+RANLIB          ?=ranlib
+CFLAGS          :=-O2 -Wall -std=c99 -pipe -fdata-sections -ffunction-sections -D_POSIX_C_SOURCE=200809L -DHAS_PTHREAD $(CFLAGS)
+
+ifneq (, $(findstring bsd, $(MACHINE)))
+	GMP_INCLUDE_DIR      :=
+else
+	GMP_INCLUDE_DIR      :=-I/usr/local/include
+endif
+
+MACHINE         := $(shell $(CC) -dumpmachine)
+ifneq (, $(findstring darwin, $(MACHINE)))
+	OS      :=darwin
+else ifneq (, $(findstring cygwin, $(MACHINE)))
+	OS      :=windows
+else ifneq (, $(findstring mingw, $(MACHINE)))
+	OS      :=windows
+else ifneq (, $(findstring windows, $(MACHINE)))
+	OS      :=windows
+else
+	OS      :=unix
+endif
+
+ifeq ($(OS),darwin)
+	SHLIB_SUFFIX    :=.dylib
+else ifeq ($(OS),windows)
+	SHLIB_SUFFIX    :=.DLL
+else
+	SHLIB_SUFFIX    :=.so
+endif

dist/rts/Makefile

@@ -0,0 +1,41 @@
+include ../config.mk
+
+OBJS = idris_rts.o idris_heap.o idris_gc.o idris_gmp.o idris_bitstring.o \
+       idris_opts.o idris_stats.o idris_utf8.o idris_stdfgn.o \
+       idris_buffer.o getline.o idris_net.o
+HDRS = idris_rts.h idris_heap.h idris_gc.h idris_gmp.h idris_bitstring.h \
+       idris_opts.h idris_stats.h idris_stdfgn.h idris_net.h \
+       idris_buffer.h idris_utf8.h getline.h
+CFLAGS := $(CFLAGS)
+CFLAGS += $(GMP_INCLUDE_DIR) $(GMP) -DIDRIS_TARGET_OS="\"$(OS)\""
+CFLAGS += -DIDRIS_TARGET_TRIPLE="\"$(MACHINE)\""
+
+ifeq ($(OS), windows)
+	OBJS += windows/win_utils.o
+else
+	CFLAGS += -fPIC
+endif
+
+ifndef IDRIS_GMP
+	OBJS += mini-gmp.o
+	HDRS += mini-gmp.h
+endif
+
+LIBTARGET = libidris_rts.a
+
+build: $(LIBTARGET) $(DYLIBTARGET)
+
+$(LIBTARGET) : $(OBJS)
+	$(AR) rc $(LIBTARGET) $(OBJS)
+	$(RANLIB) $(LIBTARGET)
+
+install :
+	mkdir -p $(TARGET)
+	install $(LIBTARGET) $(HDRS) $(TARGET)
+
+clean :
+	rm -f $(OBJS) $(LIBTARGET) $(DYLIBTARGET)
+
+$(OBJS): $(HDRS)
+
+.PHONY: build install clean

dist/rts/getline.c

@@ -0,0 +1,82 @@
+/*  $NetBSD: fgetln.c,v 1.9 2008/04/29 06:53:03 martin Exp $  */
+
+/*-
+ * Copyright (c) 2011 The NetBSD Foundation, Inc.
+ * All rights reserved.
+ *
+ * This code is derived from software contributed to The NetBSD Foundation
+ * by Christos Zoulas.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ * 1. Redistributions of source code must retain the above copyright
+ *    notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ *    notice, this list of conditions and the following disclaimer in the
+ *    documentation and/or other materials provided with the distribution.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE NETBSD FOUNDATION, INC. AND CONTRIBUTORS
+ * ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+ * TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+ * PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS
+ * BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
+ * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+ * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
+ * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
+ * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+ * POSSIBILITY OF SUCH DAMAGE.
+ */
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <unistd.h>
+#include <errno.h>
+#include <string.h>
+
+ssize_t
+getdelim(char **buf, size_t *bufsiz, int delimiter, FILE *fp)
+{
+    char *ptr, *eptr;
+
+    if (*buf == NULL || *bufsiz == 0) {
+        *bufsiz = BUFSIZ;
+        if ((*buf = malloc(*bufsiz)) == NULL)
+            return -1;
+    }
+
+    for (ptr = *buf, eptr = *buf + *bufsiz;;) {
+        int c = fgetc(fp);
+        if (c == -1) {
+            if (feof(fp)) {
+                *ptr = '\0';
+                return ptr - *buf;
+            } else {
+                return -1;
+            }
+        }
+        *ptr++ = c;
+        if (c == delimiter) {
+            *ptr = '\0';
+            return ptr - *buf;
+        }
+        if (ptr + 2 >= eptr) {
+            char *nbuf;
+            size_t nbufsiz = *bufsiz * 2;
+            ssize_t d = ptr - *buf;
+            if ((nbuf = realloc(*buf, nbufsiz)) == NULL)
+                return -1;
+            *buf = nbuf;
+            *bufsiz = nbufsiz;
+            eptr = nbuf + nbufsiz;
+            ptr = nbuf + d;
+        }
+    }
+}
+
+ssize_t
+getline(char **buf, size_t *bufsiz, FILE *fp)
+{
+  return getdelim(buf, bufsiz, '\n', fp);
+}

dist/rts/getline.h

@@ -0,0 +1,7 @@
+#ifndef GETLINE_H
+#define GETLINE_H
+#include <stdlib.h>
+#include <stdio.h>
+ssize_t getdelim(char **buf, size_t *bufsiz, int delimiter, FILE *fp);
+ssize_t getline(char **buf, size_t *bufsiz, FILE *fp);
+#endif // GETLINE_H

dist/rts/idris_bitstring.c

@@ -0,0 +1,593 @@
+#include <assert.h>
+
+#include "idris_rts.h"
+
+VAL idris_b8const(VM *vm, uint8_t a) {
+    return MKINT(a);
+}
+
+VAL idris_b16const(VM *vm, uint16_t a) {
+    return MKINT(a);
+}
+
+VAL idris_b32const(VM *vm, uint32_t a) {
+    Bits32 * cl = iallocate(vm, sizeof(*cl), 0);
+    SETTY(cl, CT_BITS32);
+    cl->bits32 = a;
+    return (VAL)cl;
+}
+
+VAL idris_b64const(VM *vm, uint64_t a) {
+    Bits64 * cl = iallocate(vm, sizeof(*cl), 0);
+    SETTY(cl, CT_BITS64);
+    cl->bits64 = a;
+    return (VAL)cl;
+}
+
+VAL idris_b8(VM *vm, VAL a) {
+    return idris_b8const(vm, GETINT(a));
+}
+
+VAL idris_b16(VM *vm, VAL a) {
+    return idris_b16const(vm, GETINT(a));
+}
+
+VAL idris_b32(VM *vm, VAL a) {
+    return idris_b32const(vm, GETINT(a));
+}
+
+VAL idris_b64(VM *vm, VAL a) {
+    return idris_b64const(vm, GETINT(a));
+}
+
+VAL idris_castB32Int(VM *vm, VAL a) {
+    return MKINT(GETBITS32(a));
+}
+
+VAL idris_b8Plus(VM *vm, VAL a, VAL b) {
+    uint8_t A = GETBITS8(a);
+    uint8_t B = GETBITS8(b);
+    return idris_b8const(vm, A + B);
+}
+
+VAL idris_b8Minus(VM *vm, VAL a, VAL b) {
+    uint8_t A = GETBITS8(a);
+    uint8_t B = GETBITS8(b);
+    return idris_b8const(vm, A - B);
+}
+
+VAL idris_b8Times(VM *vm, VAL a, VAL b) {
+    uint8_t A = GETBITS8(a);
+    uint8_t B = GETBITS8(b);
+    return idris_b8const(vm, A * B);
+}
+
+VAL idris_b8UDiv(VM *vm, VAL a, VAL b) {
+    uint8_t A = GETBITS8(a);
+    uint8_t B = GETBITS8(b);
+    return idris_b8const(vm, A / B);
+}
+
+VAL idris_b8SDiv(VM *vm, VAL a, VAL b) {
+    int8_t A = GETBITS8(a);
+    int8_t B = GETBITS8(b);
+    return idris_b8const(vm, A / B);
+}
+
+VAL idris_b8URem(VM *vm, VAL a, VAL b) {
+    uint8_t A = GETBITS8(a);
+    uint8_t B = GETBITS8(b);
+    return idris_b8const(vm, A % B);
+}
+
+VAL idris_b8SRem(VM *vm, VAL a, VAL b) {
+    int8_t A = GETBITS8(a);
+    int8_t B = GETBITS8(b);
+    return idris_b8const(vm, A % B);
+}
+
+VAL idris_b8Lt(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS8(a) < GETBITS8(b)));
+}
+
+VAL idris_b8Gt(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS8(a) > GETBITS8(b)));
+}
+
+VAL idris_b8Eq(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS8(a) == GETBITS8(b)));
+}
+
+VAL idris_b8Lte(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS8(a) <= GETBITS8(b)));
+}
+
+VAL idris_b8Gte(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS8(a) >= GETBITS8(b)));
+}
+
+VAL idris_b8Compl(VM *vm, VAL a) {
+    uint8_t A = GETBITS8(a);
+    return idris_b8const(vm, ~ A);
+}
+
+VAL idris_b8And(VM *vm, VAL a, VAL b) {
+    uint8_t A = GETBITS8(a);
+    uint8_t B = GETBITS8(b);
+    return idris_b8const(vm, A & B);
+}
+
+VAL idris_b8Or(VM *vm, VAL a, VAL b) {
+    uint8_t A = GETBITS8(a);
+    uint8_t B = GETBITS8(b);
+    return idris_b8const(vm, A | B);
+}
+
+VAL idris_b8Xor(VM *vm, VAL a, VAL b) {
+    uint8_t A = GETBITS8(a);
+    uint8_t B = GETBITS8(b);
+    return idris_b8const(vm, A ^ B);
+}
+
+VAL idris_b8Shl(VM *vm, VAL a, VAL b) {
+    uint8_t A = GETBITS8(a);
+    uint8_t B = GETBITS8(b);
+    return idris_b8const(vm, A << B);
+}
+
+VAL idris_b8LShr(VM *vm, VAL a, VAL b) {
+    uint8_t A = GETBITS8(a);
+    uint8_t B = GETBITS8(b);
+    return idris_b8const(vm, A >> B);
+}
+
+VAL idris_b8AShr(VM *vm, VAL a, VAL b) {
+    int8_t A = GETBITS8(a);
+    int8_t B = GETBITS8(b);
+    return idris_b8const(vm, A >> B);
+}
+
+VAL idris_b16Plus(VM *vm, VAL a, VAL b) {
+    uint16_t A = GETBITS16(a);
+    uint16_t B = GETBITS16(b);
+    return idris_b16const(vm, A + B);
+}
+
+VAL idris_b16Minus(VM *vm, VAL a, VAL b) {
+    uint16_t A = GETBITS16(a);
+    uint16_t B = GETBITS16(b);
+    return idris_b16const(vm, A - B);
+}
+
+VAL idris_b16Times(VM *vm, VAL a, VAL b) {
+    uint16_t A = GETBITS16(a);
+    uint16_t B = GETBITS16(b);
+    return idris_b16const(vm, A * B);
+}
+
+VAL idris_b16UDiv(VM *vm, VAL a, VAL b) {
+    uint16_t A = GETBITS16(a);
+    uint16_t B = GETBITS16(b);
+    return idris_b16const(vm, A / B);
+}
+
+VAL idris_b16SDiv(VM *vm, VAL a, VAL b) {
+    int16_t A = GETBITS16(a);
+    int16_t B = GETBITS16(b);
+    return idris_b16const(vm, A / B);
+}
+
+VAL idris_b16URem(VM *vm, VAL a, VAL b) {
+    uint16_t A = GETBITS16(a);
+    uint16_t B = GETBITS16(b);
+    return idris_b16const(vm, A % B);
+}
+
+VAL idris_b16SRem(VM *vm, VAL a, VAL b) {
+    int16_t A = GETBITS16(a);
+    int16_t B = GETBITS16(b);
+    return idris_b16const(vm, A % B);
+}
+
+VAL idris_b16Lt(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS16(a) < GETBITS16(b)));
+}
+
+VAL idris_b16Gt(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS16(a) > GETBITS16(b)));
+}
+
+VAL idris_b16Eq(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS16(a) == GETBITS16(b)));
+}
+
+VAL idris_b16Lte(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS16(a) <= GETBITS16(b)));
+}
+
+VAL idris_b16Gte(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS16(a) >= GETBITS16(b)));
+}
+
+VAL idris_b16Compl(VM *vm, VAL a) {
+    uint16_t A = GETBITS16(a);
+    return idris_b16const(vm, ~ A);
+}
+
+VAL idris_b16And(VM *vm, VAL a, VAL b) {
+    uint16_t A = GETBITS16(a);
+    uint16_t B = GETBITS16(b);
+    return idris_b16const(vm, A & B);
+}
+
+VAL idris_b16Or(VM *vm, VAL a, VAL b) {
+    uint16_t A = GETBITS16(a);
+    uint16_t B = GETBITS16(b);
+    return idris_b16const(vm, A | B);
+}
+
+VAL idris_b16Xor(VM *vm, VAL a, VAL b) {
+    uint16_t A = GETBITS16(a);
+    uint16_t B = GETBITS16(b);
+    return idris_b16const(vm, A ^ B);
+}
+
+VAL idris_b16Shl(VM *vm, VAL a, VAL b) {
+    uint16_t A = GETBITS16(a);
+    uint16_t B = GETBITS16(b);
+    return idris_b16const(vm, A << B);
+}
+
+VAL idris_b16LShr(VM *vm, VAL a, VAL b) {
+    uint16_t A = GETBITS16(a);
+    uint16_t B = GETBITS16(b);
+    return idris_b16const(vm, A >> B);
+}
+
+VAL idris_b16AShr(VM *vm, VAL a, VAL b) {
+    int16_t A = GETBITS16(a);
+    int16_t B = GETBITS16(b);
+    return idris_b16const(vm, A >> B);
+}
+
+VAL idris_b32Plus(VM *vm, VAL a, VAL b) {
+    uint32_t A = GETBITS32(a);
+    uint32_t B = GETBITS32(b);
+    return idris_b32const(vm, A + B);
+}
+
+VAL idris_b32Minus(VM *vm, VAL a, VAL b) {
+    uint32_t A = GETBITS32(a);
+    uint32_t B = GETBITS32(b);
+    return idris_b32const(vm, A - B);
+}
+
+VAL idris_b32Times(VM *vm, VAL a, VAL b) {
+    uint32_t A = GETBITS32(a);
+    uint32_t B = GETBITS32(b);
+    return idris_b32const(vm, A * B);
+}
+
+VAL idris_b32UDiv(VM *vm, VAL a, VAL b) {
+    uint32_t A = GETBITS32(a);
+    uint32_t B = GETBITS32(b);
+    return idris_b32const(vm, A / B);
+}
+
+VAL idris_b32SDiv(VM *vm, VAL a, VAL b) {
+    int32_t A = GETBITS32(a);
+    int32_t B = GETBITS32(b);
+    return idris_b32const(vm, A / B);
+}
+
+VAL idris_b32URem(VM *vm, VAL a, VAL b) {
+    uint32_t A = GETBITS32(a);
+    uint32_t B = GETBITS32(b);
+    return idris_b32const(vm, A % B);
+}
+
+VAL idris_b32SRem(VM *vm, VAL a, VAL b) {
+    int32_t A = GETBITS32(a);
+    int32_t B = GETBITS32(b);
+    return idris_b32const(vm, A % B);
+}
+
+VAL idris_b32Lt(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS32(a) < GETBITS32(b)));
+}
+
+VAL idris_b32Gt(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS32(a) > GETBITS32(b)));
+}
+
+VAL idris_b32Eq(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS32(a) == GETBITS32(b)));
+}
+
+VAL idris_b32Lte(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS32(a) <= GETBITS32(b)));
+}
+
+VAL idris_b32Gte(VM *vm, VAL a, VAL b) {
+    return MKINT((i_int) (GETBITS32(a) >= GETBITS32(b)));
+}
+
+VAL idris_b32Compl(VM *vm, VAL a) {
+    uint32_t A = GETBITS32(a);
+    return idris_b32const(vm, ~ A);
+}
+
+VAL idris_b32And(VM *vm, VAL a, VAL b) {
+    uint32_t A = GETBITS32(a);
+    uint32_t B = GETBITS32(b);
+    return idris_b32const(vm, A & B);
+}
+
+VAL idris_b32Or(VM *vm, VAL a, VAL b) {
+    uint32_t A = GETBITS32(a);
+    uint32_t B = GETBITS32(b);
+    return idris_b32const(vm, A | B);
+}
+
+VAL idris_b32Xor(VM *vm, VAL a, VAL b) {
+    uint32_t A = GETBITS32(a);
+    uint32_t B = GETBITS32(b);
+    return idris_b32const(vm, A ^ B);
+}
+
+VAL idris_b32Shl(VM *vm, VAL a, VAL b) {
+    uint32_t A = GETBITS32(a);
+    uint32_t B = GETBITS32(b);
+    return idris_b32const(vm, A << B);
+}
+
+VAL idris_b32LShr(VM *vm, VAL a, VAL b) {
+    uint32_t A = GETBITS32(a);
+    uint32_t B = GETBITS32(b);
+    return idris_b32const(vm, A >> B);
+}
+
+VAL idris_b32AShr(VM *vm, VAL a, VAL b) {
+    int32_t A = GETBITS32(a);
+    int32_t B = GETBITS32(b);
+    return idris_b32const(vm, A >> B);
+}
+
+VAL idris_b64Plus(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return idris_b64const(vm, A + B);
+}
+
+VAL idris_b64Minus(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return idris_b64const(vm, A - B);
+}
+
+VAL idris_b64Times(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return idris_b64const(vm, A * B);
+}
+
+VAL idris_b64UDiv(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return idris_b64const(vm, A / B);
+}
+
+VAL idris_b64SDiv(VM *vm, VAL a, VAL b) {
+    int64_t A = GETBITS64(a);
+    int64_t B = GETBITS64(b);
+    return idris_b64const(vm, A / B);
+}
+
+VAL idris_b64URem(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return idris_b64const(vm, A % B);
+}
+
+VAL idris_b64SRem(VM *vm, VAL a, VAL b) {
+    int64_t A = GETBITS64(a);
+    int64_t B = GETBITS64(b);
+    return idris_b64const(vm, A % B);
+}
+
+VAL idris_b64Lt(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return MKINT((i_int) (A < B));
+}
+
+VAL idris_b64Gt(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return MKINT((i_int) (A > B));
+}
+
+VAL idris_b64Eq(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return MKINT((i_int) (A == B));
+}
+
+VAL idris_b64Lte(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return MKINT((i_int) (A <= B));
+}
+
+VAL idris_b64Gte(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return MKINT((i_int) (A >= B));
+}
+
+VAL idris_b64Compl(VM *vm, VAL a) {
+    uint64_t A = GETBITS64(a);
+    return idris_b64const(vm, ~ A);
+}
+
+VAL idris_b64And(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return idris_b64const(vm, A & B);
+}
+
+VAL idris_b64Or(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return idris_b64const(vm, A | B);
+}
+
+VAL idris_b64Xor(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return idris_b64const(vm, A ^ B);
+}
+
+VAL idris_b64Shl(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return idris_b64const(vm, A << B);
+}
+
+VAL idris_b64LShr(VM *vm, VAL a, VAL b) {
+    uint64_t A = GETBITS64(a);
+    uint64_t B = GETBITS64(b);
+    return idris_b64const(vm, A >> B);
+}
+
+VAL idris_b64AShr(VM *vm, VAL a, VAL b) {
+    int64_t A = GETBITS64(a);
+    int64_t B = GETBITS64(b);
+    return idris_b64const(vm, A >> B);
+}
+
+VAL idris_b8Z16(VM *vm, VAL a) {
+    uint8_t A = GETBITS8(a);
+    return idris_b16const(vm, A);
+}
+
+VAL idris_b8Z32(VM *vm, VAL a) {
+    uint8_t A = GETBITS8(a);
+    return idris_b32const(vm, A);
+}
+
+VAL idris_b8Z64(VM *vm, VAL a) {
+    uint8_t A = GETBITS8(a);
+    return idris_b64const(vm, A);
+}
+
+VAL idris_b8S16(VM *vm, VAL a) {
+    int8_t A = GETBITS8(a);
+    return idris_b16const(vm, (int16_t) A);
+}
+
+VAL idris_b8S32(VM *vm, VAL a) {
+    int8_t A = GETBITS8(a);
+    return idris_b32const(vm, (int32_t) A);
+}
+
+VAL idris_b8S64(VM *vm, VAL a) {
+    int8_t A = GETBITS8(a);
+    return idris_b64const(vm, (int64_t) A);
+}
+
+VAL idris_b16Z32(VM *vm, VAL a) {
+    uint16_t A = GETBITS16(a);
+    return idris_b32const(vm, (uint32_t) A);
+}
+
+VAL idris_b16Z64(VM *vm, VAL a) {
+    uint16_t A = GETBITS16(a);
+    return idris_b64const(vm, (uint64_t) A);
+}
+
+VAL idris_b16S32(VM *vm, VAL a) {
+    int16_t A = GETBITS16(a);
+    return idris_b32const(vm, (int32_t) A);
+}
+
+VAL idris_b16S64(VM *vm, VAL a) {
+    int16_t A = GETBITS16(a);
+    return idris_b64const(vm, (int64_t) A);
+}
+
+VAL idris_b16T8(VM *vm, VAL a) {
+    uint16_t A = GETBITS16(a);
+    return idris_b8const(vm, (uint8_t) A);
+}
+
+VAL idris_b32Z64(VM *vm, VAL a) {
+    uint32_t A = GETBITS32(a);
+    return idris_b64const(vm, (uint64_t) A);
+}
+
+VAL idris_b32S64(VM *vm, VAL a) {
+    int32_t A = GETBITS32(a);
+    return idris_b64const(vm, (int64_t) A);
+}
+
+VAL idris_b32T8(VM *vm, VAL a) {
+    uint32_t A = GETBITS32(a);
+    return idris_b8const(vm, (uint8_t) A);
+}
+
+VAL idris_b32T16(VM *vm, VAL a) {
+    uint32_t A = GETBITS32(a);
+    return idris_b16const(vm, (uint16_t) A);
+}
+
+VAL idris_b64T8(VM *vm, VAL a) {
+    uint64_t A = GETBITS64(a);
+    return idris_b8const(vm, (uint8_t) A);
+}
+
+VAL idris_b64T16(VM *vm, VAL a) {
+    uint64_t A = GETBITS64(a);
+    return idris_b16const(vm, (uint16_t) A);
+}
+
+VAL idris_b64T32(VM *vm, VAL a) {
+    uint64_t A = GETBITS64(a);
+    return idris_b32const(vm, (uint32_t) A);
+}
+
+VAL idris_peekB8(VM* vm, VAL ptr, VAL offset) {
+    return MKB8(vm, *(uint8_t*)((char *)GETPTR(ptr) + GETINT(offset)));
+}
+
+VAL idris_pokeB8(VAL ptr, VAL offset, VAL data) {
+    *(uint8_t*)((char *)GETPTR(ptr) + GETINT(offset)) = GETBITS8(data);
+    return MKINT(0);
+}
+
+VAL idris_peekB16(VM* vm, VAL ptr, VAL offset) {
+    return MKB16(vm, *(uint16_t*)((char *)GETPTR(ptr) + GETINT(offset)));
+}
+
+VAL idris_pokeB16(VAL ptr, VAL offset, VAL data) {
+    *(uint16_t*)((char *)GETPTR(ptr) + GETINT(offset)) = GETBITS16(data);
+    return MKINT(0);
+}
+
+VAL idris_peekB32(VM* vm, VAL ptr, VAL offset) {
+    return MKB32(vm, *(uint32_t*)((char *)GETPTR(ptr) + GETINT(offset)));
+}
+
+VAL idris_pokeB32(VAL ptr, VAL offset, VAL data) {
+    *(uint32_t*)((char *)GETPTR(ptr) + GETINT(offset)) = GETBITS32(data);
+    return MKINT(0);
+}
+
+VAL idris_peekB64(VM* vm, VAL ptr, VAL offset) {
+    return MKB64(vm, *(uint64_t*)((char *)GETPTR(ptr) + GETINT(offset)));
+}
+
+VAL idris_pokeB64(VAL ptr, VAL offset, VAL data) {
+    *(uint64_t*)((char *)GETPTR(ptr) + GETINT(offset)) = GETBITS64(data);
+    return MKINT(0);
+}

dist/rts/idris_bitstring.h

@@ -0,0 +1,134 @@
+#ifndef _IDRISBITSTRING_H
+#define _IDRISBITSTRING_H
+
+VAL idris_b8(VM *vm, VAL a);
+VAL idris_b16(VM *vm, VAL a);
+VAL idris_b32(VM *vm, VAL a);
+VAL idris_b64(VM *vm, VAL a);
+VAL idris_castB32Int(VM *vm, VAL a);
+VAL idris_b8const(VM *vm, uint8_t a);
+VAL idris_b16const(VM *vm, uint16_t a);
+VAL idris_b32const(VM *vm, uint32_t a);
+VAL idris_b64const(VM *vm, uint64_t a);
+
+VAL idris_b8Plus(VM *vm, VAL a, VAL b);
+VAL idris_b8Minus(VM *vm, VAL a, VAL b);
+VAL idris_b8Times(VM *vm, VAL a, VAL b);
+VAL idris_b8UDiv(VM *vm, VAL a, VAL b);
+VAL idris_b8SDiv(VM *vm, VAL a, VAL b);
+VAL idris_b8URem(VM *vm, VAL a, VAL b);
+VAL idris_b8SRem(VM *vm, VAL a, VAL b);
+VAL idris_b8Lt(VM *vm, VAL a, VAL b);
+VAL idris_b8Gt(VM *vm, VAL a, VAL b);
+VAL idris_b8Eq(VM *vm, VAL a, VAL b);
+VAL idris_b8Lte(VM *vm, VAL a, VAL b);
+VAL idris_b8Gte(VM *vm, VAL a, VAL b);
+VAL idris_b8Compl(VM *vm, VAL a);
+VAL idris_b8And(VM *vm, VAL a, VAL b);
+VAL idris_b8Or(VM *vm, VAL a, VAL b);
+VAL idris_b8Neg(VM *vm, VAL a);
+VAL idris_b8Xor(VM *vm, VAL a, VAL b);
+VAL idris_b8Shl(VM *vm, VAL a, VAL b);
+VAL idris_b8LShr(VM *vm, VAL a, VAL b);
+VAL idris_b8AShr(VM *vm, VAL a, VAL b);
+
+VAL idris_b16Eq(VM *vm, VAL a, VAL b);
+VAL idris_b32Eq(VM *vm, VAL a, VAL b);
+VAL idris_b64Eq(VM *vm, VAL a, VAL b);
+
+VAL idris_b8Z16(VM *vm, VAL a);
+VAL idris_b8Z32(VM *vm, VAL a);
+VAL idris_b8Z64(VM *vm, VAL a);
+VAL idris_b8S16(VM *vm, VAL a);
+VAL idris_b8S32(VM *vm, VAL a);
+VAL idris_b8S64(VM *vm, VAL a);
+
+VAL idris_b16Plus(VM *vm, VAL a, VAL b);
+VAL idris_b16Minus(VM *vm, VAL a, VAL b);
+VAL idris_b16Times(VM *vm, VAL a, VAL b);
+VAL idris_b16UDiv(VM *vm, VAL a, VAL b);
+VAL idris_b16SDiv(VM *vm, VAL a, VAL b);
+VAL idris_b16URem(VM *vm, VAL a, VAL b);
+VAL idris_b16SRem(VM *vm, VAL a, VAL b);
+VAL idris_b16Lt(VM *vm, VAL a, VAL b);
+VAL idris_b16Gt(VM *vm, VAL a, VAL b);
+VAL idris_b16Eq(VM *vm, VAL a, VAL b);
+VAL idris_b16Lte(VM *vm, VAL a, VAL b);
+VAL idris_b16Gte(VM *vm, VAL a, VAL b);
+VAL idris_b16Compl(VM *vm, VAL a);
+VAL idris_b16And(VM *vm, VAL a, VAL b);
+VAL idris_b16Or(VM *vm, VAL a, VAL b);
+VAL idris_b16Neg(VM *vm, VAL a);
+VAL idris_b16Xor(VM *vm, VAL a, VAL b);
+VAL idris_b16Shl(VM *vm, VAL a, VAL b);
+VAL idris_b16LShr(VM *vm, VAL a, VAL b);
+VAL idris_b16AShr(VM *vm, VAL a, VAL b);
+
+VAL idris_b16Z32(VM *vm, VAL a);
+VAL idris_b16Z64(VM *vm, VAL a);
+VAL idris_b16S32(VM *vm, VAL a);
+VAL idris_b16S64(VM *vm, VAL a);
+VAL idris_b16T8(VM *vm, VAL a);
+
+VAL idris_b32Plus(VM *vm, VAL a, VAL b);
+VAL idris_b32Minus(VM *vm, VAL a, VAL b);
+VAL idris_b32Times(VM *vm, VAL a, VAL b);
+VAL idris_b32UDiv(VM *vm, VAL a, VAL b);
+VAL idris_b32SDiv(VM *vm, VAL a, VAL b);
+VAL idris_b32URem(VM *vm, VAL a, VAL b);
+VAL idris_b32SRem(VM *vm, VAL a, VAL b);
+VAL idris_b32Lt(VM *vm, VAL a, VAL b);
+VAL idris_b32Gt(VM *vm, VAL a, VAL b);
+VAL idris_b32Eq(VM *vm, VAL a, VAL b);
+VAL idris_b32Lte(VM *vm, VAL a, VAL b);
+VAL idris_b32Gte(VM *vm, VAL a, VAL b);
+VAL idris_b32Compl(VM *vm, VAL a);
+VAL idris_b32And(VM *vm, VAL a, VAL b);
+VAL idris_b32Or(VM *vm, VAL a, VAL b);
+VAL idris_b32Neg(VM *vm, VAL a);
+VAL idris_b32Xor(VM *vm, VAL a, VAL b);
+VAL idris_b32Shl(VM *vm, VAL a, VAL b);
+VAL idris_b32LShr(VM *vm, VAL a, VAL b);
+VAL idris_b32AShr(VM *vm, VAL a, VAL b);
+
+VAL idris_b32Z64(VM *vm, VAL a);
+VAL idris_b32S64(VM *vm, VAL a);
+VAL idris_b32T8(VM *vm, VAL a);
+VAL idris_b32T16(VM *vm, VAL a);
+
+VAL idris_b64Plus(VM *vm, VAL a, VAL b);
+VAL idris_b64Minus(VM *vm, VAL a, VAL b);
+VAL idris_b64Times(VM *vm, VAL a, VAL b);
+VAL idris_b64UDiv(VM *vm, VAL a, VAL b);
+VAL idris_b64SDiv(VM *vm, VAL a, VAL b);
+VAL idris_b64URem(VM *vm, VAL a, VAL b);
+VAL idris_b64SRem(VM *vm, VAL a, VAL b);
+VAL idris_b64Lt(VM *vm, VAL a, VAL b);
+VAL idris_b64Gt(VM *vm, VAL a, VAL b);
+VAL idris_b64Eq(VM *vm, VAL a, VAL b);
+VAL idris_b64Lte(VM *vm, VAL a, VAL b);
+VAL idris_b64Gte(VM *vm, VAL a, VAL b);
+VAL idris_b64Compl(VM *vm, VAL a);
+VAL idris_b64And(VM *vm, VAL a, VAL b);
+VAL idris_b64Or(VM *vm, VAL a, VAL b);
+VAL idris_b64Neg(VM *vm, VAL a);
+VAL idris_b64Xor(VM *vm, VAL a, VAL b);
+VAL idris_b64Shl(VM *vm, VAL a, VAL b);
+VAL idris_b64LShr(VM *vm, VAL a, VAL b);
+VAL idris_b64AShr(VM *vm, VAL a, VAL b);
+
+VAL idris_b64T8(VM *vm, VAL a);
+VAL idris_b64T16(VM *vm, VAL a);
+VAL idris_b64T32(VM *vm, VAL a);
+
+// memory access
+VAL idris_peekB8(VM* vm, VAL ptr, VAL offset);
+VAL idris_pokeB8(VAL ptr, VAL offset, VAL data);
+VAL idris_peekB16(VM* vm, VAL ptr, VAL offset);
+VAL idris_pokeB16(VAL ptr, VAL offset, VAL data);
+VAL idris_peekB32(VM* vm, VAL ptr, VAL offset);
+VAL idris_pokeB32(VAL ptr, VAL offset, VAL data);
+VAL idris_peekB64(VM* vm, VAL ptr, VAL offset);
+VAL idris_pokeB64(VAL ptr, VAL offset, VAL data);
+
+#endif

dist/rts/idris_buffer.c

@@ -0,0 +1,146 @@
+#include "idris_rts.h"
+#include "idris_buffer.h"
+
+typedef struct {
+    int size;
+    uint8_t data[0];
+} Buffer;
+
+VAL idris_newBuffer(VM* vm, int bytes) {
+    size_t size = sizeof(Buffer) + bytes*sizeof(uint8_t);
+
+    Buffer* buf = malloc(size);
+    if (buf == NULL) {
+        return NULL;
+    }
+
+    buf->size = bytes;
+    memset(buf->data, 0, bytes);
+
+    void* retbuf = MKMPTR(vm, buf, size);
+    free(buf);
+    return retbuf;
+}
+
+void idris_copyBuffer(void* from, int start, int len,
+                      void* to, int loc) {
+    Buffer* bfrom = from;
+    Buffer* bto = to;
+
+    if (loc >= 0 && loc+len <= bto->size) {
+        memcpy(bto->data + loc, bfrom->data + start, len);
+    }
+}
+
+int idris_getBufferSize(void* buffer) {
+    return ((Buffer*)buffer)->size;
+}
+
+void idris_setBufferByte(void* buffer, int loc, uint8_t byte) {
+    Buffer* b = buffer;
+    if (loc >= 0 && loc < b->size) {
+        b->data[loc] = byte;
+    }
+}
+
+void idris_setBufferInt(void* buffer, int loc, int val) {
+    Buffer* b = buffer;
+    if (loc >= 0 && loc+3 < b->size) {
+        b->data[loc] = val & 0xff;
+        b->data[loc+1] = (val >> 8) & 0xff;
+        b->data[loc+2] = (val >> 16) & 0xff;
+        b->data[loc+3] = (val >> 24) & 0xff;
+    }
+}
+
+void idris_setBufferDouble(void* buffer, int loc, double val) {
+    Buffer* b = buffer;
+    // I am not proud of this
+    if (loc >= 0 && loc + sizeof(double) <= b->size) {
+        unsigned char* c = (unsigned char*)(& val);
+        int i;
+        for (i = 0; i < sizeof(double); ++i) {
+            b->data[loc+i] = c[i];
+        }
+    }
+}
+
+void idris_setBufferString(void* buffer, int loc, char* str) {
+    Buffer* b = buffer;
+    int len = strlen(str);
+
+    if (loc >= 0 && loc+len <= b->size) {
+        memcpy((b->data)+loc, str, len);
+    }
+}
+
+uint8_t idris_getBufferByte(void* buffer, int loc) {
+    Buffer* b = buffer;
+    if (loc >= 0 && loc < b->size) {
+        return b->data[loc];
+    } else {
+        return 0;
+    }
+}
+
+int idris_getBufferInt(void* buffer, int loc) {
+    Buffer* b = buffer;
+    if (loc >= 0 && loc+3 < b->size) {
+        return b->data[loc] +
+               (b->data[loc+1] << 8) +
+               (b->data[loc+2] << 16) +
+               (b->data[loc+3] << 24);
+    } else {
+        return 0;
+    }
+}
+
+double idris_getBufferDouble(void* buffer, int loc) {
+    Buffer* b = buffer;
+    double d;
+    // I am even less proud of this
+    unsigned char *c = (unsigned char*)(& d);
+    if (loc >= 0 && loc + sizeof(double) <= b->size) {
+        int i;
+        for (i = 0; i < sizeof(double); ++i) {
+            c[i] = b->data[loc+i];
+        }
+        return d;
+    }
+    else {
+        return 0;
+    }
+}
+
+VAL idris_getBufferString(void* buffer, int loc, int len) {
+    Buffer* b = buffer;
+    char * s = (char*)(b->data + loc);
+    size_t sz = loc >= 0 && loc+len <= b->size? len : 0;
+    return MKSTRlen(get_vm(), s, sz);
+}
+
+int idris_readBuffer(FILE* h, void* buffer, int loc, int max) {
+    Buffer* b = buffer;
+    size_t len;
+
+    if (loc >= 0 && loc < b->size) {
+        if (loc + max > b->size) {
+            max = b->size - loc;
+        }
+        len = fread((b->data)+loc, sizeof(uint8_t), (size_t)max, h);
+        return len;
+    } else {
+        return 0;
+    }
+}
+
+void idris_writeBuffer(FILE* h, void* buffer, int loc, int len) {
+    Buffer* b = buffer;
+
+    if (loc >= 0 && loc < b->size) {
+        if (loc + len > b->size) {
+            len = b->size - loc;
+        }
+        fwrite((b->data)+loc, sizeof(uint8_t), len, h);
+    }
+}

dist/rts/idris_buffer.h

@@ -0,0 +1,29 @@
+#ifndef __BUFFER_H
+#define __BUFFER_H
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <stdint.h>
+#include "idris_rts.h"
+
+VAL idris_newBuffer(VM* vm, int bytes);
+
+int idris_getBufferSize(void* buffer);
+
+void idris_setBufferByte(void* buffer, int loc, uint8_t byte);
+void idris_setBufferInt(void* buffer, int loc, int val);
+void idris_setBufferDouble(void* buffer, int loc, double val);
+void idris_setBufferString(void* buffer, int loc, char* str);
+
+void idris_copyBuffer(void* from, int start, int len,
+                      void* to, int loc);
+
+int idris_readBuffer(FILE* h, void* buffer, int loc, int max);
+void idris_writeBuffer(FILE* h, void* buffer, int loc, int len);
+
+uint8_t idris_getBufferByte(void* buffer, int loc);
+int idris_getBufferInt(void* buffer, int loc);
+double idris_getBufferDouble(void* buffer, int loc);
+VAL idris_getBufferString(void* buffer, int loc, int len);
+
+#endif

dist/rts/idris_gc.c

@@ -0,0 +1,156 @@
+#include "idris_heap.h"
+#include "idris_rts.h"
+#include "idris_gc.h"
+#include "idris_bitstring.h"
+#include <assert.h>
+
+static inline VAL copy_plain(VM* vm, VAL x, size_t sz) {
+    VAL cl = iallocate(vm, sz, 1);
+    memcpy(cl, x, sz);
+    return cl;
+}
+
+VAL copy(VM* vm, VAL x) {
+    int ar;
+    VAL cl;
+    if (x==NULL) {
+        return x;
+    }
+    switch(GETTY(x)) {
+    case CT_INT: return x;
+    case CT_BITS32: return copy_plain(vm, x, sizeof(Bits32));
+    case CT_BITS64: return copy_plain(vm, x, sizeof(Bits64));
+    case CT_FLOAT: return copy_plain(vm, x, sizeof(Float));
+    case CT_FWD:
+        return GETPTR(x);
+    case CT_CDATA:
+        cl = copy_plain(vm, x, sizeof(CDataC));
+        c_heap_mark_item(GETCDATA(x));
+        break;
+    case CT_BIGINT:
+        cl = MKBIGMc(vm, GETMPZ(x));
+        break;
+    case CT_CON:
+        ar = CARITY(x);
+        if (ar == 0 && CTAG(x) < 256) {
+            return x;
+        }
+        // FALLTHROUGH
+    case CT_ARRAY:
+    case CT_STRING:
+    case CT_REF:
+    case CT_STROFFSET:
+    case CT_PTR:
+    case CT_MANAGEDPTR:
+    case CT_RAWDATA:
+        cl = copy_plain(vm, x, x->hdr.sz);
+        break;
+    default:
+        cl = NULL;
+        assert(0);
+        break;
+    }
+    assert(x->hdr.sz >= sizeof(Fwd));
+    SETTY(x, CT_FWD);
+    ((Fwd*)x)->fwd = cl;
+    return cl;
+}
+
+void cheney(VM *vm) {
+    char* scan = aligned_heap_pointer(vm->heap.heap);
+
+    while(scan < vm->heap.next) {
+       VAL heap_item = (VAL)scan;
+       // If it's a CT_CON, CT_REF or CT_STROFFSET, copy its arguments
+       switch(GETTY(heap_item)) {
+       case CT_CON:
+           {
+               Con * c = (Con*)heap_item;
+               size_t len = CARITY(c);
+               for(size_t i = 0; i < len; ++i)
+                   c->args[i] = copy(vm, c->args[i]);
+           }
+           break;
+       case CT_ARRAY:
+           {
+               Array * a = (Array*)heap_item;
+               size_t len = CELEM(a);
+               for(size_t i = 0; i < len; ++i)
+                   a->array[i] = copy(vm, a->array[i]);
+           }
+           break;
+       case CT_REF:
+           {
+               Ref * r = (Ref*)heap_item;
+               r->ref = copy(vm, r->ref);
+           }
+           break;
+       case CT_STROFFSET:
+           {
+               StrOffset * s = (StrOffset*)heap_item;
+               s->base = (String*)copy(vm, (VAL)s->base);
+           }
+           break;
+       default: // Nothing to copy
+           break;
+       }
+       scan += aligned(valSize(heap_item));
+    }
+    assert(scan == vm->heap.next);
+}
+
+void idris_gc(VM* vm) {
+    HEAP_CHECK(vm)
+    STATS_ENTER_GC(vm->stats, vm->heap.size)
+
+    if (vm->heap.old != NULL)
+        free(vm->heap.old);
+
+    /* Allocate swap heap. */
+    alloc_heap(&vm->heap, vm->heap.size, vm->heap.growth, vm->heap.heap);
+
+    VAL* root;
+
+    for(root = vm->valstack; root < vm->valstack_top; ++root) {
+        *root = copy(vm, *root);
+    }
+
+#ifdef HAS_PTHREAD
+    Msg* msg;
+
+    for(msg = vm->inbox; msg < vm->inbox_write; ++msg) {
+        msg->msg = copy(vm, msg->msg);
+    }
+#endif
+
+    vm->ret = copy(vm, vm->ret);
+    vm->reg1 = copy(vm, vm->reg1);
+
+    cheney(vm);
+
+    // After reallocation, if we've still more than half filled the new heap, grow the heap
+    // for next time.
+
+    if ((vm->heap.next - vm->heap.heap) > vm->heap.size >> 1) {
+        vm->heap.size += vm->heap.growth;
+    }
+
+    // finally, sweep the C heap
+    c_heap_sweep(&vm->c_heap);
+
+    STATS_LEAVE_GC(vm->stats, vm->heap.size, vm->heap.next - vm->heap.heap)
+    HEAP_CHECK(vm)
+}
+
+void idris_gcInfo(VM* vm, int doGC) {
+    printf("Stack: <BOT %p> <TOP %p>\n", vm->valstack, vm->valstack_top);
+    printf("Final heap size         %zd\n", vm->heap.size);
+    printf("Final heap use          %zd\n", vm->heap.next - vm->heap.heap);
+    if (doGC) { idris_gc(vm); }
+    printf("Final heap use after GC %zd\n", vm->heap.next - vm->heap.heap);
+#ifdef IDRIS_ENABLE_STATS
+    printf("Total allocations       %" PRIu64 "\n", vm->stats.allocations);
+#endif
+    printf("Number of collections   %" PRIu32 "\n", vm->stats.collections);
+
+}

dist/rts/idris_gc.h

@@ -0,0 +1,9 @@
+#ifndef _IDRISGC_H
+#define _IDRISGC_H
+
+#include "idris_rts.h"
+
+void idris_gc(VM* vm);
+void idris_gcInfo(VM* vm, int doGC);
+
+#endif

dist/rts/idris_gmp.c

@@ -0,0 +1,377 @@
+#include "idris_rts.h"
+#ifdef IDRIS_GMP
+#include <gmp.h>
+#else
+#include "mini-gmp.h"
+#endif
+#include <stdlib.h>
+#include <string.h>
+
+// TMP HACK! Require this much space in the heap before a GMP operation
+// so it doesn't garbage collect in the middle.
+// This is highly dodgy and needs to be done better because who knows if
+// GMP will need to allocate more than 64k... better to work out how
+// much space is needed (or find another way of preventing copying)
+#define IDRIS_MAXGMP 65536
+
+void init_gmpalloc(void) {
+    mp_set_memory_functions(idris_alloc, idris_realloc, idris_free);
+}
+
+VAL MKBIGI(int val) {
+    return MKINT((i_int)val);
+}
+
+static BigInt * allocBig(VM * vm) {
+    idris_requireAlloc(vm, IDRIS_MAXGMP);
+    BigInt * cl = iallocate(vm, sizeof(*cl) + sizeof(mpz_t), 0);
+    idris_doneAlloc(vm);
+    SETTY(cl, CT_BIGINT);
+    mpz_init(*getmpz(cl));
+    return cl;
+}
+
+VAL MKBIGC(VM* vm, char* val) {
+    if (*val == '\0') {
+        return MKBIGI(0);
+    }
+    else {
+        BigInt * cl = allocBig(vm);
+        mpz_set_str(*getmpz(cl), val, 10);
+        return (VAL)cl;
+    }
+}
+
+VAL MKBIGM(VM* vm, void* ibig) {
+    BigInt * cl = allocBig(vm);
+    mpz_set(*getmpz(cl), *((mpz_t*)ibig));
+    return (VAL)cl;
+}
+
+VAL MKBIGMc(VM* vm, void* ibig) {
+    BigInt * cl = allocBig(vm);
+    mpz_init_set(*getmpz(cl), *((mpz_t*)ibig));
+    return (VAL)cl;
+}
+
+VAL MKBIGUI(VM* vm, unsigned long val) {
+    BigInt * cl = allocBig(vm);
+    mpz_init_set_ui(*getmpz(cl), val);
+    return (VAL)cl;
+}
+
+VAL MKBIGSI(VM* vm, signed long val) {
+    BigInt * cl = allocBig(vm);
+    mpz_init_set_si(*getmpz(cl), val);
+    return (VAL)cl;
+}
+
+static BigInt * getbig(VM * vm, VAL x) {
+    switch(GETTY(x)) {
+    case CT_INT:
+        {
+            BigInt * cl = allocBig(vm);
+            mpz_set_si(*getmpz(cl), GETINT(x));
+            return cl;
+        }
+    case CT_FWD:
+        return getbig(vm, ((Fwd*)x)->fwd);
+    default:
+        return (BigInt*)x;
+    }
+}
+
+#define GETBIG (VAL)getbig
+
+VAL bigAdd(VM* vm, VAL x, VAL y) {
+    BigInt * cl = allocBig(vm);
+    mpz_add(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));
+    return (VAL)cl;
+}
+
+VAL bigSub(VM* vm, VAL x, VAL y) {
+    BigInt * cl = allocBig(vm);
+    mpz_sub(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));
+    return (VAL)cl;
+}
+
+VAL bigMul(VM* vm, VAL x, VAL y) {
+    BigInt * cl = allocBig(vm);
+    mpz_mul(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));
+    return (VAL)cl;
+}
+
+VAL bigDiv(VM* vm, VAL x, VAL y) {
+    BigInt * cl = allocBig(vm);
+    mpz_tdiv_q(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));
+    return (VAL)cl;
+}
+
+VAL bigMod(VM* vm, VAL x, VAL y) {
+    BigInt * cl = allocBig(vm);
+    mpz_tdiv_r(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));
+    return (VAL)cl;
+}
+
+VAL bigAnd(VM* vm, VAL x, VAL y) {
+    BigInt * cl = allocBig(vm);
+    mpz_and(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));
+    return (VAL)cl;
+}
+
+VAL bigOr(VM* vm, VAL x, VAL y) {
+    BigInt * cl = allocBig(vm);
+    mpz_ior(*getmpz(cl), *getmpz(getbig(vm,x)), *getmpz(getbig(vm,y)));
+    return (VAL)cl;
+}
+
+VAL bigShiftLeft(VM* vm, VAL x, VAL y) {
+    BigInt * cl = allocBig(vm);
+    mpz_mul_2exp(*getmpz(cl), *getmpz(getbig(vm,x)), GETINT(y));
+    return (VAL)cl;
+}
+
+
+VAL bigLShiftRight(VM* vm, VAL x, VAL y) {
+    BigInt * cl = allocBig(vm);
+    mpz_fdiv_q_2exp(*getmpz(cl), *getmpz(getbig(vm,x)), GETINT(y));
+    return (VAL)cl;
+}
+
+VAL bigAShiftRight(VM* vm, VAL x, VAL y) {
+    BigInt * cl = allocBig(vm);
+    mpz_fdiv_q_2exp(*getmpz(cl), *getmpz(getbig(vm,x)), GETINT(y));
+    return (VAL)cl;
+}
+
+VAL idris_bigAnd(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return INTOP(&, x, y);
+    } else {
+        return bigAnd(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+VAL idris_bigOr(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return INTOP(|, x, y);
+    } else {
+        return bigOr(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+VAL idris_bigPlus(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        i_int vx = GETINT(x);
+        i_int vy = GETINT(y);
+        if ((vx <= 0 && vy >=0) || (vx >=0 && vy <=0)) {
+            return ADD(x, y);
+        }
+        i_int res = vx + vy;
+        if (res >= 1<<30 || res <= -(1 << 30)) {
+            return bigAdd(vm, GETBIG(vm, x), GETBIG(vm, y));
+        } else {
+            return MKINT(res);
+        }
+    } else {
+        return bigAdd(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+VAL idris_bigMinus(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        i_int vx = GETINT(x);
+        i_int vy = GETINT(y);
+        if ((vx <= 0 && vy <=0) || (vx >=0 && vy <=0)) {
+            return INTOP(-, x, y);
+        }
+        i_int res = vx - vy;
+        if (res >= 1<<30 || res <= -(1 << 30)) {
+            return bigSub(vm, GETBIG(vm, x), GETBIG(vm, y));
+        } else {
+            return MKINT(res);
+        }
+    } else {
+        return bigSub(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+VAL idris_bigTimes(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        i_int vx = GETINT(x);
+        i_int vy = GETINT(y);
+        // we could work out likelihood of overflow by checking the number
+        // of necessary bits. Here's a quick conservative hack instead.
+        if ((vx < (1<<15) && vy < (1<16)) ||
+            (vx < (1<<16) && vy < (1<15)) ||
+            (vx < (1<<20) && vy < (1<11)) ||
+            (vx < (1<<11) && vy < (1<20)) ||
+            (vx < (1<<23) && vy < (1<<8)) ||
+            (vx < (1<<8) && vy < (1<<23))) { // ultra-conservative!
+            return INTOP(*,x,y);
+        } else {
+            return bigMul(vm, GETBIG(vm, x), GETBIG(vm, y));
+        }
+    } else {
+        return bigMul(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+VAL idris_bigShiftLeft(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return INTOP(<<, x, y);
+    } else {
+        return bigShiftLeft(vm, GETBIG(vm, x), y);
+    }
+}
+
+VAL idris_bigAShiftRight(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return INTOP(>>, x, y);
+    } else {
+        return bigAShiftRight(vm, GETBIG(vm, x), y);
+    }
+}
+
+VAL idris_bigLShiftRight(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return INTOP(>>, x, y);
+    } else {
+        return bigLShiftRight(vm, GETBIG(vm, x), y);
+    }
+}
+
+VAL idris_bigDivide(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return INTOP(/, x, y);
+    } else {
+        return bigDiv(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+VAL idris_bigMod(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return INTOP(%, x, y);
+    } else {
+        return bigMod(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+int bigEqConst(VAL x, int c) {
+    if (ISINT(x)) { return (GETINT(x) == c); }
+    else {
+        int rv = mpz_cmp_si(GETMPZ(x), c);
+        return (rv == 0);
+    }
+}
+
+VAL bigEq(VM* vm, VAL x, VAL y) {
+    return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) == 0));
+}
+
+VAL bigLt(VM* vm, VAL x, VAL y) {
+    return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) < 0));
+}
+
+VAL bigGt(VM* vm, VAL x, VAL y) {
+    return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) > 0));
+}
+
+VAL bigLe(VM* vm, VAL x, VAL y) {
+    return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) <= 0));
+}
+
+VAL bigGe(VM* vm, VAL x, VAL y) {
+    return MKINT((i_int)(mpz_cmp(GETMPZ(x), GETMPZ(y)) >= 0));
+}
+
+VAL idris_bigEq(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return MKINT((i_int)(GETINT(x) == GETINT(y)));
+    } else {
+        return bigEq(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+VAL idris_bigLt(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return MKINT((i_int)(GETINT(x) < GETINT(y)));
+    } else {
+        return bigLt(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+VAL idris_bigLe(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return MKINT((i_int)(GETINT(x) <= GETINT(y)));
+    } else {
+        return bigLe(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+VAL idris_bigGt(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return MKINT((i_int)(GETINT(x) > GETINT(y)));
+    } else {
+        return bigGt(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+VAL idris_bigGe(VM* vm, VAL x, VAL y) {
+    if (ISINT(x) && ISINT(y)) {
+        return MKINT((i_int)(GETINT(x) >= GETINT(y)));
+    } else {
+        return bigGe(vm, GETBIG(vm, x), GETBIG(vm, y));
+    }
+}
+
+
+VAL idris_castIntBig(VM* vm, VAL i) {
+    return i;
+}
+
+VAL idris_castBigInt(VM* vm, VAL i) {
+    if (ISINT(i)) {
+        return i;
+    } else {
+        return MKINT((i_int)(mpz_get_ui(GETMPZ(i))));
+    }
+}
+
+VAL idris_castBigFloat(VM* vm, VAL i) {
+    if (ISINT(i)) {
+        return MKFLOAT(vm, GETINT(i));
+    } else {
+        return MKFLOAT(vm, mpz_get_d(GETMPZ(i)));
+    }
+}
+
+VAL idris_castFloatBig(VM* vm, VAL f) {
+    double val = GETFLOAT(f);
+    BigInt * cl = allocBig(vm);
+    mpz_init_set_d(*getmpz(cl), val);
+    return (VAL)cl;
+}
+
+VAL idris_castStrBig(VM* vm, VAL i) {
+    return MKBIGC(vm, GETSTR(i));
+}
+
+VAL idris_castBigStr(VM* vm, VAL i) {
+    char* str = mpz_get_str(NULL, 10, *getmpz(getbig(vm, i)));
+    return MKSTR(vm, str);
+}
+
+// Get 64 bits out of a big int with special handling
+// for systems that have 32-bit longs which needs two limbs to
+// fill that.
+uint64_t idris_truncBigB64(const mpz_t bi) {
+    if (sizeof(mp_limb_t) == 8) {
+        return mpz_get_ui(bi);
+    }
+    int64_t out = mpz_get_ui(bi);
+    if (mpz_size(bi) > 1) {
+        out |= ((int64_t)mpz_getlimbn(bi, 1)) << 32;
+    }
+    return out;
+}

dist/rts/idris_gmp.h

@@ -0,0 +1,57 @@
+#ifndef _IDRISGMP_H
+#define _IDRISGMP_H
+
+#ifdef IDRIS_GMP
+#include <gmp.h>
+#else
+#include "mini-gmp.h"
+#endif
+
+#include "idris_rts.h"
+
+// Set memory allocation functions
+void init_gmpalloc(void);
+
+VAL MKBIGI(int val);
+VAL MKBIGC(VM* vm, char* bigint);
+VAL MKBIGM(VM* vm, void* bigint);
+VAL MKBIGMc(VM* vm, void* bigint);
+VAL MKBIGUI(VM* vm, unsigned long val);
+VAL MKBIGSI(VM* vm, signed long val);
+
+VAL idris_bigPlus(VM*, VAL x, VAL y);
+VAL idris_bigMinus(VM*, VAL x, VAL y);
+VAL idris_bigTimes(VM*, VAL x, VAL y);
+VAL idris_bigDivide(VM*, VAL x, VAL y);
+VAL idris_bigMod(VM*, VAL x, VAL y);
+
+int bigEqConst(VAL x, int c);
+
+VAL idris_bigEq(VM*, VAL x, VAL y);
+VAL idris_bigLt(VM*, VAL x, VAL y);
+VAL idris_bigLe(VM*, VAL x, VAL y);
+VAL idris_bigGt(VM*, VAL x, VAL y);
+VAL idris_bigGe(VM*, VAL x, VAL y);
+
+VAL idris_castIntBig(VM* vm, VAL i);
+VAL idris_castBigInt(VM* vm, VAL i);
+VAL idris_castFloatBig(VM* vm, VAL i);
+VAL idris_castBigFloat(VM* vm, VAL i);
+VAL idris_castStrBig(VM* vm, VAL i);
+VAL idris_castBigStr(VM* vm, VAL i);
+
+VAL idris_bigAnd(VM* vm, VAL x, VAL y);
+VAL idris_bigOr(VM* vm, VAL x, VAL y);
+VAL idris_bigShiftLeft(VM* vm, VAL x, VAL y);
+VAL idris_bigAShiftRight(VM* vm, VAL x, VAL y);
+VAL idris_bigLShiftRight(VM* vm, VAL x, VAL y);
+
+uint64_t idris_truncBigB64(const mpz_t bi);
+
+static inline mpz_t * getmpz(BigInt * v) {
+    return (mpz_t*)(v->big);
+}
+
+#define GETMPZ(x) *getmpz((BigInt*)x)
+
+#endif

dist/rts/idris_heap.c

@@ -0,0 +1,242 @@
+#include "idris_heap.h"
+#include "idris_rts.h"
+#include "idris_gc.h"
+
+#include <stdlib.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <assert.h>
+
+static void c_heap_free_item(CHeap * heap, CHeapItem * item)
+{
+    assert(item->size <= heap->size);
+    heap->size -= item->size;
+
+    // fix links
+    if (item->next != NULL)
+    {
+        item->next->prev_next = item->prev_next;
+    }
+    *(item->prev_next) = item->next;
+
+    // free payload
+    item->finalizer(item->data);
+
+    // free item struct
+    free(item);
+}
+
+CHeapItem * c_heap_create_item(void * data, size_t size, CDataFinalizer * finalizer)
+{
+    CHeapItem * item = (CHeapItem *) malloc(sizeof(CHeapItem));
+
+    item->data = data;
+    item->size = size;
+    item->finalizer = finalizer;
+    item->is_used = false;
+    item->next = NULL;
+    item->prev_next = NULL;
+
+    return item;
+}
+
+void c_heap_insert_if_needed(VM * vm, CHeap * heap, CHeapItem * item)
+{
+    if (item->prev_next != NULL) return;  // already inserted
+
+    if (heap->first != NULL)
+    {
+        heap->first->prev_next = &item->next;
+    }
+
+    item->prev_next = &heap->first;
+    item->next = heap->first;
+
+    heap->first = item;
+
+    // at this point, links are done; let's calculate sizes
+
+    heap->size += item->size;
+    if (heap->size >= heap->gc_trigger_size)
+    {
+        item->is_used = true;  // don't collect what we're inserting
+        idris_gc(vm);
+    }
+}
+
+void c_heap_mark_item(CHeapItem * item)
+{
+    item->is_used = true;
+}
+
+void c_heap_sweep(CHeap * heap)
+{
+    CHeapItem * p = heap->first;
+    while (p != NULL)
+    {
+        if (p->is_used)
+        {
+            p->is_used = false;
+            p = p->next;
+        }
+        else
+        {
+            CHeapItem * unused_item = p;
+            p = p->next;
+
+            c_heap_free_item(heap, unused_item);
+        }
+    }
+
+    heap->gc_trigger_size = C_HEAP_GC_TRIGGER_SIZE(heap->size);
+}
+
+void c_heap_init(CHeap * heap)
+{
+    heap->first = NULL;
+    heap->size = 0;
+    heap->gc_trigger_size = C_HEAP_GC_TRIGGER_SIZE(heap->size);
+}
+
+void c_heap_destroy(CHeap * heap)
+{
+    while (heap->first != NULL)
+    {
+        c_heap_free_item(heap, heap->first);  // will update heap->first via the backward link
+    }
+}
+
+/* Used for initializing the FP heap. */
+void alloc_heap(Heap * h, size_t heap_size, size_t growth, char * old)
+{
+    char * mem = malloc(heap_size);
+
+    if (mem == NULL) {
+        fprintf(stderr,
+                "RTS ERROR: Unable to allocate heap. Requested %zd bytes.\n",
+                heap_size);
+        exit(EXIT_FAILURE);
+    }
+    memset(mem, 0, heap_size);
+
+    h->heap = mem;
+    h->next = aligned_heap_pointer(h->heap);
+    h->end  = h->heap + heap_size;
+
+    h->size   = heap_size;
+    h->growth = growth;
+
+    h->old = old;
+}
+
+void free_heap(Heap * h) {
+    free(h->heap);
+
+    if (h->old != NULL) {
+        free(h->old);
+    }
+}
+
+
+// TODO: more testing
+/******************** Heap testing ********************************************/
+void heap_check_underflow(Heap * heap) {
+    if (!(heap->heap <= heap->next)) {
+       fprintf(stderr, "RTS ERROR: HEAP UNDERFLOW <bot %p> <cur %p>\n",
+               heap->heap, heap->next);
+        exit(EXIT_FAILURE);
+    }
+}
+
+void heap_check_overflow(Heap * heap) {
+    if (!(heap->next <= heap->end)) {
+       fprintf(stderr, "RTS ERROR: HEAP OVERFLOW <cur %p> <end %p>\n",
+               heap->next, heap->end);
+        exit(EXIT_FAILURE);
+    }
+}
+
+int is_valid_ref(VAL v) {
+    return (v != NULL) && !(ISINT(v));
+}
+
+int ref_in_heap(Heap * heap, VAL v) {
+    return ((VAL)heap->heap <= v) && (v < (VAL)heap->next);
+}
+
+char* aligned_heap_pointer(char * heap) {
+#ifdef FORCE_ALIGNMENT
+    if (((i_int)heap&1) == 1) {
+	    return (heap + 1);
+    } else
+#endif
+    {
+	    return heap;
+    }
+}
+
+// Checks three important properties:
+// 1. Closure.
+//      Check if all pointers in the _heap_ points only to heap.
+// 2. Unidirectionality. (if compact gc)
+//      All references in the heap should be are unidirectional. In other words,
+//      more recently allocated closure can point only to earlier allocated one.
+// 3. After gc there should be no forward references.
+//
+void heap_check_pointers(Heap * heap) {
+    char* scan = NULL;
+
+    size_t item_size = 0;
+    for(scan = heap->heap; scan < heap->next; scan += item_size) {
+       VAL heap_item = (VAL)scan;
+       item_size = aligned(valSize(heap_item));
+
+       switch(GETTY(heap_item)) {
+       case CT_CON:
+           {
+	     Con * c = (Con*)heap_item;
+             size_t ar = CARITY(c);
+             size_t i;
+             for(i = 0; i < ar; ++i) {
+                 VAL ptr = c->args[i];
+
+                 if (is_valid_ref(ptr)) {
+                     // Check for closure.
+                     if (!ref_in_heap(heap, ptr)) {
+                         fprintf(stderr,
+                                 "RTS ERROR: heap closure broken. "\
+                                 "<HEAP %p %p %p> <REF %p>\n",
+                                 heap->heap, heap->next, heap->end, ptr);
+                         exit(EXIT_FAILURE);
+                     }
+#if 0 // TODO macro
+                     // Check for unidirectionality.
+                     if (!(ptr < heap_item)) {
+                         fprintf(stderr,
+                                 "RTS ERROR: heap unidirectionality broken:" \
+                                 "<CT_CON %p> <FIELD %p>\n",
+                                 heap_item, ptr);
+                         exit(EXIT_FAILURE);
+                     }
+#endif
+                 }
+             }
+             break;
+           }
+       case CT_FWD:
+           // Check for artifacts after cheney gc.
+           fprintf(stderr, "RTS ERROR: CT_FWD in working heap.\n");
+           exit(EXIT_FAILURE);
+           break;
+       default:
+           break;
+       }
+    }
+}
+
+void heap_check_all(Heap * heap)
+{
+    heap_check_underflow(heap);
+    heap_check_overflow(heap);
+    heap_check_pointers(heap);
+}

dist/rts/idris_heap.h

@@ -0,0 +1,111 @@
+#ifndef _IDRIS_HEAP_H
+#define _IDRIS_HEAP_H
+
+#include <stdbool.h>
+#include <stddef.h>
+
+/* *** C heap ***
+ * Objects with finalizers. Mark&sweep-collected.
+ *
+ * The C heap is implemented as a doubly linked list
+ * of pointers coupled with their finalizers.
+ */
+
+struct VM;
+
+#define C_HEAP_GC_TRIGGER_SIZE(heap_size) \
+    (heap_size < 2048    \
+        ? 4096           \
+        : 2 * heap_size  \
+    )
+
+typedef void CDataFinalizer(void *);
+
+typedef struct CHeapItem {
+    /// Payload.
+    void * data;
+
+    /// Size of the item, in bytes.
+    /// This does not have to be a precise size. It is used to assess
+    /// whether the heap needs garbage collection.
+    size_t size;
+
+    /// Finalizer that will be called on the payload pointer.
+    /// Its job is to deallocate all associated resources,
+    /// including the memory pointed to by `data` (if any).
+    CDataFinalizer * finalizer;
+
+    /// The mark bit set by the FP heap traversal,
+    /// cleared by C heap sweep.
+    bool is_used;
+
+    /// Next item in the C heap.
+    struct CHeapItem * next;
+
+    /// Pointer to the previous next-pointer.
+    struct CHeapItem ** prev_next;
+} CHeapItem;
+
+typedef struct CHeap {
+    /// The first item in the heap. NULL if the heap is empty.
+    CHeapItem * first;
+
+    /// Total size of the heap. (Sum of sizes of items.)
+    /// This may not be a precise size since individual items'
+    /// sizes may be just estimates.
+    size_t size;
+
+    /// When heap reaches this size, GC will be triggered.
+    size_t gc_trigger_size;
+} CHeap;
+
+/// Create a C heap.
+void c_heap_init(CHeap * c_heap);
+
+/// Destroy the given C heap. Will not deallocate the given pointer.
+/// Will call finalizers & deallocate all blocks in the heap.
+void c_heap_destroy(CHeap * c_heap);
+
+/// Insert the given item into the heap if it's not there yet.
+/// The VM pointer is needed because this operation may trigger GC.
+void c_heap_insert_if_needed(struct VM * vm, CHeap * c_heap, CHeapItem * item);
+
+/// Mark the given item as used.
+void c_heap_mark_item(CHeapItem * item);
+
+/// Sweep the C heap, finalizing and freeing unused blocks.
+void c_heap_sweep(CHeap * c_heap);
+
+/// Create a C heap item from its payload, size estimate, and finalizer.
+/// The size does not have to be precise but it should roughly reflect
+/// how big the item is for GC to work effectively.
+CHeapItem * c_heap_create_item(void * data, size_t size, CDataFinalizer * finalizer);
+
+/* *** Idris heap **
+ * Objects without finalizers. Cheney-collected.
+ */
+
+typedef struct {
+    char*  next;   // Next allocated chunk. Should always (heap <= next < end).
+    char*  heap;   // Point to bottom of heap
+    char*  end;    // Point to top of heap
+    size_t size;   // Size of _next_ heap. Size of current heap is /end - heap/.
+    size_t growth; // Quantity of heap growth in bytes.
+
+    char* old;
+} Heap;
+
+
+void alloc_heap(Heap * heap, size_t heap_size, size_t growth, char * old);
+void free_heap(Heap * heap);
+char* aligned_heap_pointer(char * heap);
+
+#ifdef IDRIS_DEBUG
+void heap_check_all(Heap * heap);
+// Should be used _between_ gc's.
+#define HEAP_CHECK(vm) heap_check_all(&(vm->heap));
+#else
+#define HEAP_CHECK(vm)
+#endif // IDRIS_DEBUG
+
+#endif // _IDRIS_HEAP_H

dist/rts/idris_main.c

@@ -0,0 +1,78 @@
+#include "idris_gmp.h"
+#include "idris_opts.h"
+#include "idris_rts.h"
+#include "idris_stats.h"
+
+void* _idris__123_runMain_95_0_125_(VM* vm, VAL* oldbase);
+
+#ifdef _WIN32
+
+#include <Windows.h>
+
+int win32_get_argv_utf8(int *argc_ptr, char ***argv_ptr)
+{
+    int argc;
+    char **argv;
+    wchar_t **argv_utf16 = CommandLineToArgvW(GetCommandLineW(), &argc);
+    int i;
+    int offset = (argc + 1) * sizeof(char *);
+    int size = offset;
+    for (i = 0; i < argc; i++) {
+        size += WideCharToMultiByte(CP_UTF8, 0, argv_utf16[i], -1, 0, 0, 0, 0);
+    }
+    argv = (char **)malloc(size);
+    for (i = 0; i < argc; i++) {
+        argv[i] = (char *)argv + offset;
+        offset += WideCharToMultiByte(CP_UTF8, 0, argv_utf16[i], -1, argv[i], size - offset, 0, 0);
+    }
+    *argc_ptr = argc;
+    *argv_ptr = argv;
+    return 0;
+}
+
+#endif
+
+// The default options should give satisfactory results under many circumstances.
+RTSOpts opts = {
+    .init_heap_size = 16384000,
+    .max_stack_size = 4096000,
+    .show_summary   = 0
+};
+
+#ifdef _WIN32
+int main() {
+    int argc;
+    char **argv;
+    win32_get_argv_utf8(&argc, &argv);
+#else
+int main(int argc, char **argv) {
+#endif
+    parse_shift_args(&opts, &argc, &argv);
+
+    __idris_argc = argc;
+    __idris_argv = argv;
+
+    VM* vm = init_vm(opts.max_stack_size, opts.init_heap_size, 1);
+    init_threadkeys();
+    init_threaddata(vm);
+    init_gmpalloc();
+
+    init_nullaries();
+    init_signals();
+
+    _idris__123_runMain_95_0_125_(vm, NULL);
+
+#ifdef IDRIS_DEBUG
+    if (opts.show_summary) {
+        idris_gcInfo(vm, 1);
+    }
+#endif
+
+    Stats stats = terminate(vm);
+
+    if (opts.show_summary) {
+        print_stats(&stats);
+    }
+
+    return EXIT_SUCCESS;
+}

dist/rts/idris_net.c

@@ -0,0 +1,351 @@
+// C-Side of the Idris network library
+// (C) Simon Fowler, 2014
+// MIT Licensed. Have fun!
+#include "idris_net.h"
+#include <errno.h>
+#include <stdbool.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+
+#ifndef _WIN32
+#include <netinet/in.h>
+#include <arpa/inet.h>
+#else
+static int socket_inited = 0;
+static WSADATA wsa_data;
+
+static void clean_sockets(void) {
+    WSACleanup();
+}
+
+static int check_init(void) {
+    if (!socket_inited) {
+        int result = WSAStartup(MAKEWORD(2, 2), &wsa_data);
+        if (result == NO_ERROR) {
+            socket_inited = 1;
+            atexit(clean_sockets);
+        }
+    }
+    return socket_inited;
+}
+#endif
+
+
+void buf_htonl(void* buf, int len) {
+    int* buf_i = (int*) buf;
+    int i;
+    for (i = 0; i < (len / sizeof(int)) + 1; i++) {
+        buf_i[i] = htonl(buf_i[i]);
+    }
+}
+
+void buf_ntohl(void* buf, int len) {
+    int* buf_i = (int*) buf;
+    int i;
+    for (i = 0; i < (len / sizeof(int)) + 1; i++) {
+        buf_i[i] = ntohl(buf_i[i]);
+    }
+}
+
+void* idrnet_malloc(int size) {
+    return malloc(size);
+}
+
+void idrnet_free(void* ptr) {
+    free(ptr);
+}
+
+
+int idrnet_socket(int domain, int type, int protocol) {
+#ifdef _WIN32
+    if (!check_init()) {
+        return -1;
+    }
+#endif
+    return socket(domain, type, protocol);
+}
+
+// We call this from quite a few functions. Given a textual host and an int port,
+// populates a struct addrinfo.
+int idrnet_getaddrinfo(struct addrinfo** address_res, char* host, int port,
+                       int family, int socket_type) {
+
+    struct addrinfo hints;
+    // Convert port into string
+    char str_port[8];
+    sprintf(str_port, "%d", port);
+
+    // Set up hints structure
+    memset(&hints, 0, sizeof(hints)); // zero out hints
+    hints.ai_family = family;
+    hints.ai_socktype = socket_type;
+
+    // If the length of the hostname is 0 (i.e, it was set to Nothing in Idris)
+    // then we want to instruct the C library to fill in the IP automatically
+    if (strlen(host) == 0) {
+        hints.ai_flags = AI_PASSIVE; // fill in IP automatically
+        return getaddrinfo(NULL, str_port, &hints, address_res);
+    }
+    return getaddrinfo(host, str_port, &hints, address_res);
+
+}
+
+int idrnet_bind(int sockfd, int family, int socket_type, char* host, int port) {
+    struct addrinfo* address_res;
+    int addr_res = idrnet_getaddrinfo(&address_res, host, port, family, socket_type);
+    if (addr_res != 0) {
+        //printf("Lib err: bind getaddrinfo\n");
+        return -1;
+    }
+
+    int bind_res = bind(sockfd, address_res->ai_addr, address_res->ai_addrlen);
+    if (bind_res == -1) {
+        //freeaddrinfo(address_res);
+        //printf("Lib err: bind\n");
+        return -1;
+    }
+    return 0;
+}
+
+int idrnet_connect(int sockfd, int family, int socket_type, char* host, int port) {
+    struct addrinfo* remote_host;
+    int addr_res = idrnet_getaddrinfo(&remote_host, host, port, family, socket_type);
+    if (addr_res != 0) {
+        return -1;
+    }
+
+    int connect_res = connect(sockfd, remote_host->ai_addr, remote_host->ai_addrlen);
+    if (connect_res == -1) {
+        freeaddrinfo(remote_host);
+        return -1;
+    }
+    freeaddrinfo(remote_host);
+    return 0;
+}
+
+
+int idrnet_sockaddr_family(void* sockaddr) {
+    struct sockaddr* addr = (struct sockaddr*) sockaddr;
+    return (int) addr->sa_family;
+}
+
+char* idrnet_sockaddr_ipv4(void* sockaddr) {
+    struct sockaddr_in* addr = (struct sockaddr_in*) sockaddr;
+    char* ip_addr = (char*) malloc(sizeof(char) * INET_ADDRSTRLEN);
+    inet_ntop(AF_INET, &(addr->sin_addr), ip_addr, INET_ADDRSTRLEN);
+    //printf("Lib: ip_addr: %s\n", ip_addr);
+    return ip_addr;
+}
+
+int idrnet_sockaddr_ipv4_port(void* sockaddr) {
+    struct sockaddr_in* addr = (struct sockaddr_in*) sockaddr;
+    return ((int) ntohs(addr->sin_port));
+}
+
+void* idrnet_create_sockaddr() {
+    return malloc(sizeof(struct sockaddr_storage));
+}
+
+
+int idrnet_accept(int sockfd, void* sockaddr) {
+    struct sockaddr* addr = (struct sockaddr*) sockaddr;
+    socklen_t addr_size = sizeof(struct sockaddr_storage);
+    return accept(sockfd, addr, &addr_size);
+}
+
+int idrnet_send(int sockfd, char* data) {
+    int len = strlen(data); // For now.
+    return send(sockfd, (void*) data, len, 0);
+}
+
+int idrnet_send_buf(int sockfd, void* data, int len) {
+    void* buf_cpy = malloc(len);
+    memset(buf_cpy, 0, len);
+    memcpy(buf_cpy, data, len);
+    buf_htonl(buf_cpy, len);
+    int res = send(sockfd, buf_cpy, len, 0);
+    free(buf_cpy);
+    return res;
+}
+
+void* idrnet_recv(int sockfd, int len) {
+    idrnet_recv_result* res_struct =
+        (idrnet_recv_result*) malloc(sizeof(idrnet_recv_result));
+    char* buf = malloc(len + 1);
+    memset(buf, 0, len + 1);
+    int recv_res = recv(sockfd, buf, len, 0);
+    res_struct->result = recv_res;
+
+    if (recv_res > 0) { // Data was received
+        buf[recv_res + 1] = 0x00; // Null-term, so Idris can interpret it
+    }
+    res_struct->payload = buf;
+    return (void*) res_struct;
+}
+
+int idrnet_recv_buf(int sockfd, void* buf, int len) {
+    int recv_res = recv(sockfd, buf, len, 0);
+    if (recv_res != -1) {
+        buf_ntohl(buf, len);
+    }
+    return recv_res;
+}
+
+int idrnet_get_recv_res(void* res_struct) {
+    return (((idrnet_recv_result*) res_struct)->result);
+}
+
+char* idrnet_get_recv_payload(void* res_struct) {
+    return (((idrnet_recv_result*) res_struct)->payload);
+}
+
+void idrnet_free_recv_struct(void* res_struct) {
+    idrnet_recv_result* i_res_struct =
+        (idrnet_recv_result*) res_struct;
+    if (i_res_struct->payload != NULL) {
+        free(i_res_struct->payload);
+    }
+    free(res_struct);
+}
+
+int idrnet_errno() {
+    return errno;
+}
+
+
+int idrnet_sendto(int sockfd, char* data, char* host, int port, int family) {
+
+    struct addrinfo* remote_host;
+    int addr_res = idrnet_getaddrinfo(&remote_host, host, port, family, SOCK_DGRAM);
+    if (addr_res != 0) {
+        return -1;
+    }
+
+    int send_res = sendto(sockfd, data, strlen(data), 0,
+                        remote_host->ai_addr, remote_host->ai_addrlen);
+    freeaddrinfo(remote_host);
+    return send_res;
+}
+
+int idrnet_sendto_buf(int sockfd, void* buf, int buf_len, char* host, int port, int family) {
+
+    struct addrinfo* remote_host;
+    int addr_res = idrnet_getaddrinfo(&remote_host, host, port, family, SOCK_DGRAM);
+    if (addr_res != 0) {
+        //printf("lib err: sendto getaddrinfo \n");
+        return -1;
+    }
+
+    buf_htonl(buf, buf_len);
+
+    int send_res = sendto(sockfd, buf, buf_len, 0,
+                        remote_host->ai_addr, remote_host->ai_addrlen);
+    if (send_res == -1) {
+        perror("lib err: sendto \n");
+    }
+    //freeaddrinfo(remote_host);
+    return send_res;
+}
+
+
+
+void* idrnet_recvfrom(int sockfd, int len) {
+/*
+ * int recvfrom(int sockfd, void *buf, int len, unsigned int flags,
+             struct sockaddr *from, int *fromlen);
+*/
+    // Allocate the required structures, and nuke them
+    struct sockaddr_storage* remote_addr =
+        (struct sockaddr_storage*) malloc(sizeof(struct sockaddr_storage));
+    char* buf = (char*) malloc(len + 1);
+    idrnet_recvfrom_result* ret =
+        (idrnet_recvfrom_result*) malloc(sizeof(idrnet_recvfrom_result));
+    memset(remote_addr, 0, sizeof(struct sockaddr_storage));
+    memset(buf, 0, len + 1);
+    memset(ret, 0, sizeof(idrnet_recvfrom_result));
+    socklen_t fromlen = sizeof(struct sockaddr_storage);
+
+    int recv_res = recvfrom(sockfd, buf, len, 0, (struct sockaddr*) remote_addr, &fromlen);
+    ret->result = recv_res;
+    // Check for failure...
+    if (recv_res == -1) {
+        free(buf);
+        free(remote_addr);
+    } else {
+        // If data was received, process and populate
+        ret->result = recv_res;
+        ret->remote_addr = remote_addr;
+        // Ensure the last byte is NULL, since in this mode we're sending strings
+        buf[len] = 0x00;
+        ret->payload = (void*) buf;
+    }
+
+    return ret;
+}
+
+void* idrnet_recvfrom_buf(int sockfd, void* buf, int len) {
+    // Allocate the required structures, and nuke them
+    struct sockaddr_storage* remote_addr =
+        (struct sockaddr_storage*) malloc(sizeof(struct sockaddr_storage));
+    idrnet_recvfrom_result* ret =
+        (idrnet_recvfrom_result*) malloc(sizeof(idrnet_recvfrom_result));
+    memset(remote_addr, 0, sizeof(struct sockaddr_storage));
+    memset(ret, 0, sizeof(idrnet_recvfrom_result));
+    socklen_t fromlen = 0;
+
+    int recv_res = recvfrom(sockfd, buf, len, 0, (struct sockaddr*) remote_addr, &fromlen);
+    // Check for failure... But don't free the buffer! Not our job.
+    ret->result = recv_res;
+    if (recv_res == -1) {
+        free(remote_addr);
+    }
+    // Payload will be NULL -- since it's been put into the user-specified buffer. We
+    // still need the return struct to get our hands on the remote address, though.
+    if (recv_res > 0) {
+        buf_ntohl(buf, len);
+        ret->payload = NULL;
+        ret->remote_addr = remote_addr;
+    }
+    return ret;
+}
+
+int idrnet_get_recvfrom_res(void* res_struct) {
+    return (((idrnet_recvfrom_result*) res_struct)->result);
+}
+
+char* idrnet_get_recvfrom_payload(void* res_struct) {
+    return (((idrnet_recvfrom_result*) res_struct)->payload);
+}
+
+void* idrnet_get_recvfrom_sockaddr(void* res_struct) {
+    idrnet_recvfrom_result* recv_struct = (idrnet_recvfrom_result*) res_struct;
+    return recv_struct->remote_addr;
+}
+
+int idrnet_get_recvfrom_port(void* res_struct) {
+    idrnet_recvfrom_result* recv_struct = (idrnet_recvfrom_result*) res_struct;
+    if (recv_struct->remote_addr != NULL) {
+        struct sockaddr_in* remote_addr_in =
+            (struct sockaddr_in*) recv_struct->remote_addr;
+        return ((int) ntohs(remote_addr_in->sin_port));
+    }
+    return -1;
+}
+
+void idrnet_free_recvfrom_struct(void* res_struct) {
+    idrnet_recvfrom_result* recv_struct = (idrnet_recvfrom_result*) res_struct;
+    if (recv_struct != NULL) {
+        if (recv_struct->payload != NULL) {
+            free(recv_struct->payload);
+        }
+        if (recv_struct->remote_addr != NULL) {
+            free(recv_struct->remote_addr);
+        }
+    }
+}
+
+int idrnet_geteagain() {
+    return EAGAIN;
+}
+

dist/rts/idris_net.h

@@ -0,0 +1,91 @@
+#ifndef IDRISNET_H
+#define IDRISNET_H
+
+// Includes used by the idris-file.
+#ifdef _WIN32
+#include <winsock2.h>
+#include <Ws2tcpip.h>
+#else
+#include <netdb.h>
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/socket.h>
+#endif
+
+struct sockaddr_storage;
+struct addrinfo;
+
+typedef struct idrnet_recv_result {
+    int result;
+    void* payload;
+} idrnet_recv_result;
+
+// Same type of thing as idrnet_recv_result, but for UDP, so stores some 
+// address information
+typedef struct idrnet_recvfrom_result {
+    int result;
+    void* payload;
+    struct sockaddr_storage* remote_addr;
+} idrnet_recvfrom_result;
+
+// Memory management functions
+void* idrnet_malloc(int size);
+void idrnet_free(void* ptr);
+
+// Gets value of errno
+int idrnet_errno(); 
+
+int idrnet_socket(int domain, int type, int protocol);
+
+// Bind
+int idrnet_bind(int sockfd, int family, int socket_type, char* host, int port);
+
+// Connect
+int idrnet_connect(int sockfd, int family, int socket_type, char* host, int port);
+
+// Accessor functions for struct_sockaddr
+int idrnet_sockaddr_family(void* sockaddr);
+char* idrnet_sockaddr_ipv4(void* sockaddr);
+int idrnet_sockaddr_ipv4_port(void* sockaddr);
+void* idrnet_create_sockaddr();
+
+// Accept
+int idrnet_accept(int sockfd, void* sockaddr);
+
+// Send
+int idrnet_send(int sockfd, char* data);
+int idrnet_send_buf(int sockfd, void* data, int len);
+
+// Receive
+// Creates a result structure containing result and payload
+void* idrnet_recv(int sockfd, int len);
+// Receives directly into a buffer
+int idrnet_recv_buf(int sockfd, void* buf, int len);
+
+// UDP Send
+int idrnet_sendto(int sockfd, char* data, char* host, int port, int family);
+int idrnet_sendto_buf(int sockfd, void* buf, int buf_len, char* host, int port, int family);
+
+
+// UDP Receive
+void* idrnet_recvfrom(int sockfd, int len);
+void* idrnet_recvfrom_buf(int sockfd, void* buf, int len);
+
+// Receive structure accessors
+int idrnet_get_recv_res(void* res_struct);
+char* idrnet_get_recv_payload(void* res_struct);
+void idrnet_free_recv_struct(void* res_struct);
+
+// Recvfrom structure accessors
+int idrnet_get_recvfrom_res(void* res_struct);
+char* idrnet_get_recvfrom_payload(void* res_struct);
+void* idrnet_get_recvfrom_sockaddr(void* res_struct);
+void idrnet_free_recvfrom_struct(void* res_struct);
+
+
+int idrnet_getaddrinfo(struct addrinfo** address_res, char* host, 
+    int port, int family, int socket_type);
+
+int idrnet_geteagain();
+
+#endif

dist/rts/idris_opts.c

@@ -0,0 +1,109 @@
+#include "idris_opts.h"
+
+#include <stdlib.h>
+#include <stddef.h>
+#include <stdio.h>
+#include <string.h>
+
+
+#define USAGE "\n"                                              \
+    "Usage: <prog> [+RTS <rtsopts> -RTS] <args>\n\n"            \
+    "Options:\n\n"                                              \
+    "  -?    Print this message and exits.\n"                   \
+    "  -s    Summary GC statistics.\n"                          \
+    "  -H    Initial heap size. Egs: -H4M, -H500K, -H1G\n"      \
+    "  -K    Sets the maximum stack size. Egs: -K8M\n"          \
+    "\n"
+
+void print_usage(FILE * s) {
+    fprintf(s, USAGE);
+}
+
+int read_size(char * str) {
+    int size = 0;
+    char mult = ' ';
+
+    int r = sscanf(str, "%u%c", &size, &mult);
+
+    if (r == 1)
+        return size;
+
+    if (r == 2) {
+        switch (mult) {
+        case 'K': size = size << 10; break;
+        case 'M': size = size << 20; break;
+        case 'G': size = size << 30; break;
+        default:
+            fprintf(stderr,
+                    "RTS Opts: Unable to recognize size suffix `%c'.\n" \
+                    "          Possible suffixes are K or M or G.\n",
+                    mult);
+            print_usage(stderr);
+            exit(EXIT_FAILURE);
+        }
+        return size;
+    }
+
+    fprintf(stderr, "RTS Opts: Unable to parse size. Egs: 1K, 10M, 2G.\n");
+    print_usage(stderr);
+    exit(EXIT_FAILURE);
+}
+
+
+int parse_args(RTSOpts * opts, int argc, char *argv[])
+{
+    if (argc == 0)
+        return 0;
+
+    if (strcmp(argv[0], "+RTS") != 0)
+        return 0;
+
+    int i;
+    for (i = 1; i < argc; i++) {
+        if (strcmp(argv[i], "-RTS") == 0) {
+            return i + 1;
+        }
+
+        if (argv[i][0] != '-') {
+            fprintf(stderr, "RTS options should start with '-'.\n");
+            print_usage(stderr);
+            exit(EXIT_FAILURE);
+        }
+
+        switch (argv[i][1])
+        {
+        case '?':
+            print_usage(stdout);
+            exit(EXIT_SUCCESS);
+            break;
+
+        case 's':
+            opts->show_summary = 1;
+            break;
+
+        case 'H':
+            opts->init_heap_size = read_size(argv[i] + 2);
+            break;
+
+        case 'K':
+            opts->max_stack_size = read_size(argv[i] + 2);
+            break;
+
+        default:
+            printf("RTS opts: Wrong argument: %s\n", argv[i]);
+            print_usage(stderr);
+            exit(EXIT_FAILURE);
+        }
+    }
+
+    return argc;
+}
+
+void parse_shift_args(RTSOpts * opts, int * argc, char *** argv) {
+    size_t shift = parse_args(opts, (*argc) - 1, (*argv) + 1);
+
+    char *prg = (*argv)[0];
+    *argc = *argc - shift;
+    *argv = *argv + shift;
+    (*argv)[0] = prg;
+}

dist/rts/idris_opts.h

@@ -0,0 +1,19 @@
+#ifndef _IDRIS_OPTS_H
+#define _IDRIS_OPTS_H
+
+#include <stddef.h>
+#include <stdio.h>
+
+typedef struct {
+    size_t init_heap_size;
+    size_t max_stack_size;
+    int    show_summary;
+} RTSOpts;
+
+void print_usage(FILE * s);
+
+// Parse rts options and shift arguments such that rts options becomes invisible
+// for main program.
+void parse_shift_args(RTSOpts * opts, int * argc, char *** argv);
+
+#endif

dist/rts/idris_rts.h

@@ -0,0 +1,546 @@
+#ifndef _IDRISRTS_H
+#define _IDRISRTS_H
+
+#include <assert.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#ifdef HAS_PTHREAD
+#include <stdarg.h>
+#include <pthread.h>
+#endif
+
+#include "idris_heap.h"
+#include "idris_stats.h"
+
+
+#ifndef EXIT_SUCCESS
+#define EXIT_SUCCESS 0
+#endif
+#ifndef EXIT_FAILURE
+#define EXIT_FAILURE 1
+#endif
+
+// Closures
+typedef enum {
+    CT_CON, CT_ARRAY, CT_INT, CT_BIGINT,
+    CT_FLOAT, CT_STRING, CT_STROFFSET, CT_BITS32,
+    CT_BITS64, CT_PTR, CT_REF, CT_FWD,
+    CT_MANAGEDPTR, CT_RAWDATA, CT_CDATA
+} ClosureType;
+
+typedef struct Hdr {
+    uint8_t ty;
+    uint8_t u8;
+    uint16_t u16;
+    uint32_t sz;
+} Hdr;
+
+typedef struct Val {
+    Hdr hdr;
+} Val;
+
+typedef struct Val * VAL;
+
+typedef struct Con {
+    Hdr hdr;
+    uint32_t tag;
+    VAL args[0];
+} Con;
+
+typedef struct Array {
+    Hdr hdr;
+    VAL array[0];
+} Array;
+
+typedef struct BigInt {
+    Hdr hdr;
+    char big[0];
+} BigInt;
+
+typedef struct Float {
+    Hdr hdr;
+    double f;
+} Float;
+
+typedef struct String {
+    Hdr hdr;
+    size_t slen;
+    char str[0];
+} String;
+
+typedef struct StrOffset {
+    Hdr hdr;
+    String * base;
+    size_t offset;
+} StrOffset;
+
+typedef struct Bits32 {
+    Hdr hdr;
+    uint32_t bits32;
+} Bits32;
+
+typedef struct Bits64 {
+    Hdr hdr;
+    uint64_t bits64;
+} Bits64;
+
+typedef struct Ptr {
+    Hdr hdr;
+    void * ptr;
+} Ptr;
+
+typedef struct Ref {
+    Hdr hdr;
+    VAL ref;
+} Ref;
+
+typedef struct Fwd {
+    Hdr hdr;
+    VAL fwd;
+} Fwd;
+
+typedef struct ManagedPtr {
+    Hdr hdr;
+    char mptr[0];
+} ManagedPtr;
+
+typedef struct RawData {
+    Hdr hdr;
+    char raw[0];
+} RawData;
+
+typedef struct CDataC {
+    Hdr hdr;
+    CHeapItem * item;
+} CDataC;
+
+struct VM;
+
+struct Msg_t {
+    struct VM* sender;
+    // An identifier to say which conversation this message is part of.
+    // Lowest bit is set if the id is the first message in a conversation.
+    int channel_id;
+    VAL msg;
+};
+
+typedef struct Msg_t Msg;
+
+struct VM {
+    int active; // 0 if no longer running; keep for message passing
+                // TODO: If we're going to have lots of concurrent threads,
+                // we really need to be cleverer than this!
+
+    VAL* valstack;
+    VAL* valstack_top;
+    VAL* valstack_base;
+    VAL* stack_max;
+
+    CHeap c_heap;
+    Heap heap;
+#ifdef HAS_PTHREAD
+    pthread_mutex_t inbox_lock;
+    pthread_mutex_t inbox_block;
+    pthread_mutex_t alloc_lock;
+    pthread_cond_t inbox_waiting;
+
+    Msg* inbox; // Block of memory for storing messages
+    Msg* inbox_end; // End of block of memory
+    int inbox_nextid; // Next channel id
+    Msg* inbox_write; // Location of next message to write
+
+    int processes; // Number of child processes
+    int max_threads; // maximum number of threads to run in parallel
+    struct VM* creator; // The VM that created this VM, NULL for root VM
+#endif
+    Stats stats;
+
+    VAL ret;
+    VAL reg1;
+};
+
+typedef struct VM VM;
+
+
+/* C data interface: allocation on the C heap.
+ *
+ * Although not enforced in code, CData is meant to be opaque
+ * and non-RTS code (such as libraries or C bindings) should
+ * access only its (void *) field called "data".
+ *
+ * Feel free to mutate cd->data; the heap does not care
+ * about its particular value. However, keep in mind
+ * that it must not break Idris's referential transparency.
+ *
+ * If you call cdata_allocate or cdata_manage, the resulting
+ * CData object *must* be returned from your FFI function so
+ * that it is inserted in the C heap. Otherwise the memory
+ * will be leaked.
+ */
+
+/// C data block. Contains (void * data).
+typedef CHeapItem * CData;
+
+/// Allocate memory, returning the corresponding C data block.
+CData cdata_allocate(size_t size, CDataFinalizer * finalizer);
+
+/// Wrap a pointer as a C data block.
+/// The size should be an estimate of how much memory, in bytes,
+/// is associated with the pointer. This estimate need not be absolutely precise
+/// but it is necessary for GC to work effectively.
+CData cdata_manage(void * data, size_t size, CDataFinalizer * finalizer);
+
+
+// Create a new VM
+VM* init_vm(int stack_size, size_t heap_size,
+            int max_threads);
+
+// Get the VM for the current thread
+VM* get_vm(void);
+// Initialise thread-local data for this VM
+void init_threaddata(VM *vm);
+// Clean up a VM once it's no longer needed
+Stats terminate(VM* vm);
+
+// Create a new VM, set up everything with sensible defaults (use when
+// calling Idris from C)
+VM* idris_vm(void);
+void close_vm(VM* vm);
+
+// Set up key for thread-local data - called once from idris_main
+void init_threadkeys(void);
+
+// Functions all take a pointer to their VM, and previous stack base,
+// and return nothing.
+typedef void*(*func)(VM*, VAL*);
+
+// Register access
+
+#define RVAL (vm->ret)
+#define LOC(x) (vm->valstack_base[x])
+#define TOP(x) (vm->valstack_top[x])
+#define REG1 (vm->reg1)
+
+// Retrieving values
+static inline char * getstr(String * x) {
+    // hdr.u8 used to mark a null string
+    return x->hdr.u8? NULL : x->str;
+}
+
+static inline size_t getstrlen(String * x) {
+    return x->slen;
+}
+
+#define GETSTR(x) (ISSTR(x) ? getstr((String*)(x)) : GETSTROFF(x))
+#define GETSTRLEN(x) (ISSTR(x) ? getstrlen((String*)(x)) : GETSTROFFLEN(x))
+#define GETPTR(x) (((Ptr*)(x))->ptr)
+#define GETMPTR(x) (((ManagedPtr*)(x))->mptr)
+#define GETFLOAT(x) (((Float*)(x))->f)
+#define GETCDATA(x) (((CDataC*)(x))->item)
+
+#define GETBITS8(x) (GETINT(x))
+#define GETBITS16(x) (GETINT(x))
+#define GETBITS32(x) (((Bits32*)(x))->bits32)
+#define GETBITS64(x) (((Bits64*)(x))->bits64)
+
+// Already checked it's a CT_CON
+#define CTAG(x) (((Con*)(x))->tag)
+#define CARITY(x) (((Con*)(x))->hdr.u16) // hdr.u16 used to store arity
+
+#define TAG(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CTAG((Con*)x) : (-1)) )
+#define ARITY(x) (ISINT(x) || x == NULL ? (-1) : ( GETTY(x) == CT_CON ? CARITY((Con*)x) : (-1)) )
+
+#define CELEM(x) (((x)->hdr.sz - sizeof(Array)) / sizeof(VAL))
+
+#define GETTY(x) (ISINT(x)? CT_INT : (ClosureType)((x)->hdr.ty))
+#define SETTY(x,t) ((x)->hdr.ty = t)
+
+// Integers, floats and operators
+
+typedef intptr_t i_int;
+
+// Shifting a negative number left is undefined and (rightly) gives a warning,
+// but we're only interested in shifting the bit pattern, so cast it
+#define MKINT(x) ((void*)((i_int)((((uintptr_t)x)<<1)+1)))
+#define GETINT(x) ((i_int)(x)>>1)
+#define ISINT(x) ((((i_int)x)&1) == 1)
+#define ISSTR(x) (GETTY(x) == CT_STRING)
+
+#define INTOP(op,x,y) MKINT((i_int)((((i_int)x)>>1) op (((i_int)y)>>1)))
+#define UINTOP(op,x,y) MKINT((i_int)((((uintptr_t)x)>>1) op (((uintptr_t)y)>>1)))
+#define FLOATOP(op,x,y) MKFLOAT(vm, ((GETFLOAT(x)) op (GETFLOAT(y))))
+#define FLOATBOP(op,x,y) MKINT((i_int)(((GETFLOAT(x)) op (GETFLOAT(y)))))
+#define ADD(x,y) (void*)(((i_int)x)+(((i_int)y)-1))
+#define MULT(x,y) (MKINT((((i_int)x)>>1) * (((i_int)y)>>1)))
+
+// Stack management
+
+#ifdef IDRIS_TRACE
+#define TRACE idris_trace(vm, __FUNCTION__, __LINE__);
+#else
+#define TRACE
+#endif
+
+#define INITFRAME TRACE\
+                  __attribute__((unused)) VAL* myoldbase;\
+                  void* callres
+
+#define REBASE vm->valstack_base = oldbase; return NULL
+#define RESERVE(x) do { \
+    if (vm->valstack_top+(x) > vm->stack_max) { stackOverflow(); } \
+    else { memset(vm->valstack_top, 0, (x)*sizeof(VAL)); } \
+  } while(0)
+#define RESERVENOALLOC(x) do { \
+    if (vm->valstack_top+(x) > vm->stack_max) { stackOverflow(); } \
+  } while(0)
+#define ADDTOP(x) vm->valstack_top += (x)
+#define TOPBASE(x) vm->valstack_top = vm->valstack_base + (x)
+#define BASETOP(x) vm->valstack_base = vm->valstack_top + (x)
+#define STOREOLD myoldbase = vm->valstack_base
+
+#define CALL(f) callres = f(vm, myoldbase); \
+  while(callres!=NULL) { \
+      callres = ((func)(callres))(vm, myoldbase); \
+  }
+#define TAILCALL(f) return (void*)(f);
+
+// Creating new values (each value placed at the top of the stack)
+VAL MKFLOAT(VM* vm, double val);
+VAL MKSTR(VM* vm, const char* str);
+VAL MKSTRlen(VM* vm, const char* str, size_t size);
+VAL MKPTR(VM* vm, void* ptr);
+VAL MKMPTR(VM* vm, void* ptr, size_t size);
+VAL MKB8(VM* vm, uint8_t b);
+VAL MKB16(VM* vm, uint16_t b);
+VAL MKB32(VM* vm, uint32_t b);
+VAL MKB64(VM* vm, uint64_t b);
+VAL MKCDATA(VM* vm, CHeapItem * item);
+
+// following versions don't take a lock when allocating
+VAL MKFLOATc(VM* vm, double val);
+VAL MKSTROFFc(VM* vm, VAL basestr);
+VAL MKSTRc(VM* vm, char* str);
+VAL MKSTRclen(VM* vm, char* str, size_t len);
+VAL MKPTRc(VM* vm, void* ptr);
+VAL MKMPTRc(VM* vm, void* ptr, size_t size);
+VAL MKCDATAc(VM* vm, CHeapItem * item);
+
+char* GETSTROFF(VAL stroff);
+size_t GETSTROFFLEN(VAL stroff);
+
+#define SETARG(x, i, a) (((Con*)(x))->args)[i] = ((VAL)(a))
+#define GETARG(x, i) (((Con*)(x))->args[i])
+
+#define PROJECT(vm,r,loc,num) \
+    memcpy(&(LOC(loc)), ((Con*)(r))->args, sizeof(VAL)*num)
+#define SLIDE(vm, args) \
+    memmove(&(LOC(0)), &(TOP(0)), sizeof(VAL)*args)
+
+void* iallocate(VM *, size_t, int);
+
+void* allocate(size_t size, int outerlock);
+// void* allocCon(VM* vm, int arity, int outerlock);
+
+// When allocating from C, call 'idris_requireAlloc' with a size to
+// guarantee that no garbage collection will happen (and hence nothing
+// will move) until at least size bytes have been allocated.
+// idris_doneAlloc *must* be called when allocation from C is done (as it
+// may take a lock if other threads are running).
+
+void idris_requireAlloc(VM *, size_t size);
+void idris_doneAlloc(VM *);
+
+// public interface to allocation (note that this may move other pointers
+// if allocating beyond the limits given by idris_requireAlloc!)
+// 'realloc' just calls alloc and copies; 'free' does nothing
+void* idris_alloc(size_t size);
+void* idris_realloc(void* old, size_t old_size, size_t size);
+void idris_free(void* ptr, size_t size);
+
+static inline void updateConF(Con * cl, unsigned tag, unsigned arity) {
+    SETTY(cl, CT_CON);
+    cl->tag = tag;
+    // hdr.u16 used to store arity
+    cl->hdr.u16 = arity;
+    assert(cl->hdr.sz == sizeof(*cl) + sizeof(VAL) * arity);
+    // cl->hdr.sz = sizeof(*cl) + sizeof(VAL) * arity;
+}
+
+static inline Con * allocConF(VM * vm, unsigned tag, unsigned arity, int outer) {
+    Con * cl = iallocate(vm, sizeof(*cl) + sizeof(VAL) * arity, outer);
+    SETTY(cl, CT_CON);
+    cl->tag = tag;
+    // hdr.u16 used to store arity
+    cl->hdr.u16 = arity;
+    return cl;
+}
+
+static inline Array * allocArrayF(VM * vm, size_t len, int outer) {
+    Array * cl = iallocate(vm, sizeof(*cl) + sizeof(VAL) * len, outer);
+    SETTY(cl, CT_ARRAY);
+    return cl;
+}
+
+
+#define allocCon(cl, vm, t, a, o) (cl) = (VAL)allocConF(vm, t, a, o)
+
+#define updateCon(cl, old, tag, arity) (cl) = (old); updateConF(cl, tag, arity)
+
+#define NULL_CON(x) ((VAL)(nullary_cons + x))
+
+#define allocArray(cl, vm, len, o) (cl) = (VAL)allocArrayF(vm, len, o)
+
+int idris_errno(void);
+char* idris_showerror(int err);
+
+extern Con nullary_cons[];
+void init_nullaries(void);
+
+void init_signals(void);
+
+void* vmThread(VM* callvm, func f, VAL arg);
+void* idris_stopThread(VM* vm);
+
+// Copy a structure to another vm's heap
+VAL copyTo(VM* newVM, VAL x);
+
+// Add a message to another VM's message queue
+int idris_sendMessage(VM* sender, int channel_id, VM* dest, VAL msg);
+// Check whether there are any messages in the queue and return PID of
+// sender if so (null if not)
+VM* idris_checkMessages(VM* vm);
+// Check whether there are any messages which are initiating a conversation
+// in the queue and return the message if so (without removing it)
+Msg* idris_checkInitMessages(VM* vm);
+// Check whether there are any messages in the queue
+VM* idris_checkMessagesFrom(VM* vm, int channel_id, VM* sender);
+// Check whether there are any messages in the queue, and wait if not
+VM* idris_checkMessagesTimeout(VM* vm, int timeout);
+// block until there is a message in the queue
+Msg* idris_recvMessage(VM* vm);
+// block until there is a message in the queue
+Msg* idris_recvMessageFrom(VM* vm, int channel_id, VM* sender);
+
+// Query/free structure used to return message data (recvMessage will malloc,
+// so needs an explicit free)
+VAL idris_getMsg(Msg* msg);
+VM* idris_getSender(Msg* msg);
+int idris_getChannel(Msg* msg);
+void idris_freeMsg(Msg* msg);
+
+void idris_trace(VM* vm, const char* func, int line);
+void dumpVal(VAL r);
+void dumpStack(VM* vm);
+
+// Casts
+#define idris_castIntFloat(x) MKFLOAT(vm, (double)(GETINT(x)))
+#define idris_castFloatInt(x) MKINT((i_int)(GETFLOAT(x)))
+
+VAL idris_castIntStr(VM* vm, VAL i);
+VAL idris_castBitsStr(VM* vm, VAL i);
+VAL idris_castStrInt(VM* vm, VAL i);
+VAL idris_castFloatStr(VM* vm, VAL i);
+VAL idris_castStrFloat(VM* vm, VAL i);
+
+// Raw memory manipulation
+void idris_memset(void* ptr, i_int offset, uint8_t c, i_int size);
+void idris_memmove(void* dest, void* src, i_int dest_offset, i_int src_offset, i_int size);
+uint8_t idris_peek(void* ptr, i_int offset);
+void idris_poke(void* ptr, i_int offset, uint8_t data);
+
+VAL idris_peekPtr(VM* vm, VAL ptr, VAL offset);
+VAL idris_pokePtr(VAL ptr, VAL offset, VAL data);
+VAL idris_peekDouble(VM* vm, VAL ptr, VAL offset);
+VAL idris_pokeDouble(VAL ptr, VAL offset, VAL data);
+VAL idris_peekSingle(VM* vm, VAL ptr, VAL offset);
+VAL idris_pokeSingle(VAL ptr, VAL offset, VAL data);
+
+// Crash with a message (used for partial primitives)
+void idris_crash(char* msg);
+
+// String primitives
+VAL idris_concat(VM* vm, VAL l, VAL r);
+VAL idris_strlt(VM* vm, VAL l, VAL r);
+VAL idris_streq(VM* vm, VAL l, VAL r);
+VAL idris_strlen(VM* vm, VAL l);
+// Read a line from a file
+VAL idris_readStr(VM* vm, FILE* h);
+// Read up to 'num' characters from a file
+VAL idris_readChars(VM* vm, int num, FILE* h);
+
+VAL idris_strHead(VM* vm, VAL str);
+VAL idris_strShift(VM* vm, VAL str, int num);
+VAL idris_strTail(VM* vm, VAL str);
+// This is not expected to be efficient! Mostly we wouldn't expect to call
+// it at all at run time.
+VAL idris_strCons(VM* vm, VAL x, VAL xs);
+VAL idris_strIndex(VM* vm, VAL str, VAL i);
+VAL idris_strRev(VM* vm, VAL str);
+VAL idris_substr(VM* vm, VAL offset, VAL length, VAL str);
+
+// Support for IORefs
+VAL idris_newRefLock(VAL x, int outerlock);
+VAL idris_newRef(VAL x);
+void idris_writeRef(VAL ref, VAL x);
+VAL idris_readRef(VAL ref);
+
+// Support for IOArrays
+VAL idris_newArray(VM* vm, int size, VAL def);
+void idris_arraySet(VAL arr, int index, VAL newval);
+VAL idris_arrayGet(VAL arr, int index);
+
+// system infox
+// used indices:
+//   0 returns backend
+//   1 returns OS
+VAL idris_systemInfo(VM* vm, VAL index);
+
+// Command line args
+
+extern int __idris_argc;
+extern char **__idris_argv;
+
+int idris_numArgs(void);
+const char *idris_getArg(int i);
+
+// disable stdin/stdout buffering
+void idris_disableBuffering(void);
+
+#ifndef SEL4
+int idris_usleep(int usec);
+#endif // SEL4
+
+// Handle stack overflow.
+// Just reports an error and exits.
+
+void stackOverflow(void);
+
+// I think these names are nicer for an API...
+
+#define idris_constructor allocCon
+#define idris_setConArg SETARG
+#define idris_getConArg GETARG
+#define idris_mkInt(x) MKINT((intptr_t)(x))
+
+#include "idris_gmp.h"
+
+static inline size_t valSize(VAL v) {
+    return v->hdr.sz;
+}
+
+static inline size_t aligned(size_t sz) {
+    return (sz + sizeof(void*) - 1) & ~(sizeof(void*)-1);
+}
+
+VM* get_vm(void);
+
+#endif
+
+/*
+  Local variables: **
+  c-file-style: "bsd" **
+  c-basic-offset: 4 **
+  indent-tabs-mode: nil **
+  End: **
+*/

dist/rts/idris_stats.c

@@ -0,0 +1,68 @@
+#include "idris_stats.h"
+
+#include <stdio.h>
+#include <locale.h>
+
+#ifdef IDRIS_ENABLE_STATS
+
+void print_stats(const Stats * stats) {
+    clock_t total   = clock() - stats->start_time;
+    clock_t mut     = total - stats->init_time - stats->gc_time - stats->exit_time;
+    double  mut_sec = (double)mut   / CLOCKS_PER_SEC;
+
+    uint64_t avg_chunk = 0;
+    if (stats->alloc_count > 0) {
+      avg_chunk = (uint64_t)((double)stats->allocations / (double)stats->alloc_count);
+    }
+
+    uint64_t alloc_rate = 0;
+    if (mut > 0) {
+      alloc_rate  = (uint64_t)((double)(stats->allocations) / mut_sec);
+    }
+
+    double gc_percent = 0.0;
+    double productivity = 0.0;
+    if (total > 0) {
+        gc_percent = 100 * (double)stats->gc_time / (double)total;
+        productivity = 100 * ((double)mut / (double)total);
+    }
+
+    setlocale(LC_NUMERIC, "");
+    printf("\n");
+    printf("%'20" PRIu64 " bytes allocated in the heap\n",  stats->allocations);
+    printf("%'20" PRIu64 " bytes copied during GC\n",       stats->copied);
+    printf("%'20" PRIu32 " maximum heap size\n",            stats->max_heap_size);
+    printf("%'20" PRIu32 " chunks allocated in the heap\n", stats->alloc_count);
+    printf("%'20" PRIu64 " average chunk size\n\n",         avg_chunk);
+
+    printf("GC called %d times\n\n", stats->collections);
+
+    printf("INIT  time: %8.3fs\n",   (double)stats->init_time / CLOCKS_PER_SEC);
+    printf("MUT   time: %8.3fs\n",   mut_sec);
+    printf("GC    time: %8.3fs\n",   (double)stats->gc_time   / CLOCKS_PER_SEC);
+    printf("EXIT  time: %8.3fs\n",   (double)stats->exit_time / CLOCKS_PER_SEC);
+    printf("TOTAL time: %8.3fs\n\n", (double)total            / CLOCKS_PER_SEC);
+
+    printf("%%GC   time: %.2f%%\n\n", gc_percent);
+
+    printf("Alloc rate %'" PRIu64 " bytes per MUT sec\n\n", alloc_rate);
+
+    printf("Productivity %.2f%%\n", productivity);
+}
+
+void aggregate_stats(Stats * stats1, const Stats * stats2) {
+    fprintf(stderr, "RTS error: aggregate_stats not implemented");
+}
+
+#else
+
+void print_stats(const Stats * stats) {
+    fprintf(stderr, "RTS ERROR: Stats are disabled.\n"  \
+                    "By the way GC called %d times.\n", stats->collections);
+}
+
+void aggregate_stats(Stats * stats1, const Stats * stats2) {
+    stats1->collections += stats2->collections;
+}
+
+#endif // IDRIS_ENABLE_STATS

dist/rts/idris_stats.h

@@ -0,0 +1,76 @@
+#ifndef _IDRIS_STATS_H
+#define _IDRIS_STATS_H
+
+#ifdef IDRIS_ENABLE_STATS
+#include <time.h>
+#endif
+
+#include <inttypes.h>
+#include <stdint.h>
+
+
+// TODO: measure user time, exclusive/inclusive stats
+typedef struct {
+#ifdef IDRIS_ENABLE_STATS
+    uint64_t allocations;       // Size of allocated space in bytes for all execution time.
+    uint32_t alloc_count;       // How many times alloc is called.
+    uint64_t copied;            // Size of space copied during GC.
+    uint32_t max_heap_size;     // Maximum heap size achieved.
+
+    clock_t init_time;     // Time spent for vm initialization.
+    clock_t exit_time;     // Time spent for vm termination.
+    clock_t gc_time;       // Time spent for gc for all execution time.
+    clock_t max_gc_pause;  // Time spent for longest gc.
+    clock_t start_time;    // Time of rts entry point.
+#endif // IDRIS_ENABLE_STATS
+    uint32_t collections;       // How many times gc called.
+} Stats; // without start time it's a monoid, can we remove start_time it somehow?
+
+void print_stats(const Stats * stats);
+void aggregate_stats(Stats * stats1, const Stats * stats2);
+
+
+#ifdef IDRIS_ENABLE_STATS
+
+#ifndef MAX
+#define MAX(a, b) ((a) > (b) ? (a) : (b))
+#endif
+
+#define STATS_INIT_STATS(stats)                 \
+    memset(&stats, 0, sizeof(Stats));           \
+    stats.start_time  = clock();
+
+#define STATS_ALLOC(stats, size)                \
+    stats.allocations += size;                  \
+    stats.alloc_count = stats.alloc_count + 1;
+
+#define STATS_ENTER_INIT(stats) clock_t _start_time = clock();
+#define STATS_LEAVE_INIT(stats) stats.init_time = clock() - _start_time;
+
+#define STATS_ENTER_EXIT(stats) clock_t _start_time = clock();
+#define STATS_LEAVE_EXIT(stats) stats.exit_time = clock() - _start_time;
+
+#define STATS_ENTER_GC(stats, heap_size)                        \
+    clock_t _start_time = clock();                              \
+    stats.max_heap_size = MAX(stats.max_heap_size, heap_size);
+#define STATS_LEAVE_GC(stats, heap_size, heap_occuped)          \
+    clock_t _pause = clock() - _start_time;                     \
+    stats.gc_time += _pause;                                    \
+    stats.max_gc_pause = MAX(_pause, stats.max_gc_pause);       \
+    stats.max_heap_size = MAX(stats.max_heap_size, heap_size);  \
+    stats.copied     += heap_occuped;                           \
+    stats.collections = stats.collections + 1;
+
+#else
+#define STATS_INIT_STATS(stats) memset(&stats, 0, sizeof(Stats));
+#define STATS_ENTER_INIT(stats)
+#define STATS_LEAVE_INIT(stats)
+#define STATS_ENTER_EXIT(stats)
+#define STATS_LEAVE_EXIT(stats)
+#define STATS_ALLOC(stats, size)
+#define STATS_ENTER_GC(stats, heap_size)
+#define STATS_LEAVE_GC(stats, heap_size, heap_occuped)  \
+    stats.collections = stats.collections + 1;
+#endif // IDRIS_ENABLE_STATS
+
+#endif // _IDRIS_STATS_H

dist/rts/idris_stdfgn.c

@@ -0,0 +1,292 @@
+#include "idris_stdfgn.h"
+#include "idris_rts.h"
+#include "idris_gmp.h"
+#include "idris_gc.h"
+
+#include <fcntl.h>
+#include <errno.h>
+#include <sys/stat.h>
+#include <time.h>
+#include <dirent.h>
+#include <unistd.h>
+
+#ifdef _WIN32
+#include "windows/win_utils.h"
+#else
+#include <sys/select.h>
+#endif
+
+extern char** environ;
+
+void putStr(char* str) {
+    printf("%s", str);
+}
+
+void *fileOpen(char *name, char *mode) {
+#ifdef _WIN32
+    FILE *f = win32_u8fopen(name, mode);
+#else
+    FILE *f = fopen(name, mode);
+#endif
+    return (void *)f;
+}
+
+void fileClose(void* h) {
+    FILE* f = (FILE*)h;
+    fclose(f);
+}
+
+int fileEOF(void* h) {
+    FILE* f = (FILE*)h;
+    return feof(f);
+}
+
+int fileError(void* h) {
+    FILE* f = (FILE*)h;
+    return ferror(f);
+}
+
+int fileRemove(const char *filename) {
+    return remove(filename);
+}
+
+int fileSize(void* h) {
+    FILE* f = (FILE*)h;
+    int fd = fileno(f);
+
+    struct stat buf;
+    if (fstat(fd, &buf) == 0) {
+        return (int)(buf.st_size);
+    } else {
+        return -1;
+    }
+}
+
+VAL fileAccessTime(void* h) {
+    FILE* f = (FILE*)h;
+    int fd = fileno(f);
+
+    struct stat buf;
+    if (fstat(fd, &buf) == 0) {
+        return MKBIGI(buf.st_atime);
+    } else {
+        return MKBIGI(-1);
+    }
+}
+
+VAL fileModifiedTime(void* h) {
+    FILE* f = (FILE*)h;
+    int fd = fileno(f);
+
+    struct stat buf;
+    if (fstat(fd, &buf) == 0) {
+        return MKBIGI(buf.st_mtime);
+    } else {
+        return MKBIGI(-1);
+    }
+}
+
+VAL fileStatusTime(void* h) {
+    FILE* f = (FILE*)h;
+    int fd = fileno(f);
+
+    struct stat buf;
+    if (fstat(fd, &buf) == 0) {
+        return MKBIGI(buf.st_ctime);
+    } else {
+        return MKBIGI(-1);
+    }
+}
+
+typedef struct {
+    DIR* dirptr;
+    int error;
+} DirInfo;
+
+void* idris_dirOpen(char* dname) {
+    DIR *d = opendir(dname);
+    if (d == NULL) {
+        return NULL;
+    } else {
+        DirInfo* di = malloc(sizeof(DirInfo));
+        di->dirptr = d;
+        di->error = 0;
+
+        return (void*)di;
+    }
+}
+
+void idris_dirClose(void* h) {
+    DirInfo* di = (DirInfo*)h;
+
+    closedir(di->dirptr);
+    free(di);
+}
+
+char* idris_nextDirEntry(void* h) {
+    DirInfo* di = (DirInfo*)h;
+    struct dirent* de = readdir(di->dirptr);
+
+    if (de == NULL) {
+        di->error = -1;
+        return NULL;
+    } else {
+        return de->d_name;
+    }
+}
+
+int idris_mkdir(char* dname) {
+#ifdef _WIN32
+    return mkdir(dname);
+#else
+    return mkdir(dname, S_IRWXU | S_IRGRP | S_IROTH);
+#endif
+}
+
+int idris_chdir(char* dname) {
+    return chdir(dname);
+}
+
+int idris_dirError(void *dptr) {
+    return ((DirInfo*)dptr)->error;
+}
+
+int idris_writeStr(void* h, char* str) {
+    FILE* f = (FILE*)h;
+    if (fputs(str, f) >= 0) {
+        return 0;
+    } else {
+        return -1;
+    }
+}
+
+int fpoll(void* h)
+{
+#ifdef _WIN32
+    return win_fpoll(h);
+#else
+    FILE* f = (FILE*)h;
+    fd_set x;
+    struct timeval timeout;
+    timeout.tv_sec = 1;
+    timeout.tv_usec = 0;
+    int fd = fileno(f);
+
+    FD_ZERO(&x);
+    FD_SET(fd, &x);
+
+    int r = select(fd+1, &x, 0, 0, &timeout);
+    return r;
+#endif
+}
+
+void *do_popen(const char *cmd, const char *mode) {
+#ifdef _WIN32
+    FILE *f = win32_u8popen(cmd, mode);
+#else
+    FILE *f = popen(cmd, mode);
+    //    int d = fileno(f);
+    //    fcntl(d, F_SETFL, O_NONBLOCK);
+#endif
+    return f;
+}
+
+int isNull(void* ptr) {
+    return ptr==NULL;
+}
+
+void* idris_stdin() {
+    return (void*)stdin;
+}
+
+char* getEnvPair(int i) {
+    return *(environ + i);
+}
+
+VAL idris_time() {
+    time_t t = time(NULL);
+    return MKBIGI(t);
+}
+
+VAL idris_clock(VM* vm) {
+    VAL result;
+#ifdef _WIN32
+    int64_t sec, nsec;
+    win32_gettime(&sec, &nsec);
+    idris_constructor(result, vm, 0, 2, 0);
+    idris_setConArg(result, 0, MKBIGI(sec));
+    idris_setConArg(result, 1, MKBIGI(nsec));
+#else
+    struct timespec ts;
+    // We're not checking the result here, which is of course bad, but
+    // CLOCK_REALTIME is required by POSIX at least!
+    clock_gettime(CLOCK_REALTIME, &ts);
+    idris_constructor(result, vm, 0, 2, 0);
+    idris_setConArg(result, 0, MKBIGI(ts.tv_sec));
+    idris_setConArg(result, 1, MKBIGI(ts.tv_nsec));
+#endif
+    return result;
+}
+
+VAL idris_mkFileError(VM* vm) {
+    VAL result;
+    switch(errno) {
+        // Make sure this corresponds to the FileError structure in
+        // Prelude.File
+        case ENOENT:
+            idris_constructor(result, vm, 3, 0, 0);
+            break;
+        case EACCES:
+            idris_constructor(result, vm, 4, 0, 0);
+            break;
+        default:
+            idris_constructor(result, vm, 0, 1, 0);
+            idris_setConArg(result, 0, MKINT((intptr_t)errno));
+            break;
+    }
+    return result;
+}
+
+void idris_forceGC(void* vm) {
+    idris_gc((VM*)vm);
+}
+
+typedef struct {
+    char* string;
+    int len;
+} StrBuffer;
+
+void* idris_makeStringBuffer(int len) {
+    StrBuffer* sb = malloc(sizeof(StrBuffer));
+    if (sb != NULL) {
+        sb->string = malloc(len);
+        sb->string[0] = '\0';
+        sb->len = 0;
+    }
+    return sb;
+}
+
+void idris_addToString(void* buffer, char* str) {
+    StrBuffer* sb = (StrBuffer*)buffer;
+    int len = strlen(str);
+
+    memcpy(sb->string + sb->len, str, len+1);
+    sb->len += len;
+}
+
+VAL idris_getString(VM* vm, void* buffer) {
+    StrBuffer* sb = (StrBuffer*)buffer;
+
+    VAL str = MKSTR(vm, sb->string);
+    free(sb->string);
+    free(sb);
+    return str;
+}
+
+VAL idris_currentDir() {
+   char cwd[1024];
+   if (getcwd(cwd, sizeof(cwd)) != NULL)
+     return MKSTR(get_vm(),cwd);
+   else
+     return MKSTR(get_vm(),"");
+}

dist/rts/idris_stdfgn.h

@@ -0,0 +1,62 @@
+#ifndef _IDRISSTDFGN_H
+#define _IDRISSTDFGN_H
+
+#include "idris_rts.h"
+
+// A collection of useful standard functions to be used by the prelude.
+
+void putStr(char* str);
+//char* readStr();
+
+void* fileOpen(char* f, char* mode);
+void fileClose(void* h);
+int fileEOF(void* h);
+int fileError(void* h);
+int fileRemove(const char* fname);
+// Returns a negative number if not a file (e.g. directory or device)
+int fileSize(void* h);
+
+// Return a negative number if not a file (e.g. directory or device)
+VAL fileAccessTime(void* h);
+VAL fileModifiedTime(void* h);
+VAL fileStatusTime(void* h);
+
+void* idris_dirOpen(char* dname);
+void idris_dirClose(void* h);
+char* idris_nextDirEntry(void* h);
+
+// Create a directory; return 0 on success or -1 on failure
+int idris_mkdir(char* dname);
+int idris_chdir(char* dname);
+
+// Return 0 if ok, or -1 if there was an error with the given directory
+// (like ferror)
+int idris_dirError(void *dptr);
+
+// return 0 on success
+int idris_writeStr(void*h, char* str);
+// construct a file error structure (see Prelude.File) from errno
+VAL idris_mkFileError(VM* vm);
+
+// Some machinery for building a large string without reallocating
+// Create a string with space for 'len' bytes
+void* idris_makeStringBuffer(int len);
+void idris_addToString(void* buffer, char* str);
+VAL idris_getString(VM* vm, void* buffer);
+
+void* do_popen(const char* cmd, const char* mode);
+int fpoll(void* h);
+
+int isNull(void* ptr);
+void* idris_stdin();
+
+char* getEnvPair(int i);
+
+VAL idris_time();
+VAL idris_clock(VM* vm);
+
+void idris_forceGC();
+
+VAL idris_currentDir();
+
+#endif

dist/rts/idris_utf8.c

@@ -0,0 +1,181 @@
+#include "idris_utf8.h"
+#include <stdio.h>
+#include <string.h>
+#include <stdlib.h>
+
+int idris_utf8_strlen(char *s) {
+   int i = 0, j = 0;
+   while (s[i]) {
+     if ((s[i] & 0xc0) != 0x80) j++;
+     i++;
+   }
+   return j;
+}
+
+int idris_utf8_charlen(char* s) {
+    int init = (int)s[0];
+    if ((init & 0x80) == 0) {
+        return 1; // Top bit unset, so 1 byte
+    }
+    if ((init > 244 && init < 256) ||
+        (init == 192) ||
+        (init == 193)) {
+        return 1; // Invalid characters
+    }
+    int i = 1;
+    while ((s[i] & 0xc0) == 0x80) {
+        i++; // Move on until top 2 bits are not 10
+    }
+    return i;
+}
+
+unsigned idris_utf8_index(char* s, int idx) {
+   int i = 0, j = 0;
+   while (j < idx) {
+     if ((s[i] & 0xc0) != 0x80) j++;
+     i++;
+   }
+   // Find the start of the next character
+   while ((s[i] & 0xc0) == 0x80) { i++; }
+
+   unsigned bytes = 0;
+   unsigned top = 0;
+
+   int init = (int)s[1];
+
+   // s[i] is now the start of the character we want
+   if ((s[i] & 0x80) == 0) {
+       bytes = 1;
+       top = (int)(s[i]);
+   } else if ((init > 244 && init < 256) ||
+              (init == 192) ||
+              (init == 193)) {
+       bytes = 1;
+       top = (int)(s[i]); // Invalid characters
+   } else if ((s[i] & 0xe0) == 0xc0) {
+       bytes = 2;
+       top = (int)(s[i] & 0x1f); // 5 bits
+   } else if ((s[i] & 0xf0) == 0xe0) {
+       bytes = 3;
+       top = (int)(s[i] & 0x0f); // 4 bits
+   } else if ((s[i] & 0xf8) == 0xf0) {
+       bytes = 4;
+       top = (int)(s[i] & 0x07); // 3 bits
+   } else if ((s[i] & 0xfc) == 0xf8) {
+       bytes = 5;
+       top = (int)(s[i] & 0x03); // 2 bits
+   } else if ((s[i] & 0xfe) == 0xfc) {
+       bytes = 6;
+       top = (int)(s[i] & 0x01); // 1 bits
+   }
+
+   while (bytes > 1) {
+       top = top << 6;
+       top += s[++i] & 0x3f; // 6 bits
+       --bytes;
+   }
+
+   return top;
+}
+
+char* idris_utf8_advance(char* str, int i) {
+    while (i > 0 && *str != '\0') {
+        // In a UTF8 single-byte char, the highest bit is 0.  In the
+        // first byte of a multi-byte char, the highest two bits are
+        // 11, but the rest of the bytes start with 10. So we can
+        // decrement our character counter when we see something other
+        // than 10 at the front.
+
+        // This is a bit of an overapproximation, as invalid multibyte
+        // sequences that are too long will be treated as if they are
+        // OK, but it's always paying attention to null-termination.
+        if ((*str & 0xc0) != 0x80) {
+            i--;
+        }
+        str++;
+    }
+    // Now we've found the first byte of the last character. Advance
+    // to the end of it, or the end of the string, whichever is first.
+    // Here, we don't risk overrunning the end of the string because
+    // ('\0' & 0xc0) != 0x80.
+    while ((*str & 0xc0) == 0x80) { str++; }
+
+    return str;
+}
+
+int idris_utf8_findOffset(char* str, int i) {
+    int offset = 0;
+    while(i > 0) {
+        int len = idris_utf8_charlen(str);
+        str+=len;
+        offset+=len;
+        i--;
+    }
+    return offset;
+}
+
+
+char* idris_utf8_fromChar(int x) {
+    char* str;
+    int bytes = 0, top = 0;
+
+    if (x < 0x80) {
+        str = malloc(2);
+        str[0] = (char)x;
+        str[1] = '\0';
+        return str;
+    }
+
+    if (x >= 0x80 && x <= 0x7ff) {
+        bytes = 2;
+        top = 0xc0;
+    } else if (x >= 0x800 && x <= 0xffff) {
+        bytes = 3;
+        top = 0xe0;
+    } else if (x >= 0x10000 && x <= 0x10ffff) {
+        bytes = 4;
+        top = 0xf0;
+    }
+
+    str = malloc(bytes + 1);
+    str[bytes] = '\0';
+    while(bytes > 0) {
+        int xbits = x & 0x3f; // Next 6 bits
+        bytes--;
+        if (bytes > 0) {
+            str[bytes] = (char)xbits + 0x80;
+        } else {
+            str[0] = (char)xbits + top;
+        }
+        x = x >> 6;
+    }
+
+    return str;
+}
+
+void reverse_range(char *start, char *end)
+{
+    while(start < end)
+    {
+        char c = *start;
+        *start++ = *end;
+        *end-- = c;
+    }
+}
+
+char* reverse_char(char *start)
+{
+    char *end = start;
+    while((end[1] & 0xc0) == 0x80) { end++; }
+    reverse_range(start, end);
+    return(end + 1);
+}
+
+char* idris_utf8_rev(char* s, char* result) {
+    strcpy(result, s);
+    char* end = result;
+    while(*end) { end = reverse_char(end); }
+    reverse_range(result, end-1);
+    return result;
+}
+

dist/rts/idris_utf8.h

@@ -0,0 +1,26 @@
+#ifndef _IDRIS_UTF8
+#define _IDRIS_UTF8
+
+/* Various functions for dealing with UTF8 encoding. These are probably
+   not very efficient (and I'm (EB) making no guarantees about their
+   correctness.) Nevertheless, they mean that we can treat Strings as
+   UFT8. Patches welcome :). */
+
+// Get length of a UTF8 encoded string in characters
+int idris_utf8_strlen(char *s);
+// Get number of bytes the first character takes in a string
+int idris_utf8_charlen(char* s);
+// Return int representation of string at an index.
+// Assumes in bounds.
+unsigned idris_utf8_index(char* s, int j);
+// Convert a char as an integer to a char* as a byte sequence
+// Null terminated; caller responsible for freeing
+char* idris_utf8_fromChar(int x);
+// Reverse a UTF8 encoded string, putting the result in 'result'
+char* idris_utf8_rev(char* s, char* result);
+// Advance a pointer into a string by i UTF8 characters.
+// Return original pointer if i <= 0.
+char* idris_utf8_advance(char* str, int i);
+// Return the offset of the ith UTF8 character in the string
+int idris_utf8_findOffset(char* str, int i);
+#endif

dist/rts/libtest.c

@@ -0,0 +1 @@
+int main() {}

dist/rts/mini-gmp.h

@@ -0,0 +1,298 @@
+/* mini-gmp, a minimalistic implementation of a GNU GMP subset.
+
+Copyright 2011-2015 Free Software Foundation, Inc.
+
+This file is part of the GNU MP Library.
+
+The GNU MP Library is free software; you can redistribute it and/or modify
+it under the terms of either:
+
+  * the GNU Lesser General Public License as published by the Free
+    Software Foundation; either version 3 of the License, or (at your
+    option) any later version.
+
+or
+
+  * the GNU General Public License as published by the Free Software
+    Foundation; either version 2 of the License, or (at your option) any
+    later version.
+
+or both in parallel, as here.
+
+The GNU MP Library is distributed in the hope that it will be useful, but
+WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received copies of the GNU General Public License and the
+GNU Lesser General Public License along with the GNU MP Library.  If not,
+see https://www.gnu.org/licenses/.  */
+
+/* About mini-gmp: This is a minimal implementation of a subset of the
+   GMP interface. It is intended for inclusion into applications which
+   have modest bignums needs, as a fallback when the real GMP library
+   is not installed.
+
+   This file defines the public interface. */
+
+#ifndef __MINI_GMP_H__
+#define __MINI_GMP_H__
+
+/* For size_t */
+#include <stddef.h>
+
+#if defined (__cplusplus)
+extern "C" {
+#endif
+
+void mp_set_memory_functions (void *(*) (size_t),
+			      void *(*) (void *, size_t, size_t),
+			      void (*) (void *, size_t));
+
+void mp_get_memory_functions (void *(**) (size_t),
+			      void *(**) (void *, size_t, size_t),
+			      void (**) (void *, size_t));
+
+typedef unsigned long mp_limb_t;
+typedef long mp_size_t;
+typedef unsigned long mp_bitcnt_t;
+
+typedef mp_limb_t *mp_ptr;
+typedef const mp_limb_t *mp_srcptr;
+
+typedef struct
+{
+  int _mp_alloc;		/* Number of *limbs* allocated and pointed
+				   to by the _mp_d field.  */
+  int _mp_size;			/* abs(_mp_size) is the number of limbs the
+				   last field points to.  If _mp_size is
+				   negative this is a negative number.  */
+  mp_limb_t *_mp_d;		/* Pointer to the limbs.  */
+} __mpz_struct;
+
+typedef __mpz_struct mpz_t[1];
+
+typedef __mpz_struct *mpz_ptr;
+typedef const __mpz_struct *mpz_srcptr;
+
+extern const int mp_bits_per_limb;
+
+void mpn_copyi (mp_ptr, mp_srcptr, mp_size_t);
+void mpn_copyd (mp_ptr, mp_srcptr, mp_size_t);
+void mpn_zero (mp_ptr, mp_size_t);
+
+int mpn_cmp (mp_srcptr, mp_srcptr, mp_size_t);
+int mpn_zero_p (mp_srcptr, mp_size_t);
+
+mp_limb_t mpn_add_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t);
+mp_limb_t mpn_add_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t);
+mp_limb_t mpn_add (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t);
+
+mp_limb_t mpn_sub_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t);
+mp_limb_t mpn_sub_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t);
+mp_limb_t mpn_sub (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t);
+
+mp_limb_t mpn_mul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t);
+mp_limb_t mpn_addmul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t);
+mp_limb_t mpn_submul_1 (mp_ptr, mp_srcptr, mp_size_t, mp_limb_t);
+
+mp_limb_t mpn_mul (mp_ptr, mp_srcptr, mp_size_t, mp_srcptr, mp_size_t);
+void mpn_mul_n (mp_ptr, mp_srcptr, mp_srcptr, mp_size_t);
+void mpn_sqr (mp_ptr, mp_srcptr, mp_size_t);
+int mpn_perfect_square_p (mp_srcptr, mp_size_t);
+mp_size_t mpn_sqrtrem (mp_ptr, mp_ptr, mp_srcptr, mp_size_t);
+
+mp_limb_t mpn_lshift (mp_ptr, mp_srcptr, mp_size_t, unsigned int);
+mp_limb_t mpn_rshift (mp_ptr, mp_srcptr, mp_size_t, unsigned int);
+
+mp_bitcnt_t mpn_scan0 (mp_srcptr, mp_bitcnt_t);
+mp_bitcnt_t mpn_scan1 (mp_srcptr, mp_bitcnt_t);
+
+void mpn_com (mp_ptr, mp_srcptr, mp_size_t);
+mp_limb_t mpn_neg (mp_ptr, mp_srcptr, mp_size_t);
+
+mp_bitcnt_t mpn_popcount (mp_srcptr, mp_size_t);
+
+mp_limb_t mpn_invert_3by2 (mp_limb_t, mp_limb_t);
+#define mpn_invert_limb(x) mpn_invert_3by2 ((x), 0)
+
+size_t mpn_get_str (unsigned char *, int, mp_ptr, mp_size_t);
+mp_size_t mpn_set_str (mp_ptr, const unsigned char *, size_t, int);
+
+void mpz_init (mpz_t);
+void mpz_init2 (mpz_t, mp_bitcnt_t);
+void mpz_clear (mpz_t);
+
+#define mpz_odd_p(z)   (((z)->_mp_size != 0) & (int) (z)->_mp_d[0])
+#define mpz_even_p(z)  (! mpz_odd_p (z))
+
+int mpz_sgn (const mpz_t);
+int mpz_cmp_si (const mpz_t, long);
+int mpz_cmp_ui (const mpz_t, unsigned long);
+int mpz_cmp (const mpz_t, const mpz_t);
+int mpz_cmpabs_ui (const mpz_t, unsigned long);
+int mpz_cmpabs (const mpz_t, const mpz_t);
+int mpz_cmp_d (const mpz_t, double);
+int mpz_cmpabs_d (const mpz_t, double);
+
+void mpz_abs (mpz_t, const mpz_t);
+void mpz_neg (mpz_t, const mpz_t);
+void mpz_swap (mpz_t, mpz_t);
+
+void mpz_add_ui (mpz_t, const mpz_t, unsigned long);
+void mpz_add (mpz_t, const mpz_t, const mpz_t);
+void mpz_sub_ui (mpz_t, const mpz_t, unsigned long);
+void mpz_ui_sub (mpz_t, unsigned long, const mpz_t);
+void mpz_sub (mpz_t, const mpz_t, const mpz_t);
+
+void mpz_mul_si (mpz_t, const mpz_t, long int);
+void mpz_mul_ui (mpz_t, const mpz_t, unsigned long int);
+void mpz_mul (mpz_t, const mpz_t, const mpz_t);
+void mpz_mul_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
+void mpz_addmul_ui (mpz_t, const mpz_t, unsigned long int);
+void mpz_addmul (mpz_t, const mpz_t, const mpz_t);
+void mpz_submul_ui (mpz_t, const mpz_t, unsigned long int);
+void mpz_submul (mpz_t, const mpz_t, const mpz_t);
+
+void mpz_cdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t);
+void mpz_fdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t);
+void mpz_tdiv_qr (mpz_t, mpz_t, const mpz_t, const mpz_t);
+void mpz_cdiv_q (mpz_t, const mpz_t, const mpz_t);
+void mpz_fdiv_q (mpz_t, const mpz_t, const mpz_t);
+void mpz_tdiv_q (mpz_t, const mpz_t, const mpz_t);
+void mpz_cdiv_r (mpz_t, const mpz_t, const mpz_t);
+void mpz_fdiv_r (mpz_t, const mpz_t, const mpz_t);
+void mpz_tdiv_r (mpz_t, const mpz_t, const mpz_t);
+
+void mpz_cdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
+void mpz_fdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
+void mpz_tdiv_q_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
+void mpz_cdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
+void mpz_fdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
+void mpz_tdiv_r_2exp (mpz_t, const mpz_t, mp_bitcnt_t);
+
+void mpz_mod (mpz_t, const mpz_t, const mpz_t);
+
+void mpz_divexact (mpz_t, const mpz_t, const mpz_t);
+
+int mpz_divisible_p (const mpz_t, const mpz_t);
+int mpz_congruent_p (const mpz_t, const mpz_t, const mpz_t);
+
+unsigned long mpz_cdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long);
+unsigned long mpz_fdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long);
+unsigned long mpz_tdiv_qr_ui (mpz_t, mpz_t, const mpz_t, unsigned long);
+unsigned long mpz_cdiv_q_ui (mpz_t, const mpz_t, unsigned long);
+unsigned long mpz_fdiv_q_ui (mpz_t, const mpz_t, unsigned long);
+unsigned long mpz_tdiv_q_ui (mpz_t, const mpz_t, unsigned long);
+unsigned long mpz_cdiv_r_ui (mpz_t, const mpz_t, unsigned long);
+unsigned long mpz_fdiv_r_ui (mpz_t, const mpz_t, unsigned long);
+unsigned long mpz_tdiv_r_ui (mpz_t, const mpz_t, unsigned long);
+unsigned long mpz_cdiv_ui (const mpz_t, unsigned long);
+unsigned long mpz_fdiv_ui (const mpz_t, unsigned long);
+unsigned long mpz_tdiv_ui (const mpz_t, unsigned long);
+
+unsigned long mpz_mod_ui (mpz_t, const mpz_t, unsigned long);
+
+void mpz_divexact_ui (mpz_t, const mpz_t, unsigned long);
+
+int mpz_divisible_ui_p (const mpz_t, unsigned long);
+
+unsigned long mpz_gcd_ui (mpz_t, const mpz_t, unsigned long);
+void mpz_gcd (mpz_t, const mpz_t, const mpz_t);
+void mpz_gcdext (mpz_t, mpz_t, mpz_t, const mpz_t, const mpz_t);
+void mpz_lcm_ui (mpz_t, const mpz_t, unsigned long);
+void mpz_lcm (mpz_t, const mpz_t, const mpz_t);
+int mpz_invert (mpz_t, const mpz_t, const mpz_t);
+
+void mpz_sqrtrem (mpz_t, mpz_t, const mpz_t);
+void mpz_sqrt (mpz_t, const mpz_t);
+int mpz_perfect_square_p (const mpz_t);
+
+void mpz_pow_ui (mpz_t, const mpz_t, unsigned long);
+void mpz_ui_pow_ui (mpz_t, unsigned long, unsigned long);
+void mpz_powm (mpz_t, const mpz_t, const mpz_t, const mpz_t);
+void mpz_powm_ui (mpz_t, const mpz_t, unsigned long, const mpz_t);
+
+void mpz_rootrem (mpz_t, mpz_t, const mpz_t, unsigned long);
+int mpz_root (mpz_t, const mpz_t, unsigned long);
+
+void mpz_fac_ui (mpz_t, unsigned long);
+void mpz_bin_uiui (mpz_t, unsigned long, unsigned long);
+
+int mpz_probab_prime_p (const mpz_t, int);
+
+int mpz_tstbit (const mpz_t, mp_bitcnt_t);
+void mpz_setbit (mpz_t, mp_bitcnt_t);
+void mpz_clrbit (mpz_t, mp_bitcnt_t);
+void mpz_combit (mpz_t, mp_bitcnt_t);
+
+void mpz_com (mpz_t, const mpz_t);
+void mpz_and (mpz_t, const mpz_t, const mpz_t);
+void mpz_ior (mpz_t, const mpz_t, const mpz_t);
+void mpz_xor (mpz_t, const mpz_t, const mpz_t);
+
+mp_bitcnt_t mpz_popcount (const mpz_t);
+mp_bitcnt_t mpz_hamdist (const mpz_t, const mpz_t);
+mp_bitcnt_t mpz_scan0 (const mpz_t, mp_bitcnt_t);
+mp_bitcnt_t mpz_scan1 (const mpz_t, mp_bitcnt_t);
+
+int mpz_fits_slong_p (const mpz_t);
+int mpz_fits_ulong_p (const mpz_t);
+long int mpz_get_si (const mpz_t);
+unsigned long int mpz_get_ui (const mpz_t);
+double mpz_get_d (const mpz_t);
+size_t mpz_size (const mpz_t);
+mp_limb_t mpz_getlimbn (const mpz_t, mp_size_t);
+
+void mpz_realloc2 (mpz_t, mp_bitcnt_t);
+mp_srcptr mpz_limbs_read (mpz_srcptr);
+mp_ptr mpz_limbs_modify (mpz_t, mp_size_t);
+mp_ptr mpz_limbs_write (mpz_t, mp_size_t);
+void mpz_limbs_finish (mpz_t, mp_size_t);
+mpz_srcptr mpz_roinit_n (mpz_t, mp_srcptr, mp_size_t);
+
+#define MPZ_ROINIT_N(xp, xs) {{0, (xs),(xp) }}
+
+void mpz_set_si (mpz_t, signed long int);
+void mpz_set_ui (mpz_t, unsigned long int);
+void mpz_set (mpz_t, const mpz_t);
+void mpz_set_d (mpz_t, double);
+
+void mpz_init_set_si (mpz_t, signed long int);
+void mpz_init_set_ui (mpz_t, unsigned long int);
+void mpz_init_set (mpz_t, const mpz_t);
+void mpz_init_set_d (mpz_t, double);
+
+size_t mpz_sizeinbase (const mpz_t, int);
+char *mpz_get_str (char *, int, const mpz_t);
+int mpz_set_str (mpz_t, const char *, int);
+int mpz_init_set_str (mpz_t, const char *, int);
+
+/* This long list taken from gmp.h. */
+/* For reference, "defined(EOF)" cannot be used here.  In g++ 2.95.4,
+   <iostream> defines EOF but not FILE.  */
+#if defined (FILE)                                              \
+  || defined (H_STDIO)                                          \
+  || defined (_H_STDIO)               /* AIX */                 \
+  || defined (_STDIO_H)               /* glibc, Sun, SCO */     \
+  || defined (_STDIO_H_)              /* BSD, OSF */            \
+  || defined (__STDIO_H)              /* Borland */             \
+  || defined (__STDIO_H__)            /* IRIX */                \
+  || defined (_STDIO_INCLUDED)        /* HPUX */                \
+  || defined (__dj_include_stdio_h_)  /* DJGPP */               \
+  || defined (_FILE_DEFINED)          /* Microsoft */           \
+  || defined (__STDIO__)              /* Apple MPW MrC */       \
+  || defined (_MSL_STDIO_H)           /* Metrowerks */          \
+  || defined (_STDIO_H_INCLUDED)      /* QNX4 */		\
+  || defined (_ISO_STDIO_ISO_H)       /* Sun C++ */		\
+  || defined (__STDIO_LOADED)         /* VMS */
+size_t mpz_out_str (FILE *, int, const mpz_t);
+#endif
+
+void mpz_import (mpz_t, size_t, int, size_t, int, size_t, const void *);
+void *mpz_export (void *, size_t *, int, size_t, int, size_t, const mpz_t);
+
+#if defined (__cplusplus)
+}
+#endif
+#endif /* __MINI_GMP_H__ */

dist/rts/windows/win_utils.c

@@ -0,0 +1,67 @@
+#include <io.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <windows.h>
+
+
+// THis file exists to avoid clashes between windows.h and idris_rts.h
+//
+
+int win_fpoll(void *h)
+{
+    HANDLE wh =(HANDLE) _get_osfhandle(_fileno((FILE *)h));
+    if (wh == INVALID_HANDLE_VALUE) {
+        return -1;
+    }
+    DWORD ret = WaitForSingleObject(wh, 1000);
+    // Imitate the return values of select()
+    if (ret == WAIT_OBJECT_0)
+        return 1;
+    if (ret == WAIT_TIMEOUT)
+        return 0;
+    return -1;
+}
+
+int widen_utf8(const char *filename_utf8, LPWSTR *filename_w)
+{
+    int num_chars = MultiByteToWideChar(CP_UTF8, 0, filename_utf8, -1, 0, 0);
+    int size = sizeof(WCHAR);
+    *filename_w = (LPWSTR)malloc(size * num_chars);
+    MultiByteToWideChar(CP_UTF8, 0, filename_utf8, -1, *filename_w, num_chars);
+    return num_chars;
+}
+
+FILE *win32_u8fopen(const char *path, const char *mode)
+{
+    LPWSTR wpath, wmode;
+    widen_utf8(path, &wpath);
+    widen_utf8(mode, &wmode);
+    FILE *f = _wfopen(wpath, wmode);
+    free(wpath);
+    free(wmode);
+    return f;
+}
+
+FILE *win32_u8popen(const char *path, const char *mode)
+{
+    LPWSTR wpath, wmode;
+    widen_utf8(path, &wpath);
+    widen_utf8(mode, &wmode);
+    FILE *f = _wpopen(wpath, wmode);
+    free(wpath);
+    free(wmode);
+    return f;
+}
+
+void win32_gettime(int64_t* sec, int64_t* nsec)
+{
+    FILETIME ft;
+    GetSystemTimePreciseAsFileTime(&ft);
+    ULARGE_INTEGER t;
+    t.HighPart = ft.dwHighDateTime;
+    t.LowPart = ft.dwLowDateTime;
+
+    *nsec = (t.QuadPart % 10000000)*100;
+    *sec = t.QuadPart / 10000000;
+    *sec -= 11644473600; // LDAP epoch to Unix epoch 
+}

dist/rts/windows/win_utils.h

@@ -0,0 +1,9 @@
+#include <stdint.h>
+#include <stdio.h>
+
+#pragma once
+
+int win_fpoll(void *h);
+FILE *win32_u8fopen(const char *path, const char *mode);
+FILE *win32_u8popen(const char *path, const char *mode);
+void win32_gettime(int64_t* sec, int64_t* nsec);

idris2-mkc.ipkg

@@ -0,0 +1,133 @@
+package idris2
+
+modules = 
+    Compiler.Common,
+    Compiler.CompileExpr,
+    Compiler.Inline,
+    Compiler.Scheme.Chez,
+    Compiler.Scheme.Chicken,
+    Compiler.Scheme.Racket,
+    Compiler.Scheme.Common,
+
+    Control.Delayed,
+
+    Core.AutoSearch,
+    Core.Binary,
+    Core.CaseBuilder,
+    Core.CaseTree,
+    Core.Context,
+    Core.CompileExpr,
+    Core.Core,
+    Core.Coverage,
+    Core.Directory,
+    Core.Env,
+    Core.FC,
+    Core.GetType,
+    Core.Hash,
+    Core.LinearCheck,
+    Core.Metadata,
+    Core.Name,
+    Core.Normalise,
+    Core.Options,
+    Core.Reflect,
+    Core.Termination,
+    Core.TT,
+    Core.TTC,
+    Core.Unify,
+    Core.UnifyState,
+    Core.Value,
+
+    Data.ANameMap,
+    Data.Bool.Extra,
+    Data.IntMap,
+    Data.IOArray,
+    Data.NameMap,
+    Data.StringMap,
+    Data.These,
+    Data.StringTrie,
+
+    Idris.CommandLine,
+    Idris.Desugar,
+    Idris.Elab.Implementation,
+    Idris.Elab.Interface,
+    Idris.Error,
+    Idris.IDEMode.CaseSplit,
+    Idris.IDEMode.Commands,
+    Idris.IDEMode.MakeClause,
+    Idris.IDEMode.Parser,
+    Idris.IDEMode.REPL,
+    Idris.IDEMode.TokenLine,
+    Idris.ModTree,
+    Idris.Package,
+    Idris.Parser,
+    Idris.ProcessIdr,
+    Idris.REPL,
+    Idris.REPLCommon,
+    Idris.REPLOpts,
+    Idris.Resugar,
+    Idris.SetOptions,
+    Idris.Socket,
+    Idris.Socket.Data,
+    Idris.Socket.Raw,
+    Idris.Syntax,
+
+    Parser.Lexer,
+    Parser.Support,
+
+    Text.Lexer,
+    Text.Lexer.Core,
+    Text.Parser,
+    Text.Parser.Core,
+    Text.Quantity,
+    Text.Token,
+
+    TTImp.BindImplicits,
+    TTImp.Elab,
+    TTImp.Elab.Ambiguity,
+    TTImp.Elab.App,
+    TTImp.Elab.As,
+    TTImp.Elab.Binders,
+    TTImp.Elab.Case,
+    TTImp.Elab.Check,
+    TTImp.Elab.Dot,
+    TTImp.Elab.Hole,
+    TTImp.Elab.ImplicitBind,
+    TTImp.Elab.Lazy,
+    TTImp.Elab.Local,
+    TTImp.Elab.Prim,
+    TTImp.Elab.Quote,
+    TTImp.Elab.Record,
+    TTImp.Elab.Rewrite,
+    TTImp.Elab.Term,
+    TTImp.Elab.Utils,
+    TTImp.Impossible,
+    TTImp.Interactive.CaseSplit,
+    TTImp.Interactive.ExprSearch,
+    TTImp.Interactive.GenerateDef,
+    TTImp.Interactive.MakeLemma,
+    TTImp.Parser,
+    TTImp.ProcessData,
+    TTImp.ProcessDecls,
+    TTImp.ProcessDef,
+    TTImp.ProcessParams,
+    TTImp.ProcessRecord,
+    TTImp.ProcessType,
+    TTImp.Reflect,
+    TTImp.TTImp,
+    TTImp.Unelab,
+    TTImp.Utils,
+    TTImp.WithClause,
+
+    Utils.Binary,
+    Utils.Hex,
+    Utils.Shunting,
+
+    Yaffle.Main,
+    Yaffle.REPL
+
+sourcedir = src
+executable = idris2.c
+opts = "--partial-eval -S"
+
+main = Idris.Main
+