Populate tree.

.gitignore

@@ -1,4 +1,6 @@
 *~
+*.x86
+*.llvm
 *.out
 *.exe
 *.orig

AUTHORS.txt

@@ -1,7 +1,12 @@
-Rust authors:
+Initial author, project lead, target of blame:
 
 Graydon Hoare <graydon@mozilla.com>
+
+Other authors:
+
 Andreas Gal <gal@mozilla.com>
+Brendan Eich <brendan@mozilla.org>
 Dave Herman <dherman@mozilla.com>
+Michael Bebenita <mbebenita@mozilla.com>
 Patrick Walton <pwalton@mozilla.com>
-Brendan Eich <brendan@mozilla.com>
+Roy Frostig <rfrostig@mozilla.com>

LICENSE.txt

@@ -53,7 +53,8 @@ The following third party packages are included:
     All rights reserved.
 
     Redistribution and use in source and binary forms, with or without
-    modification, are permitted provided that the following conditions are met:
+    modification, are permitted provided that the following conditions are
+    met:
 
         * Redistributions of source code must retain the above copyright
           notice, this list of conditions and the following disclaimer.
@@ -71,9 +72,10 @@ The following third party packages are included:
     SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
 
-* Two header files that are part of the Valgrind package. These files are found
-  at src/rt/valgrind.h and src/rt/memcheck.h, within this distribution. These
-  files are redistributed under the following terms, as noted in them:
+* Two header files that are part of the Valgrind package. These files are
+  found at src/rt/valgrind.h and src/rt/memcheck.h, within this
+  distribution. These files are redistributed under the following terms, as
+  noted in them:
 
   for src/rt/valgrind.h:
 
@@ -158,20 +160,20 @@ well as the collective work itslf, is distributed under the following terms:
     Copyright (c) 2006-2010 Graydon Hoare
     Copyright (c) 2009-2010 Mozilla Foundation
 
-    Permission is hereby granted, free of charge, to any person obtaining a copy
-    of this software and associated documentation files (the "Software"), to deal
-    in the Software without restriction, including without limitation the rights
-    to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
-    copies of the Software, and to permit persons to whom the Software is
-    furnished to do so, subject to the following conditions:
+    Permission is hereby granted, free of charge, to any person obtaining a
+    copy of this software and associated documentation files (the "Software"),
+    to deal in the Software without restriction, including without limitation
+    the rights to use, copy, modify, merge, publish, distribute, sublicense,
+    and/or sell copies of the Software, and to permit persons to whom the
+    Software is furnished to do so, subject to the following conditions:
 
     The above copyright notice and this permission notice shall be included in
     all copies or substantial portions of the Software.
 
     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
     IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-    AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
-    OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
-    THE SOFTWARE.
+    FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
+    THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+    LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+    FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
+    DEALINGS IN THE SOFTWARE.

doc/Makefile

@@ -5,7 +5,8 @@ all: rust.pdf rust.html
 	texi2pdf $<
 
 %.html: %.texi
-	makeinfo --html --force --no-split --output=$@ $<
+	makeinfo --html --ifhtml --force --no-split --output=$@ $<
 
 clean:
-	rm -f rust.aux rust.cp rust.fn rust.ky rust.log rust.pdf rust.html rust.pg rust.toc rust.tp rust.vr
+	rm -f rust.aux rust.cp rust.fn rust.ky rust.log rust.pdf \
+          rust.html rust.pg rust.toc rust.tp rust.vr

src/Makefile

@@ -19,27 +19,29 @@ endif
 
 CFG_INFO := $(info cfg: building on $(CFG_OSTYPE) $(CFG_CPUTYPE))
 
-CFG_GCC_COMPILE_FLAGS :=
+CFG_GCC_CFLAGS :=
 CFG_GCC_LINK_FLAGS :=
 CFG_VALGRIND :=
 
 CFG_LLVM_CONFIG := llvm-config
-CFG_BOOT_FLAGS :=
+CFG_BOOT_FLAGS := $(FLAGS)
 
 ifeq ($(CFG_OSTYPE), Linux)
   CFG_RUNTIME := librustrt.so
   CFG_STDLIB := libstd.so
-  CFG_GCC_COMPILE_FLAGS += -fPIC
+  CFG_GCC_CFLAGS += -fPIC
   CFG_GCC_LINK_FLAGS += -shared -fPIC -ldl -lpthread
   ifeq ($(CFG_CPUTYPE), x86_64)
-    CFG_GCC_COMPILE_FLAGS += -m32
+    CFG_GCC_CFLAGS += -m32
     CFG_GCC_LINK_FLAGS += -m32
   endif
   CFG_NATIVE := 1
   CFG_UNIXY := 1
   CFG_VALGRIND := $(shell which valgrind)
   ifdef CFG_VALGRIND
-    CFG_VALGRIND += --run-libc-freeres=no --leak-check=full --quiet --vex-iropt-level=0
+    CFG_VALGRIND += --leak-check=full \
+                    --quiet --vex-iropt-level=0 \
+                    --suppressions=etc/x86.supp
   endif
 endif
 
@@ -52,7 +54,7 @@ ifeq ($(CFG_OSTYPE), Darwin)
   # "on an i386" when the whole userspace is 64-bit and the compiler
   # emits 64-bit binaries by default. So we just force -m32 here. Smarter
   # approaches welcome!
-  CFG_GCC_COMPILE_FLAGS += -m32
+  CFG_GCC_CFLAGS += -m32
   CFG_GCC_LINK_FLAGS += -m32
 endif
 
@@ -73,7 +75,7 @@ ifdef CFG_WINDOWSY
   CFG_EXE_SUFFIX := .exe
   CFG_BOOT := ./rustboot.exe
   CFG_COMPILER := ./rustc.exe
-  CFG_GCC_COMPILE_FLAGS += -march=i686
+  CFG_GCC_CFLAGS += -march=i686
   CFG_GCC_LINK_FLAGS += -shared -fPIC
   CFG_RUN_TARG = $(1)
   # FIXME: support msvc at some point
@@ -99,10 +101,10 @@ ifdef CFG_UNIXY
     endif
     CFG_OBJ_SUFFIX := .o
     CFG_EXE_SUFFIX := .exe
-    CFG_GCC_COMPILE_FLAGS :=
+    CFG_GCC_CFLAGS :=
     CFG_GCC_LINK_FLAGS := -shared
     ifeq ($(CFG_CPUTYPE), x86_64)
-      CFG_GCC_COMPILE_FLAGS += -m32
+      CFG_GCC_CFLAGS += -m32
       CFG_GCC_LINK_FLAGS += -m32
     endif
   endif
@@ -110,11 +112,11 @@ endif
 
 ifdef CFG_GCC
   CFG_INFO := $(info cfg: using gcc)
-  CFG_GCC_COMPILE_FLAGS += -Wall -Werror -fno-rtti -fno-exceptions -g
+  CFG_GCC_CFLAGS += -Wall -Werror -fno-rtti -fno-exceptions -g
   CFG_GCC_LINK_FLAGS += -g
-  CFG_COMPILE_C = $(CFG_GCC_CROSS)g++ $(CFG_GCC_COMPILE_FLAGS) -c -o $(1) $(2)
+  CFG_COMPILE_C = $(CFG_GCC_CROSS)g++ $(CFG_GCC_CFLAGS) -c -o $(1) $(2)
   CFG_LINK_C = $(CFG_GCC_CROSS)g++ $(CFG_GCC_LINK_FLAGS) -o $(1)
-  CFG_DEPEND_C = $(CFG_GCC_CROSS)g++ $(CFG_GCC_COMPILE_FLAGS) -MT "$(1)" -MM $(2)
+  CFG_DEPEND_C = $(CFG_GCC_CROSS)g++ $(CFG_GCC_CFLAGS) -MT "$(1)" -MM $(2)
 else
   CFG_ERR := $(error please try on a system with gcc)
 endif
@@ -153,7 +155,8 @@ ifneq ($(CFG_LLVM_CONFIG),)
     $(info cfg: using LLVM version 2.8svn)
   else
     CFG_LLVM_CONFIG :=
-    $(info cfg: incompatible LLVM version $(CFG_LLVM_VERSION), expected 2.8svn)
+    $(info cfg: incompatible LLVM version $(CFG_LLVM_VERSION), \
+      expected 2.8svn)
   endif
 endif
 ifdef CFG_LLVM_CONFIG
@@ -161,11 +164,12 @@ ifdef CFG_LLVM_CONFIG
   WHERE := $(shell ocamlc -where)
   LLVM_LIBS := llvm.cma llvm_bitwriter.cma
   LLVM_NATIVE_LIBS := llvm.cmxa llvm_bitwiter.cmxa
-  LLVM_CLIBS := $(shell for c in `$(CFG_LLVM_CONFIG) --ldflags --libs` -lllvm -lllvm_bitwriter; do echo -cclib && echo $$c; done | xargs echo)
+  LLVM_CLIBS := $(shell for c in `$(CFG_LLVM_CONFIG) --ldflags --libs` \
+    -lllvm -lllvm_bitwriter; do echo -cclib && echo $$c; done | xargs echo)
   LLVM_INCS := -I boot/llvm -I $(WHERE)
-  LLVM_MLS := $(addprefix boot/llvm/, llabi.ml llasm.ml llfinal.ml lltrans.ml \
-    llemit.ml)
-  CFG_LLC_COMPILE_FLAGS := -march=x86
+  LLVM_MLS := $(addprefix boot/llvm/, llabi.ml llasm.ml llfinal.ml \
+    lltrans.ml llemit.ml)
+  CFG_LLC_CFLAGS := -march=x86
   $(info cfg: found llvm-config at $(CFG_LLVM_CONFIG))
 else
   VARIANT=x86
@@ -190,7 +194,8 @@ ML_INCS := -I boot/fe -I boot/me -I boot/be -I boot/driver/$(VARIANT) \
 ML_LIBS := unix.cma nums.cma bigarray.cma
 ML_NATIVE_LIBS := unix.cmxa nums.cmxa bigarray.cmxa
 OCAMLC_FLAGS := -g $(ML_INCS) -w Ael -warn-error Ael
-OCAMLOPT_FLAGS := $(ML_INCS) -w Ael -warn-error Ael $(CFG_OCAMLOPT_PROFILE_FLAGS)
+OCAMLOPT_FLAGS := $(ML_INCS) -w Ael -warn-error Ael \
+                    $(CFG_OCAMLOPT_PROFILE_FLAGS)
 
 ifdef CFG_LLVM_CONFIG
   ML_LIBS += $(LLVM_LIBS) -custom -cclib -lstdc++ $(LLVM_CLIBS)
@@ -205,11 +210,12 @@ DRIVER_BOT_MLS := $(addprefix boot/driver/, session.ml)
 BE_MLS := $(addprefix boot/be/, x86.ml ra.ml pe.ml elf.ml \
           macho.ml)
 IL_MLS := $(addprefix boot/be/, asm.ml il.ml abi.ml)
-ME_MLS := $(addprefix boot/me/, walk.ml semant.ml resolve.ml alias.ml type.ml dead.ml \
-          typestate.ml mode.ml mutable.ml gctype.ml loop.ml layout.ml transutil.ml \
-          trans.ml dwarf.ml)
-FE_MLS := $(addprefix boot/fe/, ast.ml token.ml lexer.ml parser.ml pexp.ml item.ml cexp.ml)
-DRIVER_TOP_MLS := $(addprefix boot/driver/, $(VARIANT)/glue.ml lib.ml main.ml)
+ME_MLS := $(addprefix boot/me/, walk.ml semant.ml resolve.ml alias.ml \
+            type.ml dead.ml effect.ml typestate.ml loop.ml layout.ml  \
+            transutil.ml trans.ml dwarf.ml)
+FE_MLS := $(addprefix boot/fe/, ast.ml token.ml lexer.ml parser.ml pexp.ml \
+            item.ml cexp.ml)
+DRIVER_TOP_MLS := $(addprefix boot/driver/, lib.ml $(VARIANT)/glue.ml main.ml)
 
 BOOT_MLS := $(UTIL_BOT_MLS) $(DRIVER_BOT_MLS) $(FE_MLS) $(IL_MLS) $(ME_MLS) \
   $(BE_MLS) $(LLVM_MLS) $(DRIVER_TOP_MLS)
@@ -226,8 +232,12 @@ RUNTIME_CS := rt/rust.cpp \
               rt/rust_comm.cpp \
               rt/rust_dom.cpp \
               rt/rust_task.cpp \
+              rt/rust_chan.cpp \
               rt/rust_upcall.cpp \
+              rt/rust_log.cpp \
+              rt/rust_timer.cpp \
               rt/isaac/randport.cpp
+
 RUNTIME_HDR := rt/rust.h \
                rt/rust_dwarf.h \
                rt/rust_internal.h \
@@ -253,7 +263,8 @@ $(CFG_RUNTIME): $(RUNTIME_OBJS) $(MKFILES) $(RUNTIME_HDR)
 
 $(CFG_STDLIB): $(STDLIB_CRATE) $(CFG_BOOT) $(MKFILES)
 	@$(call CFG_ECHO, compile: $<)
-	$(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -shared -o $@ $(STDLIB_CRATE)
+	$(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) \
+      -shared -o $@ $(STDLIB_CRATE)
 
 %$(CFG_OBJ_SUFFIX): %.cpp $(MKFILES)
 	@$(call CFG_ECHO, compile: $<)
@@ -262,7 +273,8 @@ $(CFG_STDLIB): $(STDLIB_CRATE) $(CFG_BOOT) $(MKFILES)
 ifdef CFG_NATIVE
 $(CFG_BOOT): $(BOOT_CMXS) $(MKFILES)
 	@$(call CFG_ECHO, compile: $<)
-	$(CFG_QUIET)ocamlopt$(OPT) -o $@ $(OCAMLOPT_FLAGS) $(ML_NATIVE_LIBS) $(BOOT_CMXS)
+	$(CFG_QUIET)ocamlopt$(OPT) -o $@ $(OCAMLOPT_FLAGS) $(ML_NATIVE_LIBS) \
+      $(BOOT_CMXS)
 else
 $(CFG_BOOT): $(BOOT_CMOS) $(MKFILES)
 	@$(call CFG_ECHO, compile: $<)
@@ -288,7 +300,7 @@ endif
 # Main compiler targets and rules
 ######################################################################
 
-$(CFG_COMPILER): $(COMPILER_CRATE) $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB)
+$(CFG_COMPILER): $(COMPILER_INPUTS) $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB)
 	@$(call CFG_ECHO, compile: $<)
 	$(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ $<
 	$(CFG_QUIET)chmod 0755 $@
@@ -302,13 +314,17 @@ self: $(CFG_COMPILER)
 # Testing
 ######################################################################
 
-TEST_XFAILS_X86 :=  test/run-pass/mlist_cycle.rs \
+TEST_XFAILS_X86 :=  test/run-pass/mlist-cycle.rs \
                     test/run-pass/clone-with-exterior.rs \
+                    test/run-pass/obj-as.rs \
                     test/run-pass/rec-auto.rs \
                     test/run-pass/vec-slice.rs \
                     test/run-pass/generic-fn-infer.rs \
+                    test/run-pass/generic-recursive-tag.rs \
                     test/run-pass/generic-tag.rs \
+                    test/run-pass/generic-tag-alt.rs \
                     test/run-pass/bind-obj-ctor.rs \
+                    test/run-pass/task-comm.rs \
                     test/compile-fail/rec-missing-fields.rs \
                     test/compile-fail/infinite-tag-type-recursion.rs \
                     test/compile-fail/infinite-vec-type-recursion.rs
@@ -316,61 +332,74 @@ TEST_XFAILS_X86 :=  test/run-pass/mlist_cycle.rs \
 TEST_XFAILS_LLVM := $(addprefix test/run-pass/, \
                       acyclic-unwind.rs \
                       alt-tag.rs \
+                      argv.rs \
                       basic.rs \
                       bind-obj-ctor.rs \
                       bind-thunk.rs \
                       bind-trivial.rs \
+                      bitwise.rs \
+                      box-unbox.rs \
                       cast.rs \
                       char.rs \
                       clone-with-exterior.rs \
                       comm.rs \
+                      command-line-args.rs \
                       complex.rs \
                       dead-code-one-arm-if.rs \
                       deep.rs \
                       div-mod.rs \
                       drop-on-ret.rs \
+                      else-if.rs \
+                      export-non-interference.rs \
                       exterior.rs \
-                      foreach-simple.rs \
-                      foreach-simple-outer-slot.rs \
                       foreach-put-structured.rs \
-                      vec-slice.rs \
-                      simple-obj.rs \
-                      import.rs \
+                      foreach-simple-outer-slot.rs \
+                      foreach-simple.rs \
                       fun-call-variants.rs \
                       fun-indirect-call.rs \
                       generic-derived-type.rs \
                       generic-drop-glue.rs \
-                      generic-fn.rs \
-                      generic-obj.rs \
-                      generic-obj-with-derived-type.rs \
-                      generic-tag.rs \
-                      generic-type.rs \
+                      generic-exterior-box.rs \
                       generic-fn-infer.rs \
-                      vec-append.rs \
-                      vec-concat.rs \
-                      vec-drop.rs \
-                      mutable-vec-drop.rs \
+                      generic-fn.rs \
+                      generic-obj-with-derived-type.rs \
+                      generic-obj.rs \
+                      generic-recursive-tag.rs \
+                      generic-tag-alt.rs \
+                      generic-tag.rs \
+                      generic-type-synonym.rs \
+                      generic-type.rs \
+                      i32-sub.rs \
+                      i8-incr.rs \
+                      import.rs \
                       inner-module.rs \
                       large-records.rs \
+                      lazy-and-or.rs \
                       lazychan.rs \
                       linear-for-loop.rs \
+                      list.rs \
                       many.rs \
+                      mlist-cycle.rs \
                       mlist.rs \
-                      mlist_cycle.rs \
+                      mutable-vec-drop.rs \
                       mutual-recursion-group.rs \
+                      native-mod.rc \
+                      native-opaque-type.rs \
                       native.rc \
-                      command-line-args.rs \
-                      native_mod.rc \
+                      obj-as.rs \
+                      obj-drop.rs \
+                      obj-dtor.rs \
+                      obj-with-vec.rs \
                       opeq.rs \
+                      preempt.rs \
                       pred.rs \
                       readalias.rs \
                       rec-auto.rs \
                       rec-extend.rs \
+                      rec-tup.rs \
                       rec.rs \
-                      rec_tup.rs \
                       return-nil.rs \
-                      i32-sub.rs \
-                      i8-incr.rs \
+                      simple-obj.rs \
                       spawn-fn.rs \
                       spawn.rs \
                       stateful-obj.rs \
@@ -383,31 +412,31 @@ TEST_XFAILS_LLVM := $(addprefix test/run-pass/, \
                       tail-direct.rs \
                       threads.rs \
                       tup.rs \
+                      type-sizes.rs \
                       u32-decr.rs \
                       u8-incr-decr.rs \
                       u8-incr.rs \
                       unit.rs \
                       user.rs \
+                      utf8.rs \
+                      vec-append.rs \
+                      vec-concat.rs \
+                      vec-drop.rs \
+                      vec-slice.rs \
                       vec.rs \
                       writealias.rs \
                       yield.rs \
                       yield2.rs \
-                      native-opaque-type.rs \
-                      type-sizes.rs \
-                      obj-drop.rs \
-                      obj-dtor.rs \
-                      obj-with-vec.rs \
-                      else-if.rs \
-                      lazy-and-or.rs \
+                      task-comm.rs \
                      ) \
                     $(addprefix test/run-fail/, \
                       explicit-fail.rs \
                       fail.rs \
                       linked-failure.rs \
                       pred.rs \
-                      vec_overrun.rs \
-                      str_overrun.rs \
-                      vec_underrun.rs \
+                      vec-overrun.rs \
+                      str-overrun.rs \
+                      vec-underrun.rs \
                      ) \
                     $(addprefix test/compile-fail/, \
                       rec-missing-fields.rs \
@@ -416,93 +445,109 @@ TEST_XFAILS_LLVM := $(addprefix test/run-pass/, \
                      )
 
 ifdef CFG_WINDOWSY
-TEST_XFAILS_X86 += test/run-pass/native_mod.rc
-TEST_XFAILS_LLVM += test/run-pass/native_mod.rc
+TEST_XFAILS_X86 += test/run-pass/native-mod.rc
+TEST_XFAILS_LLVM += test/run-pass/native-mod.rc
+else
+TEST_XFAILS_X86 += test/run-pass/preempt.rs
+TEST_XFAILS_LLVM += test/run-pass/preempt.rs
 endif
 
-TEST_RUN_PASS_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/run-pass/*.rc))
-TEST_RUN_PASS_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/run-pass/*.rc))
-TEST_RUN_PASS_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/run-pass/*.rs))
-TEST_RUN_PASS_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/run-pass/*.rs))
-TEST_RUN_PASS_EXTRAS := $(wildcard test/run-pass/*/*.rs)
-TEST_RUN_PASS_EXES_X86 := \
-                      $(TEST_RUN_PASS_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \
-                      $(TEST_RUN_PASS_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX))
-TEST_RUN_PASS_EXES_LLVM := \
-                      $(TEST_RUN_PASS_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \
-                      $(TEST_RUN_PASS_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX))
-TEST_RUN_PASS_OUTS_X86  := \
-                    $(TEST_RUN_PASS_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out)
-TEST_RUN_PASS_OUTS_LLVM := \
-                    $(TEST_RUN_PASS_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out)
+RPASS_RC := $(wildcard test/run-pass/*.rc)
+RPASS_RS := $(wildcard test/run-pass/*.rs)
+RFAIL_RC := $(wildcard test/run-fail/*.rc)
+RFAIL_RS := $(wildcard test/run-fail/*.rs)
+CFAIL_RC := $(wildcard test/compile-fail/*.rc)
+CFAIL_RS := $(wildcard test/compile-fail/*.rs)
+
+TEST_RPASS_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(RPASS_RC))
+TEST_RPASS_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(RPASS_RC))
+TEST_RPASS_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(RPASS_RS))
+TEST_RPASS_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(RPASS_RS))
+TEST_RPASS_EXTRAS := $(wildcard test/run-pass/*/*.rs)
+TEST_RPASS_EXES_X86 := \
+                      $(TEST_RPASS_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \
+                      $(TEST_RPASS_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX))
+TEST_RPASS_EXES_LLVM := \
+                      $(TEST_RPASS_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \
+                      $(TEST_RPASS_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX))
+TEST_RPASS_OUTS_X86  := \
+                    $(TEST_RPASS_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out)
+TEST_RPASS_OUTS_LLVM := \
+                    $(TEST_RPASS_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out)
 
 
-TEST_RUN_FAIL_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/run-fail/*.rc))
-TEST_RUN_FAIL_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/run-fail/*.rc))
-TEST_RUN_FAIL_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/run-fail/*.rs))
-TEST_RUN_FAIL_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/run-fail/*.rs))
-TEST_RUN_FAIL_EXTRAS := $(wildcard test/run-fail/*/*.rs)
-TEST_RUN_FAIL_EXES_X86 := \
-                      $(TEST_RUN_FAIL_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \
-                      $(TEST_RUN_FAIL_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX))
-TEST_RUN_FAIL_EXES_LLVM := \
-                      $(TEST_RUN_FAIL_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \
-                      $(TEST_RUN_FAIL_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX))
-TEST_RUN_FAIL_OUTS_X86  := \
-                    $(TEST_RUN_FAIL_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out)
-TEST_RUN_FAIL_OUTS_LLVM := \
-                    $(TEST_RUN_FAIL_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out)
+TEST_RFAIL_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(RFAIL_RC))
+TEST_RFAIL_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(RFAIL_RC))
+TEST_RFAIL_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(RFAIL_RS))
+TEST_RFAIL_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(RFAIL_RS))
+TEST_RFAIL_EXTRAS := $(wildcard test/run-fail/*/*.rs)
+TEST_RFAIL_EXES_X86 := \
+                      $(TEST_RFAIL_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \
+                      $(TEST_RFAIL_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX))
+TEST_RFAIL_EXES_LLVM := \
+                      $(TEST_RFAIL_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \
+                      $(TEST_RFAIL_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX))
+TEST_RFAIL_OUTS_X86  := \
+                    $(TEST_RFAIL_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out)
+TEST_RFAIL_OUTS_LLVM := \
+                    $(TEST_RFAIL_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out)
 
 
-TEST_COMPILE_FAIL_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/compile-fail/*.rc))
-TEST_COMPILE_FAIL_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/compile-fail/*.rc))
-TEST_COMPILE_FAIL_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(wildcard test/compile-fail/*.rs))
-TEST_COMPILE_FAIL_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(wildcard test/compile-fail/*.rs))
-TEST_COMPILE_FAIL_EXTRAS := $(wildcard test/compile-fail/*/*.rs)
-TEST_COMPILE_FAIL_EXES_X86 := \
-                  $(TEST_COMPILE_FAIL_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \
-                  $(TEST_COMPILE_FAIL_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX))
-TEST_COMPILE_FAIL_EXES_LLVM := \
-                  $(TEST_COMPILE_FAIL_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \
-                  $(TEST_COMPILE_FAIL_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX))
-TEST_COMPILE_FAIL_OUTS_X86 := \
-                $(TEST_COMPILE_FAIL_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out)
-TEST_COMPILE_FAIL_OUTS_LLVM := \
-                $(TEST_COMPILE_FAIL_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out)
+TEST_CFAIL_CRATES_X86 := $(filter-out $(TEST_XFAILS_X86), $(CFAIL_RC))
+TEST_CFAIL_CRATES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(CFAIL_RC))
+TEST_CFAIL_SOURCES_X86 := $(filter-out $(TEST_XFAILS_X86), $(CFAIL_RS))
+TEST_CFAIL_SOURCES_LLVM := $(filter-out $(TEST_XFAILS_LLVM), $(CFAIL_RS))
+TEST_CFAIL_EXTRAS := $(wildcard test/compile-fail/*/*.rs)
+TEST_CFAIL_EXES_X86 := \
+                  $(TEST_CFAIL_CRATES_X86:.rc=.x86$(CFG_EXE_SUFFIX)) \
+                  $(TEST_CFAIL_SOURCES_X86:.rs=.x86$(CFG_EXE_SUFFIX))
+TEST_CFAIL_EXES_LLVM := \
+                  $(TEST_CFAIL_CRATES_LLVM:.rc=.llvm$(CFG_EXE_SUFFIX)) \
+                  $(TEST_CFAIL_SOURCES_LLVM:.rs=.llvm$(CFG_EXE_SUFFIX))
+TEST_CFAIL_OUTS_X86 := \
+                $(TEST_CFAIL_EXES_X86:.x86$(CFG_EXE_SUFFIX)=.x86.out)
+TEST_CFAIL_OUTS_LLVM := \
+                $(TEST_CFAIL_EXES_LLVM:.llvm$(CFG_EXE_SUFFIX)=.llvm.out)
 
-ALL_TEST_CRATES := $(TEST_COMPILE_FAIL_CRATES_X86) \
-                   $(TEST_RUN_FAIL_CRATES_X86) \
-                   $(TEST_RUN_PASS_CRATES_X86)
+ALL_TEST_CRATES := $(TEST_CFAIL_CRATES_X86) \
+                   $(TEST_RFAIL_CRATES_X86) \
+                   $(TEST_RPASS_CRATES_X86)
 
-ALL_TEST_SOURCES := $(TEST_COMPILE_FAIL_SOURCES_X86) \
-                    $(TEST_RUN_FAIL_SOURCES_X86) \
-                    $(TEST_RUN_PASS_SOURCES_X86)
+ALL_TEST_SOURCES := $(TEST_CFAIL_SOURCES_X86) \
+                    $(TEST_RFAIL_SOURCES_X86) \
+                    $(TEST_RPASS_SOURCES_X86)
 
 ALL_TEST_INPUTS := $(wildcard test/*/*.rs test/*/*/*.rs test/*/*.rc)
 
 
-check_nocompile: $(TEST_COMPILE_FAIL_OUTS_X86)
+check_nocompile: $(TEST_CFAIL_OUTS_X86)
+
+check: tidy \
+       $(TEST_RPASS_EXES_X86) $(TEST_RFAIL_EXES_X86) \
+       $(TEST_RPASS_OUTS_X86) $(TEST_RFAIL_OUTS_X86) \
+       $(TEST_CFAIL_OUTS_X86)
 
-check: $(TEST_RUN_PASS_EXES_X86) $(TEST_RUN_FAIL_EXES_X86) \
-       $(TEST_RUN_PASS_OUTS_X86) $(TEST_RUN_FAIL_OUTS_X86) \
-       $(TEST_COMPILE_FAIL_OUTS_X86)
 
 ifeq ($(VARIANT),llvm)
-ALL_TEST_CRATES += $(TEST_COMPILE_FAIL_CRATES_LLVM) \
-                   $(TEST_RUN_FAIL_CRATES_LLVM) \
-                   $(TEST_RUN_PASS_CRATES_LLVM)
+ALL_TEST_CRATES += $(TEST_CFAIL_CRATES_LLVM) \
+                   $(TEST_RFAIL_CRATES_LLVM) \
+                   $(TEST_RPASS_CRATES_LLVM)
 
-ALL_TEST_SOURCES += $(TEST_COMPILE_FAIL_SOURCES_LLVM) \
-                    $(TEST_RUN_FAIL_SOURCES_LLVM) \
-                    $(TEST_RUN_PASS_SOURCES_LLVM)
+ALL_TEST_SOURCES += $(TEST_CFAIL_SOURCES_LLVM) \
+                    $(TEST_RFAIL_SOURCES_LLVM) \
+                    $(TEST_RPASS_SOURCES_LLVM)
 
-check_nocompile: $(TEST_COMPILE_FAIL_OUTS_LLVM)
+check_nocompile: $(TEST_CFAIL_OUTS_LLVM)
 
-check:  $(TEST_RUN_PASS_EXES_LLVM) $(TEST_RUN_FAIL_EXES_LLVM) \
-        $(TEST_RUN_PASS_OUTS_LLVM) $(TEST_RUN_FAIL_OUTS_LLVM) \
-        $(TEST_COMPILE_FAIL_OUTS_LLVM)
+check:  tidy \
+        $(TEST_RPASS_EXES_LLVM) $(TEST_RFAIL_EXES_LLVM) \
+        $(TEST_RPASS_OUTS_LLVM) $(TEST_RFAIL_OUTS_LLVM) \
+        $(TEST_CFAIL_OUTS_LLVM)
 endif
 
+REQ := $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB)
+BOOT := $(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS)
+
 test/run-pass/%.out: test/run-pass/%$(CFG_EXE_SUFFIX) $(CFG_RUNTIME)
 	@$(call CFG_ECHO, run: $<)
 	$(CFG_QUIET)$(call CFG_RUN_TARG, $<) > $@
@@ -510,55 +555,57 @@ test/run-pass/%.out: test/run-pass/%$(CFG_EXE_SUFFIX) $(CFG_RUNTIME)
 test/run-fail/%.out: test/run-fail/%$(CFG_EXE_SUFFIX) $(CFG_RUNTIME)
 	@$(call CFG_ECHO, run: $<)
 	$(CFG_QUIET)rm -f $@
-	$(CFG_QUIET)$(call CFG_RUN_TARG, $<) >$@ 2>&1 ; X=$$? ; if [ $$X -eq 0 ] ; then exit 1 ; else exit 0 ; fi
-	$(CFG_QUIET)grep --text --quiet "`awk -F: '/error-pattern/ { print $$2 }' $(basename $(basename $@)).rs | tr -d '\n\r'`" $@
+	$(CFG_QUIET)$(call CFG_RUN_TARG, $<) >$@ 2>&1 ; X=$$? ; \
+      if [ $$X -eq 0 ] ; then exit 1 ; else exit 0 ; fi
+	$(CFG_QUIET)grep --text --quiet \
+      "`awk -F: '/error-pattern/ { print $$2 }' \
+        $(basename $(basename $@)).rs | tr -d '\n\r'`" $@
 
-test/compile-fail/%.x86.out: test/compile-fail/%.rs $(CFG_BOOT) $(CFG_RUNTIME)
+test/compile-fail/%.x86.out: test/compile-fail/%.rs $(REQ)
 	@$(call CFG_ECHO, compile [x86]: $<)
 	$(CFG_QUIET)rm -f $@
-	$(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) -o $(@:.out=$(CFG_EXE_SUFFIX)) $< >$@ 2>&1 || true
-	$(CFG_QUIET)grep --text --quiet "`awk -F: '/error-pattern/ { print $$2 }' $< | tr -d '\n\r'`" $@
+	$(BOOT) -o $(@:.out=$(CFG_EXE_SUFFIX)) $< >$@ 2>&1 || true
+	$(CFG_QUIET)grep --text --quiet \
+      "`awk -F: '/error-pattern/ { print $$2 }' $< | tr -d '\n\r'`" $@
 
-test/compile-fail/%.llvm.out: test/compile-fail/%.rs $(CFG_BOOT) $(CFG_RUNTIME)
+test/compile-fail/%.llvm.out: test/compile-fail/%.rs $(REQ)
 	@$(call CFG_ECHO, compile [llvm]: $<)
 	$(CFG_QUIET)rm -f $@
-	$(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $(@:.out=$(CFG_EXE_SUFFIX)) $< >$@ 2>&1 || true
-	$(CFG_QUIET)grep --text --quiet "`awk -F: '/error-pattern/ { print $$2 }' $< | tr -d '\n\r'`" $@
+	$(BOOT) -o $(@:.out=$(CFG_EXE_SUFFIX)) $< >$@ 2>&1 || true
+	$(CFG_QUIET)grep --text --quiet \
+      "`awk -F: '/error-pattern/ { print $$2 }' $< | tr -d '\n\r'`" $@
 
-test/run-pass/%.x86$(CFG_EXE_SUFFIX): test/run-pass/%.rc $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB)
+test/run-pass/%.x86$(CFG_EXE_SUFFIX): test/run-pass/%.rc $(REQ)
 	@$(call CFG_ECHO, compile [x86]: $<)
-	$(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ $<
-	$(CFG_QUIET)chmod 0755 $@
+	$(BOOT) -o $@ $<
 
 %.s: %.bc
 	@$(call CFG_ECHO, compile [llvm]: $<)
-	$(CFG_QUIET)llc $(CFG_LLC_COMPILE_FLAGS) -o $@ $<
+	$(CFG_QUIET)llc $(CFG_LLC_CFLAGS) -o $@ $<
 
 %.llvm$(CFG_EXE_SUFFIX): %.s $(CFG_RUNTIME)
 	@$(call CFG_ECHO, compile [llvm]: $<)
-	$(CFG_QUIET)gcc $(CFG_GCC_COMPILE_FLAGS) -o $@ $< -L. -lrustrt
+	$(CFG_QUIET)gcc $(CFG_GCC_CFLAGS) -o $@ $< -L. -lrustrt
 
-test/run-pass/%.bc: test/run-pass/%.rc $(CFG_BOOT) $(CFG_STDLIB)
+test/run-pass/%.bc: test/run-pass/%.rc $(REQ)
 	@$(call CFG_ECHO, compile [llvm]: $<)
-	$(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ -llvm $<
+	$(BOOT) -o $@ -llvm $<
 
-test/run-pass/%.x86$(CFG_EXE_SUFFIX): test/run-pass/%.rs $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB)
+test/run-pass/%.x86$(CFG_EXE_SUFFIX): test/run-pass/%.rs $(REQ)
 	@$(call CFG_ECHO, compile [x86]: $<)
-	$(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ $<
-	$(CFG_QUIET)chmod 0755 $@
+	$(BOOT) -o $@ $<
 
-test/run-pass/%.bc: test/run-pass/%.rs $(CFG_BOOT) $(CFG_STDLIB)
+test/run-pass/%.bc: test/run-pass/%.rs $(REQ)
 	@$(call CFG_ECHO, compile [llvm]: $<)
-	$(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ -llvm $<
+	$(BOOT) -o $@ -llvm $<
 
-test/run-fail/%.x86$(CFG_EXE_SUFFIX): test/run-fail/%.rs $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB)
+test/run-fail/%.x86$(CFG_EXE_SUFFIX): test/run-fail/%.rs $(REQ)
 	@$(call CFG_ECHO, compile [x86]: $<)
-	$(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ $<
-	$(CFG_QUIET)chmod 0755 $@
+	$(BOOT) -o $@ $<
 
-test/run-fail/%.bc: test/run-fail/%.rs $(CFG_BOOT) $(CFG_STDLIB)
+test/run-fail/%.bc: test/run-fail/%.rs $(REQ)
 	@$(call CFG_ECHO, compile [llvm]: $<)
-	$(CFG_QUIET)OCAMLRUNPARAM="b1" $(CFG_BOOT) $(CFG_BOOT_FLAGS) -o $@ -llvm $<
+	$(BOOT) -o $@ -llvm $<
 
 
 ######################################################################
@@ -570,7 +617,9 @@ C_DEPFILES := $(RUNTIME_CS:%.cpp=%.d)
 
 %.d: %.cpp $(MKFILES)
 	@$(call CFG_ECHO, dep: $<)
-	$(CFG_QUIET)$(call CFG_DEPEND_C, $@ $(patsubst %.cpp, %$(CFG_OBJ_SUFFIX), $<), $(RUNTIME_INCS)) $< $(CFG_PATH_MUNGE) >$@
+	$(CFG_QUIET)$(call CFG_DEPEND_C, $@ \
+      $(patsubst %.cpp, %$(CFG_OBJ_SUFFIX), $<), \
+      $(RUNTIME_INCS)) $< $(CFG_PATH_MUNGE) >$@
 
 %.d: %.ml $(MKFILES)
 	@$(call CFG_ECHO, dep: $<)
@@ -593,15 +642,15 @@ CRATE_DEPFILES := $(ALL_TEST_CRATES:%.rc=%.d) $(STDLIB_DEPFILE)
 
 $(STDLIB_DEPFILE): $(STDLIB_CRATE) $(MKFILES) $(CFG_BOOT)
 	@$(call CFG_ECHO, dep: $<)
-	$(CFG_QUIET)$(CFG_BOOT) $(CFG_BOOT_FLAGS) -shared -rdeps $< $(CFG_PATH_MUNGE) >$@
+	$(BOOT) -shared -rdeps $< $(CFG_PATH_MUNGE) >$@
 
 %.d: %.rc $(MKFILES) $(CFG_BOOT)
 	@$(call CFG_ECHO, dep: $<)
-	$(CFG_QUIET)$(CFG_BOOT) $(CFG_BOOT_FLAGS) -rdeps $< $(CFG_PATH_MUNGE) >$@
+	$(BOOT) -rdeps $< $(CFG_PATH_MUNGE) >$@
 
 %.d: %.rs $(MKFILES) $(CFG_BOOT)
 	@$(call CFG_ECHO, dep: $<)
-	$(CFG_QUIET)$(CFG_BOOT) $(CFG_BOOT_FLAGS) -rdeps $< $(CFG_PATH_MUNGE) >$@
+	$(BOOT) -rdeps $< $(CFG_PATH_MUNGE) >$@
 
 ifneq ($(MAKECMDGOALS),clean)
 -include $(CRATE_DEPFILES)
@@ -622,8 +671,9 @@ PKG_3RDPARTY := rt/valgrind.h rt/memcheck.h \
                 rt/bigint/bigint.h rt/bigint/bigint_int.cpp \
                 rt/bigint/bigint_ext.cpp rt/bigint/low_primes.h
 PKG_FILES := README \
+             $(wildcard etc/*.*) \
              $(MKFILES) $(BOOT_MLS) boot/fe/lexer.mll \
-             $(COMPILER_CRATE) $(COMPILER_INPUTS) \
+             $(COMPILER_INPUTS) \
              $(STDLIB_CRATE) $(STDLIB_INPUTS) \
              $(RUNTIME_CS) $(RUNTIME_HDR) $(PKG_3RDPARTY) \
              $(ALL_TEST_INPUTS)
@@ -658,20 +708,29 @@ distcheck:
 # Cleanup
 ######################################################################
 
-.PHONY: clean
+.PHONY: clean tidy
+
+tidy:
+	@$(call CFG_ECHO, check: formatting)
+	$(CFG_QUIET) python etc/tidy.py \
+      $(wildcard ../*.txt) \
+      ../README \
+      $(filter-out boot/fe/lexer.ml $(PKG_3RDPARTY), $(PKG_FILES))
 
 clean:
 	@$(call CFG_ECHO, cleaning)
-	$(CFG_QUIET)rm -f $(RUNTIME_OBJS) $(BOOT_CMOS) $(BOOT_CMIS) $(BOOT_CMXS) $(BOOT_OBJS)
+	$(CFG_QUIET)rm -f $(RUNTIME_OBJS)
+	$(CFG_QUIET)rm -f $(BOOT_CMOS) $(BOOT_CMIS) $(BOOT_CMXS) $(BOOT_OBJS)
 	$(CFG_QUIET)rm -f $(CFG_COMPILER)
 	$(CFG_QUIET)rm -f $(ML_DEPFILES) $(C_DEPFILES) $(CRATE_DEPFILES)
 	$(CFG_QUIET)rm -f boot/fe/lexer.ml
 	$(CFG_QUIET)rm -f $(CFG_BOOT) $(CFG_RUNTIME) $(CFG_STDLIB)
-	$(CFG_QUIET)rm -f $(TEST_RUN_PASS_EXES_X86) $(TEST_RUN_PASS_OUTS_X86)
-	$(CFG_QUIET)rm -f $(TEST_RUN_PASS_EXES_LLVM) $(TEST_RUN_PASS_OUTS_LLVM)
-	$(CFG_QUIET)rm -f $(TEST_RUN_FAIL_EXES_X86) $(TEST_RUN_FAIL_OUTS_X86)
-	$(CFG_QUIET)rm -f $(TEST_RUN_FAIL_EXES_LLVM) $(TEST_RUN_FAIL_OUTS_LLVM)
-	$(CFG_QUIET)rm -f $(TEST_COMPILE_FAIL_EXES_X86) $(TEST_COMPILE_FAIL_OUTS_X86)
-	$(CFG_QUIET)rm -f $(TEST_COMPILE_FAIL_EXES_LLVM) $(TEST_COMPILE_FAIL_OUTS_LLVM)
+	$(CFG_QUIET)rm -f $(TEST_RPASS_EXES_X86) $(TEST_RPASS_OUTS_X86)
+	$(CFG_QUIET)rm -f $(TEST_RPASS_EXES_LLVM) $(TEST_RPASS_OUTS_LLVM)
+	$(CFG_QUIET)rm -f $(TEST_RFAIL_EXES_X86) $(TEST_RFAIL_OUTS_X86)
+	$(CFG_QUIET)rm -f $(TEST_RFAIL_EXES_LLVM) $(TEST_RFAIL_OUTS_LLVM)
+	$(CFG_QUIET)rm -f $(TEST_CFAIL_EXES_X86) $(TEST_CFAIL_OUTS_X86)
+	$(CFG_QUIET)rm -f $(TEST_CFAIL_EXES_LLVM) $(TEST_CFAIL_OUTS_LLVM)
 	$(CFG_QUIET)rm -Rf $(PKG_NAME)-*.tar.gz dist
-	$(CFG_QUIET)rm -f $(foreach ext,cmx cmi cmo cma o a d exe,$(wildcard boot/*/*.$(ext) boot/*/*/*.$(ext)))
+	$(CFG_QUIET)rm -f $(foreach ext,cmx cmi cmo cma o a d exe,\
+                        $(wildcard boot/*/*.$(ext) boot/*/*/*.$(ext)))

src/README

@@ -0,0 +1,28 @@
+This is preliminary version of the Rust compiler.
+
+Source layout:
+
+boot/              The bootstrap compiler
+boot/fe            - Front end (lexer, parser, AST)
+boot/me            - Middle end (resolve, check, layout, trans)
+boot/be            - Back end (IL, RA, insns, asm, objfiles)
+boot/util          - Ubiquitous helpers
+boot/llvm          - LLVM-based alternative back end
+boot/driver        - Compiler driver
+
+comp/              The self-hosted compiler (doesn't exist yet)
+comp/*             - Same structure as in boot/
+
+rt/                The runtime system
+rt/rust_*.cpp      - The majority of the runtime services
+rt/isaac           - The PRNG used for pseudo-random choices in the runtime
+rt/bigint          - The bigint library used for the 'big' type
+rt/uthash          - Small hashtable-and-list library for C, used in runtime
+rt/{sync,util}     - Small utility classes for the runtime.
+
+test/              Testsuite (for both bootstrap and self-hosted)
+test/compile-fail  - Tests that should fail to compile
+test/run-fail      - Tests that should compile, run and fail
+test/run-pass      - Tests that should compile, run and succeed
+
+Please be gentle, it's a work in progress.

src/boot/be/abi.ml

@@ -0,0 +1,207 @@
+
+(*
+ * The 'abi' structure is pretty much just a grab-bag of machine
+ * dependencies and structure-layout information. Part of the latter
+ * is shared with trans and semant.
+ *
+ * Make some attempt to factor it as time goes by.
+ *)
+
+(* Word offsets for structure fields in rust-internal.h, and elsewhere in
+   compiler. *)
+
+let rc_base_field_refcnt = 0;;
+
+let task_field_refcnt = rc_base_field_refcnt;;
+let task_field_stk = task_field_refcnt + 1;;
+let task_field_runtime_sp = task_field_stk + 1;;
+let task_field_rust_sp = task_field_runtime_sp + 1;;
+let task_field_gc_alloc_chain = task_field_rust_sp + 1;;
+let task_field_dom = task_field_gc_alloc_chain + 1;;
+let n_visible_task_fields = task_field_dom + 1;;
+
+let dom_field_interrupt_flag = 0;;
+
+let frame_glue_fns_field_mark = 0;;
+let frame_glue_fns_field_drop = 1;;
+let frame_glue_fns_field_reloc = 2;;
+
+let exterior_rc_slot_field_refcnt = 0;;
+let exterior_rc_slot_field_body = 1;;
+
+let exterior_gc_slot_field_next = (-2);;
+let exterior_gc_slot_field_ctrl = (-1);;
+let exterior_gc_slot_field_refcnt = 0;;
+let exterior_gc_slot_field_body = 1;;
+
+let exterior_rc_header_size = 1;;
+let exterior_gc_header_size = 3;;
+
+let exterior_gc_malloc_return_adjustment = 2;;
+
+let stk_field_valgrind_id = 0 + 1;;
+let stk_field_limit = stk_field_valgrind_id + 1;;
+let stk_field_data = stk_field_limit + 1;;
+
+let binding_size = 2;;
+let binding_field_item = 0;;
+let binding_field_binding = 1;;
+
+let general_code_alignment = 16;;
+
+let tydesc_field_first_param = 0;;
+let tydesc_field_size = 1;;
+let tydesc_field_align = 2;;
+let tydesc_field_copy_glue = 3;;
+let tydesc_field_drop_glue = 4;;
+let tydesc_field_free_glue = 5;;
+let tydesc_field_mark_glue = 6;;
+let tydesc_field_obj_drop_glue = 7;;
+
+let vec_elt_rc = 0;;
+let vec_elt_alloc = 1;;
+let vec_elt_fill = 2;;
+let vec_elt_data = 3;;
+
+let calltup_elt_out_ptr = 0;;
+let calltup_elt_task_ptr = 1;;
+let calltup_elt_ty_params = 2;;
+let calltup_elt_args = 3;;
+let calltup_elt_iterator_args = 4;;
+let calltup_elt_indirect_args = 5;;
+
+let iterator_args_elt_block_fn = 0;;
+let iterator_args_elt_outer_frame_ptr = 1;;
+
+let indirect_args_elt_closure = 0;;
+
+(* ty_params, src, dst, tydesc, taskptr. *)
+let worst_case_glue_call_args = 5;;
+
+type abi =
+  {
+    abi_word_sz: int64;
+    abi_word_bits: Il.bits;
+    abi_word_ty: Common.ty_mach;
+
+    abi_is_2addr_machine: bool;
+    abi_has_pcrel_data: bool;
+    abi_has_pcrel_code: bool;
+
+    abi_n_hardregs: int;
+    abi_str_of_hardreg: (int -> string);
+
+    abi_prealloc_quad: (Il.quad' -> Il.quad');
+    abi_constrain_vregs: (Il.quad -> Bits.t array -> unit);
+
+    abi_emit_fn_prologue: (Il.emitter
+                           -> Common.size        (* framesz *)
+                             -> Common.size      (* callsz  *)
+                               -> Common.nabi
+                                 -> Common.fixup (* grow_task *)
+                                   -> unit);
+
+    abi_emit_fn_epilogue: (Il.emitter -> unit);
+
+    abi_emit_fn_tail_call: (Il.emitter
+                            -> int64            (* caller_callsz *)
+                              -> int64          (* caller_argsz  *)
+                                -> Il.code      (* callee_code   *)
+                                  -> int64      (* callee_argsz  *)
+                                    -> unit);
+
+    abi_clobbers: (Il.quad -> Il.hreg list);
+
+    abi_emit_native_call: (Il.emitter
+                           -> Il.cell                 (* ret    *)
+                             -> Common.nabi
+                               -> Common.fixup        (* callee *)
+                                 -> Il.operand array  (* args   *)
+                                   -> unit);
+
+    abi_emit_native_void_call: (Il.emitter
+                                -> Common.nabi
+                                  -> Common.fixup             (* callee *)
+                                    -> Il.operand array       (* args   *)
+                                      -> unit);
+
+    abi_emit_native_call_in_thunk: (Il.emitter
+                                    -> Il.cell                (* ret    *)
+                                      -> Common.nabi
+                                        -> Il.operand         (* callee *)
+                                          -> Il.operand array (* args   *)
+                                            -> unit);
+    abi_emit_inline_memcpy: (Il.emitter
+                             -> int64           (* n_bytes   *)
+                               -> Il.reg        (* dst_ptr   *)
+                                 -> Il.reg      (* src_ptr   *)
+                                   -> Il.reg    (* tmp_reg   *)
+                                     -> bool    (* ascending *)
+                                       -> unit);
+
+    (* Global glue. *)
+    abi_activate: (Il.emitter -> unit);
+    abi_yield: (Il.emitter -> unit);
+    abi_unwind: (Il.emitter -> Common.nabi -> Common.fixup -> unit);
+    abi_get_next_pc_thunk:
+      ((Il.reg                   (* output            *)
+        * Common.fixup           (* thunk in objfile  *)
+        * (Il.emitter -> unit))  (* fn to make thunk  *)
+         option);
+
+    abi_sp_reg: Il.reg;
+    abi_fp_reg: Il.reg;
+    abi_dwarf_fp_reg: int;
+    abi_tp_cell: Il.cell;
+    abi_implicit_args_sz: int64;
+    abi_frame_base_sz: int64;
+    abi_frame_info_sz: int64;
+    abi_spill_slot: (Il.spill -> Il.mem);
+  }
+;;
+
+let load_fixup_addr
+    (e:Il.emitter)
+    (out_reg:Il.reg)
+    (fix:Common.fixup)
+    (rty:Il.referent_ty)
+    : unit =
+
+  let cell = Il.Reg (out_reg, Il.AddrTy rty) in
+  let op = Il.ImmPtr (fix, rty) in
+    Il.emit e (Il.lea cell op);
+;;
+
+let load_fixup_codeptr
+    (e:Il.emitter)
+    (out_reg:Il.reg)
+    (fixup:Common.fixup)
+    (has_pcrel_code:bool)
+    (indirect:bool)
+    : Il.code =
+  if indirect
+  then
+    begin
+      load_fixup_addr e out_reg fixup (Il.ScalarTy (Il.AddrTy Il.CodeTy));
+      Il.CodePtr (Il.Cell (Il.Mem (Il.RegIn (out_reg, None),
+                                   Il.ScalarTy (Il.AddrTy Il.CodeTy))))
+    end
+  else
+    if has_pcrel_code
+    then (Il.CodePtr (Il.ImmPtr (fixup, Il.CodeTy)))
+    else
+      begin
+        load_fixup_addr e out_reg fixup Il.CodeTy;
+        Il.CodePtr (Il.Cell (Il.Reg (out_reg, Il.AddrTy Il.CodeTy)))
+      end
+;;
+
+
+(* 
+ * Local Variables:
+ * fill-column: 78; 
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'"; 
+ * End:
+ *)

src/boot/be/asm.ml

@@ -0,0 +1,755 @@
+(*
+
+   Our assembler is an all-at-once, buffer-in-memory job, very simple
+   minded. I have 1gb of memory on my laptop: I don't expect to ever
+   emit a program that large with this code.
+
+   It is based on the 'frag' type, which has a variant for every major
+   type of machine-blob we know how to write (bytes, zstrings, BSS
+   blocks, words of various sorts).
+
+   A frag can contain symbolic references between the sub-parts of
+   it. These are accomplished through ref cells we call fixups, and a
+   2-pass (resolution and writing) process defined recursively over
+   the frag structure.
+
+   Fixups are defined by wrapping a frag in a DEF pseudo-frag with
+   a fixup attached. This will record information about the wrapped
+   frag -- positions and sizes -- in the fixup during resolution.
+
+   We say "positions" and "sizes" there, in plural, because both a
+   file number and a memory number is recorded for each concept.
+
+   File numbers refer to positions and sizes in the file we're
+   generating, and are based on the native int type for the host
+   platform -- usually 31 or 62 bits -- whereas the expressions that
+   *use* position fixups tend to promote them up to 32 or 64 bits
+   somehow. On a 32 bit platform, you can't generate output buffers
+   with 64-bit positions (ocaml limitation!)
+
+   Memory numbers are 64 bit, always, and refer to sizes and positions
+   of frags when they are loaded into memory in the target. When
+   you're generating code for a 32-bit target, or using a memory
+   number in a context that's less than 64 bits, the value is
+   range-checked and truncated. But in all other respects, we imagine
+   a 32-bit address space is just the prefix of the continuing 64-bit
+   address space. If you need to pin an object at a particular place
+   from the point 2^32-1, say, you will need to do arithmetic and use
+   the MEMPOS pseudo-frag, that sets the current memory position as
+   it's being processed.
+
+   Fixups can be *used* anywhere else in the frag tree, as many times
+   as you like. If you try to write an unresolved fixup, the emitter
+   faults. When you specify the use of a fixup, you need to specify
+   whether you want to use its file size, file position, memory size,
+   or memory position.
+
+   Positions, addresses, sizes and such, of course, are in bytes.
+
+   Expressions are evaluated to an int64 (signed), even if the
+   expression is an int32 or less. Depending on how you use the result
+   of the expression, a range check error may fire (for example, if
+   the expression evaluates to -2^24 and you're emitting a word16).
+
+   Word endianness is per-file. At the moment this seems acceptable.
+
+   Because we want to be *very specific* about the time and place
+   arithmetic promotions occur, we define two separate expression-tree
+   types (with the same polymorphic constructors) and two separate
+   evaluation functions, with an explicit operator for marking the
+   promotion-points.
+
+*)
+
+open Common;;
+
+
+let log (sess:Session.sess) =
+  Session.log "asm"
+    sess.Session.sess_log_asm
+    sess.Session.sess_log_out
+;;
+
+let iflog (sess:Session.sess) (thunk:(unit -> unit)) : unit =
+  if sess.Session.sess_log_asm
+  then thunk ()
+  else ()
+;;
+
+exception Bad_fit of string;;
+exception Undef_sym of string;;
+
+type ('a, 'b) expr =
+    IMM of 'a
+  | ADD of (('a, 'b) expr) * (('a, 'b) expr)
+  | SUB of (('a, 'b) expr) * (('a, 'b) expr)
+  | MUL of (('a, 'b) expr) * (('a, 'b) expr)
+  | DIV of (('a, 'b) expr) * (('a, 'b) expr)
+  | REM of (('a, 'b) expr) * (('a, 'b) expr)
+  | MAX of (('a, 'b) expr) * (('a, 'b) expr)
+  | ALIGN of (('a, 'b) expr) * (('a, 'b) expr)
+  | SLL of (('a, 'b) expr) * int
+  | SLR of (('a, 'b) expr) * int
+  | SAR of (('a, 'b) expr) * int
+  | AND of (('a, 'b) expr) * (('a, 'b) expr)
+  | XOR of (('a, 'b) expr) * (('a, 'b) expr)
+  | OR of (('a, 'b) expr) * (('a, 'b) expr)
+  | NOT of (('a, 'b) expr)
+  | NEG of (('a, 'b) expr)
+  | F_POS of fixup
+  | F_SZ of fixup
+  | M_POS of fixup
+  | M_SZ of fixup
+  | EXT of 'b
+
+type expr32 = (int32, int) expr
+;;
+
+type expr64 = (int64, expr32) expr
+;;
+
+
+let rec eval32 (e:expr32)
+    : int32  =
+  let chop64 kind name v =
+    let x = Int64.to_int32 v in
+      if (Int64.compare v (Int64.of_int32 x)) = 0 then
+        x
+      else raise (Bad_fit (kind
+                           ^ " fixup "
+                           ^ name
+                           ^ " overflowed 32 bits in eval32: "
+                           ^ Int64.to_string v))
+  in
+  let expandInt _ _ v = Int32.of_int v in
+  let checkdef kind name v inj =
+    match v with
+        None ->
+          raise (Undef_sym (kind ^ " fixup " ^ name
+                            ^ " undefined in eval32"))
+      | Some x -> inj kind name x
+  in
+  match e with
+      IMM i -> i
+    | ADD (a, b) -> Int32.add (eval32 a) (eval32 b)
+    | SUB (a, b) -> Int32.sub (eval32 a) (eval32 b)
+    | MUL (a, b) -> Int32.mul (eval32 a) (eval32 b)
+    | DIV (a, b) -> Int32.div (eval32 a) (eval32 b)
+    | REM (a, b) -> Int32.rem (eval32 a) (eval32 b)
+    | MAX (a, b) -> i32_max (eval32 a) (eval32 b)
+    | ALIGN (a, b) -> i32_align (eval32 a) (eval32 b)
+    | SLL (a, b) -> Int32.shift_left (eval32 a) b
+    | SLR (a, b) -> Int32.shift_right_logical (eval32 a) b
+    | SAR (a, b) -> Int32.shift_right (eval32 a) b
+    | AND (a, b) -> Int32.logand (eval32 a) (eval32 b)
+    | XOR (a, b) -> Int32.logxor (eval32 a) (eval32 b)
+    | OR (a, b) -> Int32.logor (eval32 a) (eval32 b)
+    | NOT a -> Int32.lognot (eval32 a)
+    | NEG a -> Int32.neg (eval32 a)
+    | F_POS f ->
+        checkdef "file position"
+          f.fixup_name f.fixup_file_pos expandInt
+    | F_SZ f ->
+        checkdef "file size"
+          f.fixup_name f.fixup_file_sz expandInt
+    | M_POS f ->
+        checkdef "mem position"
+          f.fixup_name f.fixup_mem_pos chop64
+    | M_SZ f ->
+        checkdef "mem size" f.fixup_name f.fixup_mem_sz chop64
+    | EXT i -> Int32.of_int i
+;;
+
+let rec eval64 (e:expr64)
+    : int64  =
+  let checkdef kind name v inj =
+    match v with
+        None ->
+          raise (Undef_sym (kind ^ " fixup '"
+                            ^ name ^ "' undefined in eval64"))
+      | Some x -> inj x
+  in
+  match e with
+      IMM i -> i
+    | ADD (a, b) -> Int64.add (eval64 a) (eval64 b)
+    | SUB (a, b) -> Int64.sub (eval64 a) (eval64 b)
+    | MUL (a, b) -> Int64.mul (eval64 a) (eval64 b)
+    | DIV (a, b) -> Int64.div (eval64 a) (eval64 b)
+    | REM (a, b) -> Int64.rem (eval64 a) (eval64 b)
+    | MAX (a, b) -> i64_max (eval64 a) (eval64 b)
+    | ALIGN (a, b) -> i64_align (eval64 a) (eval64 b)
+    | SLL (a, b) -> Int64.shift_left (eval64 a) b
+    | SLR (a, b) -> Int64.shift_right_logical (eval64 a) b
+    | SAR (a, b) -> Int64.shift_right (eval64 a) b
+    | AND (a, b) -> Int64.logand (eval64 a) (eval64 b)
+    | XOR (a, b) -> Int64.logxor (eval64 a) (eval64 b)
+    | OR (a, b) -> Int64.logor (eval64 a) (eval64 b)
+    | NOT a -> Int64.lognot (eval64 a)
+    | NEG a -> Int64.neg (eval64 a)
+    | F_POS f ->
+        checkdef "file position"
+          f.fixup_name f.fixup_file_pos Int64.of_int
+    | F_SZ f ->
+        checkdef "file size"
+          f.fixup_name f.fixup_file_sz Int64.of_int
+    | M_POS f ->
+        checkdef "mem position"
+          f.fixup_name f.fixup_mem_pos (fun x -> x)
+    | M_SZ f ->
+        checkdef "mem size"
+          f.fixup_name f.fixup_mem_sz (fun x -> x)
+    | EXT e -> Int64.of_int32 (eval32 e)
+;;
+
+
+type frag =
+    MARK  (* MARK == 'PAD (IMM 0L)' *)
+  | SEQ of frag array
+  | PAD of int
+  | BSS of int64
+  | MEMPOS of int64
+  | BYTE of int
+  | BYTES of int array
+  | CHAR of char
+  | STRING of string
+  | ZSTRING of string
+  | ULEB128 of expr64
+  | SLEB128 of expr64
+  | WORD of (ty_mach * expr64)
+  | ALIGN_FILE of (int * frag)
+  | ALIGN_MEM of (int * frag)
+  | DEF of (fixup * frag)
+  | RELAX of relaxation
+
+and relaxation =
+    { relax_options: frag array;
+      relax_choice: int ref; }
+;;
+
+exception Relax_more of relaxation;;
+
+let new_relaxation (frags:frag array) =
+  RELAX { relax_options = frags;
+          relax_choice = ref ((Array.length frags) - 1); }
+;;
+
+
+let rec write_frag
+    ~(sess:Session.sess)
+    ~(lsb0:bool)
+    ~(buf:Buffer.t)
+    ~(frag:frag)
+    : unit =
+  let relax = Queue.create () in
+  let bump_relax r =
+    iflog sess (fun _ ->
+                  log sess "bumping relaxation to position %d"
+                    ((!(r.relax_choice)) - 1));
+    r.relax_choice := (!(r.relax_choice)) - 1;
+    if !(r.relax_choice) < 0
+    then bug () "relaxation ran out of options"
+  in
+  let rec loop _ =
+    Queue.clear relax;
+    Buffer.clear buf;
+    resolve_frag_full relax frag;
+    lower_frag ~sess ~lsb0 ~buf ~relax ~frag;
+    if Queue.is_empty relax
+    then ()
+    else
+      begin
+        iflog sess (fun _ -> log sess "relaxing");
+        Queue.iter bump_relax relax;
+        loop ()
+      end
+  in
+    loop ()
+
+
+and resolve_frag_full (relax:relaxation Queue.t) (frag:frag)
+    : unit =
+  let file_pos = ref 0 in
+  let mem_pos = ref 0L in
+  let bump i =
+    mem_pos := Int64.add (!mem_pos) (Int64.of_int i);
+    file_pos := (!file_pos) + i
+  in
+
+  let uleb (e:expr64) : unit =
+    let rec loop value =
+      let value = Int64.shift_right_logical value 7 in
+        if value = 0L
+        then bump 1
+        else
+          begin
+            bump 1;
+            loop value
+          end
+    in
+      loop (eval64 e)
+  in
+
+  let sleb (e:expr64) : unit =
+    let rec loop value =
+      let byte = Int64.logand value 0xf7L in
+      let value = Int64.shift_right value 7 in
+      let signbit = Int64.logand byte 0x40L in
+        if (((value = 0L) && (signbit = 0L)) ||
+              ((value = -1L) && (signbit = 0x40L)))
+        then bump 1
+        else
+          begin
+            bump 1;
+            loop value
+          end
+    in
+      loop (eval64 e)
+  in
+  let rec resolve_frag it =
+    match it with
+      | MARK -> ()
+      | SEQ frags -> Array.iter resolve_frag frags
+      | PAD i -> bump i
+      | BSS i -> mem_pos := Int64.add (!mem_pos) i
+      | MEMPOS i -> mem_pos := i
+      | BYTE _ -> bump 1
+      | BYTES ia -> bump (Array.length ia)
+      | CHAR _ -> bump 1
+      | STRING s -> bump (String.length s)
+      | ZSTRING s -> bump ((String.length s) + 1)
+      | ULEB128 e -> uleb e
+      | SLEB128 e -> sleb e
+      | WORD (mach,_) -> bump (bytes_of_ty_mach mach)
+      | ALIGN_FILE (n, frag) ->
+          let spill = (!file_pos) mod n in
+          let pad = (n - spill) mod n in
+            file_pos := (!file_pos) + pad;
+            (*
+             * NB: aligning the file *causes* likewise alignment of
+             * memory, since we implement "file alignment" by
+             * padding!
+             *)
+            mem_pos := Int64.add (!mem_pos) (Int64.of_int pad);
+            resolve_frag frag
+
+      | ALIGN_MEM (n, frag) ->
+          let n64 = Int64.of_int n in
+          let spill = Int64.rem (!mem_pos) n64 in
+          let pad = Int64.rem (Int64.sub n64 spill) n64 in
+            mem_pos := Int64.add (!mem_pos) pad;
+            resolve_frag frag
+
+      | DEF (f, i) ->
+          let fpos1 = !file_pos in
+          let mpos1 = !mem_pos in
+            resolve_frag i;
+            f.fixup_file_pos <- Some fpos1;
+            f.fixup_mem_pos <- Some mpos1;
+            f.fixup_file_sz <- Some ((!file_pos) - fpos1);
+            f.fixup_mem_sz <- Some (Int64.sub (!mem_pos) mpos1)
+
+      | RELAX rel ->
+          begin
+            try
+              resolve_frag rel.relax_options.(!(rel.relax_choice))
+            with
+                Bad_fit _ -> Queue.add rel relax
+          end
+  in
+    resolve_frag frag
+
+and lower_frag
+    ~(sess:Session.sess)
+    ~(lsb0:bool)
+    ~(buf:Buffer.t)
+    ~(relax:relaxation Queue.t)
+    ~(frag:frag)
+    : unit =
+  let byte (i:int) =
+    if i < 0
+    then raise (Bad_fit "byte underflow")
+    else
+      if i > 255
+      then raise (Bad_fit "byte overflow")
+      else Buffer.add_char buf (Char.chr i)
+  in
+
+  let uleb (e:expr64) : unit =
+    let emit1 k = Buffer.add_char buf (Char.chr (Int64.to_int k)) in
+    let rec loop value =
+      let byte = Int64.logand value 0x7fL in
+      let value = Int64.shift_right_logical value 7 in
+        if value = 0L
+        then emit1 byte
+        else
+          begin
+            emit1 (Int64.logor byte 0x80L);
+            loop value
+          end
+    in
+      loop (eval64 e)
+  in
+
+  let sleb (e:expr64) : unit =
+    let emit1 k = Buffer.add_char buf (Char.chr (Int64.to_int k)) in
+    let rec loop value =
+      let byte = Int64.logand value 0x7fL in
+      let value = Int64.shift_right value 7 in
+      let signbit = Int64.logand byte 0x40L in
+        if (((value = 0L) && (signbit = 0L)) ||
+              ((value = -1L) && (signbit = 0x40L)))
+        then emit1 byte
+        else
+          begin
+            emit1 (Int64.logor byte 0x80L);
+            loop value
+          end
+    in
+      loop (eval64 e)
+  in
+
+  let word (nbytes:int) (signed:bool) (e:expr64) =
+    let i = eval64 e in
+
+    (*
+       FIXME:
+
+       We should really base the entire assembler and memory-position
+       system on Big_int.big_int, but in ocaml the big_int type lacks,
+       oh, just about every useful function (no format string spec, no
+       bitwise ops, blah blah) so it's useless; we're stuck on int64
+       for bootstrapping.
+
+       For the time being we're just going to require you to represent
+       those few unsigned 64 bit terms you have in mind via their
+       signed bit pattern. Suboptimal but it's the best we can do.
+    *)
+
+    let (top,bot) =
+      if nbytes >= 8
+      then
+        if signed
+        then (Int64.max_int,Int64.min_int)
+        else (Int64.max_int,0L)
+      else
+        if signed
+        then
+          let bound = (Int64.shift_left 1L ((8 * nbytes) - 1)) in
+            (Int64.sub bound 1L, Int64.neg bound)
+        else
+          let bound = (Int64.shift_left 1L (8 * nbytes)) in
+            (Int64.sub bound 1L, 0L)
+    in
+
+    let mask1 = Int64.logand 0xffL in
+    let shift = Int64.shift_right_logical in
+    let emit1 k = Buffer.add_char buf (Char.chr (Int64.to_int k)) in
+      if Int64.compare i bot = (-1)
+      then raise (Bad_fit ("word underflow: "
+                           ^ (Int64.to_string i)
+                           ^ " into "
+                           ^ (string_of_int nbytes)
+                           ^ (if signed then " signed" else " unsigned")
+                           ^ " bytes"))
+      else
+        if Int64.compare i top = 1
+        then raise (Bad_fit ("word overflow: "
+                             ^ (Int64.to_string i)
+                             ^ " into "
+                             ^ (string_of_int nbytes)
+                             ^ (if signed then " signed" else " unsigned")
+                             ^ " bytes"))
+        else
+          if lsb0
+          then
+            for n = 0 to (nbytes - 1) do
+              emit1 (mask1 (shift i (8*n)))
+            done
+          else
+            for n = (nbytes - 1) downto 0 do
+              emit1 (mask1 (shift i (8*n)))
+            done
+  in
+    match frag with
+        MARK -> ()
+
+      | SEQ frags ->
+          Array.iter
+            begin
+              fun frag ->
+                lower_frag ~sess ~lsb0 ~buf ~relax ~frag
+            end frags
+
+      | PAD c ->
+          for i = 1 to c do
+            Buffer.add_char buf '\x00'
+          done
+
+      | BSS _ -> ()
+
+      | MEMPOS _ -> ()
+
+      | BYTE i -> byte i
+
+      | BYTES bs ->
+          iflog sess (fun _ -> log sess "lowering %d bytes"
+                        (Array.length bs));
+          Array.iter byte bs
+
+      | CHAR c ->
+          iflog sess (fun _ -> log sess "lowering char: %c" c);
+          Buffer.add_char buf c
+
+      | STRING s ->
+          iflog sess (fun _ -> log sess "lowering string: %s" s);
+          Buffer.add_string buf s
+
+      | ZSTRING s ->
+          iflog sess (fun _ -> log sess "lowering zstring: %s" s);
+          Buffer.add_string buf s;
+          byte 0
+
+      | ULEB128 e -> uleb e
+      | SLEB128 e -> sleb e
+
+      | WORD (m,e) ->
+          iflog sess
+            (fun _ ->
+               log sess "lowering word %s"
+                 (string_of_ty_mach m));
+          word (bytes_of_ty_mach m) (mach_is_signed m) e
+
+      | ALIGN_FILE (n, frag) ->
+          let spill = (Buffer.length buf) mod n in
+          let pad = (n - spill) mod n in
+            for i = 1 to pad do
+              Buffer.add_char buf '\x00'
+            done;
+            lower_frag sess lsb0 buf relax frag
+
+      | ALIGN_MEM (_, i) -> lower_frag sess lsb0 buf relax i
+      | DEF (f, i) ->
+          iflog sess (fun _ -> log sess "lowering fixup: %s" f.fixup_name);
+          lower_frag sess lsb0 buf relax i;
+
+      | RELAX rel ->
+          begin
+            try
+              lower_frag sess lsb0 buf relax
+                rel.relax_options.(!(rel.relax_choice))
+            with
+                Bad_fit _ -> Queue.add rel relax
+          end
+;;
+
+let fold_flags (f:'a -> int64) (flags:'a list) : int64 =
+  List.fold_left (Int64.logor) 0x0L (List.map f flags)
+;;
+
+let write_out_frag sess lsb0 frag =
+  let buf = Buffer.create 0xffff in
+  let file = Session.filename_of sess.Session.sess_out in
+  let out = open_out_bin file in
+    write_frag ~sess ~lsb0 ~buf ~frag;
+    Buffer.output_buffer out buf;
+    flush out;
+    close_out out;
+    Unix.chmod file 0o755
+;;
+
+(* Asm-reader stuff for loading info back from mapped files. *)
+(*
+ * Unfortunately the ocaml Bigarray interface takes 'int' indices, so
+ * f.e. can't do 64-bit offsets / files when running on a 32bit platform.
+ * Despite the fact that we can possibly produce them. Sigh. Yet another
+ * "bootstrap compiler limitation".
+ *)
+type asm_reader =
+    {
+      asm_seek: int -> unit;
+      asm_get_u32: unit -> int;
+      asm_get_u16: unit -> int;
+      asm_get_u8: unit -> int;
+      asm_get_uleb: unit -> int;
+      asm_get_zstr: unit -> string;
+      asm_get_zstr_padded: int -> string;
+      asm_get_off: unit -> int;
+      asm_adv: int -> unit;
+      asm_adv_u32: unit -> unit;
+      asm_adv_u16: unit -> unit;
+      asm_adv_u8: unit -> unit;
+      asm_adv_zstr: unit -> unit;
+      asm_close: unit -> unit;
+    }
+;;
+
+type mmap_arr =
+    (int, Bigarray.int8_unsigned_elt, Bigarray.c_layout)
+      Bigarray.Array1.t
+;;
+
+let new_asm_reader (sess:Session.sess) (s:filename) : asm_reader =
+  iflog sess (fun _ -> log sess "opening file %s" s);
+  let fd = Unix.openfile s [ Unix.O_RDONLY ] 0 in
+  let arr = (Bigarray.Array1.map_file
+               fd ~pos:0L
+               Bigarray.int8_unsigned
+               Bigarray.c_layout
+               false (-1))
+  in
+  let tmp = ref Nativeint.zero in
+  let buf = Buffer.create 16 in
+  let off = ref 0 in
+  let is_open = ref true in
+  let get_word_as_int (nbytes:int) : int =
+    assert (!is_open);
+    let lsb0 = true in
+      tmp := Nativeint.zero;
+      if lsb0
+      then
+        for j = nbytes-1 downto 0 do
+          tmp := Nativeint.shift_left (!tmp) 8;
+          tmp := Nativeint.logor (!tmp) (Nativeint.of_int arr.{(!off) + j})
+        done
+      else
+        for j = 0 to nbytes-1 do
+          tmp := Nativeint.shift_left (!tmp) 8;
+          tmp := Nativeint.logor (!tmp) (Nativeint.of_int arr.{(!off) + j})
+        done;
+      off := (!off) + nbytes;
+      Nativeint.to_int (!tmp)
+  in
+  let get_zstr_padded pad_opt =
+    assert (!is_open);
+    let i = ref (!off) in
+      Buffer.clear buf;
+      let buflen_ok _ =
+        match pad_opt with
+            None -> true
+          | Some pad -> (Buffer.length buf) < pad
+      in
+      while arr.{!i} != 0 && (buflen_ok()) do
+        Buffer.add_char buf (Char.chr arr.{!i});
+        incr i
+      done;
+      begin
+        match pad_opt with
+            None -> off := (!off) + (Buffer.length buf) + 1
+          | Some pad ->
+              begin
+                assert ((Buffer.length buf) <= pad);
+                off := (!off) + pad
+              end
+      end;
+      Buffer.contents buf
+  in
+  let bump i =
+    assert (!is_open);
+    off := (!off) + i
+  in
+    {
+      asm_seek = (fun i -> off := i);
+      asm_get_u32 = (fun _ -> get_word_as_int 4);
+      asm_get_u16 = (fun _ -> get_word_as_int 2);
+      asm_get_u8 = (fun _ -> get_word_as_int 1);
+      asm_get_uleb =
+        begin
+          fun _ ->
+            let rec loop result shift =
+              let byte = arr.{!off} in
+                incr off;
+                let result = result lor ((byte land 0x7f) lsl shift) in
+                  if (byte land 0x80) = 0
+                  then result
+                  else loop result (shift+7)
+            in
+              loop 0 0
+        end;
+      asm_get_zstr = (fun _ -> get_zstr_padded None);
+      asm_get_zstr_padded = (fun pad -> get_zstr_padded (Some pad));
+      asm_get_off = (fun _ -> !off);
+      asm_adv = bump;
+      asm_adv_u32 = (fun _ -> bump 4);
+      asm_adv_u16 = (fun _ -> bump 2);
+      asm_adv_u8 = (fun _ -> bump 1);
+      asm_adv_zstr = (fun _ -> while arr.{!off} != 0
+                      do incr off done);
+      asm_close = (fun _ ->
+                     assert (!is_open);
+                     Unix.close fd;
+                     is_open := false)
+    }
+;;
+
+
+(* 
+ * Metadata note-section encoding / decoding.
+ * 
+ * Since the only object format that defines a "note" section at all is
+ * ELF, we model the contents of the metadata section on ELF's
+ * notes. But the same blob of data is stuck into PE and Mach-O files
+ * too.
+ * 
+ * The format is essentially just the ELF note format:
+ * 
+ *    <un-padded-size-of-name:u32>
+ *    <size-of-desc:u32>
+ *    <type-code=0:u32>
+ *    <name="rust":zstr>
+ *    <0-pad to 4-byte boundary>
+ *    <n=meta-count:u32>
+ *    <k1:zstr> <v1:zstr>
+ *    ...
+ *    <kn:zstr> <vn:zstr>
+ *    <0-pad to 4-byte boundary>
+ * 
+ *)
+let note_rust_frags (meta:(Ast.ident * string) array) : frag =
+  let desc_fixup = new_fixup ".rust.note metadata" in
+  let desc =
+    DEF (desc_fixup,
+         SEQ [|
+           WORD (TY_u32, IMM (Int64.of_int (Array.length meta)));
+           SEQ (Array.map
+                  (fun (k,v) -> SEQ [| ZSTRING k; ZSTRING v; |])
+                  meta);
+           ALIGN_FILE (4, MARK) |])
+  in
+  let name = "rust" in
+  let ty = 0L in
+  let padded_name = SEQ [| ZSTRING name;
+                           ALIGN_FILE (4, MARK) |]
+  in
+  let name_sz = IMM (Int64.of_int ((String.length name) + 1)) in
+    SEQ [| WORD (TY_u32, name_sz);
+           WORD (TY_u32, F_SZ desc_fixup);
+           WORD (TY_u32, IMM ty);
+           padded_name;
+           desc;|]
+;;
+
+let read_rust_note (ar:asm_reader) : (Ast.ident * string) array =
+  ar.asm_adv_u32 ();
+  ar.asm_adv_u32 ();
+  assert ((ar.asm_get_u32 ()) = 0);
+  let rust_name = ar.asm_get_zstr_padded 8 in
+    assert (rust_name = "rust");
+    let n = ar.asm_get_u32() in
+    let meta = Queue.create () in
+      for i = 1 to n
+      do
+        let k = ar.asm_get_zstr() in
+        let v = ar.asm_get_zstr() in
+          Queue.add (k,v) meta
+      done;
+      queue_to_arr meta
+;;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/be/ra.ml

@@ -0,0 +1,664 @@
+open Il;;
+open Common;;
+
+type ctxt =
+    {
+      ctxt_sess: Session.sess;
+      ctxt_n_vregs: int;
+      ctxt_abi: Abi.abi;
+      mutable ctxt_quads: Il.quads;
+      mutable ctxt_next_spill: int;
+      mutable ctxt_next_label: int;
+      (* More state as necessary. *)
+    }
+;;
+
+let new_ctxt
+    (sess:Session.sess)
+    (quads:Il.quads)
+    (vregs:int)
+    (abi:Abi.abi)
+    : ctxt =
+  {
+    ctxt_sess = sess;
+    ctxt_quads = quads;
+    ctxt_n_vregs = vregs;
+    ctxt_abi = abi;
+    ctxt_next_spill = 0;
+    ctxt_next_label = 0;
+  }
+;;
+
+let log (cx:ctxt) =
+  Session.log "ra"
+    cx.ctxt_sess.Session.sess_log_ra
+    cx.ctxt_sess.Session.sess_log_out
+;;
+
+let iflog (cx:ctxt) (thunk:(unit -> unit)) : unit =
+  if cx.ctxt_sess.Session.sess_log_ra
+  then thunk ()
+  else ()
+;;
+
+let list_to_str list eltstr =
+  (String.concat "," (List.map eltstr (List.sort compare list)))
+;;
+
+let next_spill (cx:ctxt) : int =
+  let i = cx.ctxt_next_spill in
+    cx.ctxt_next_spill <- i + 1;
+    i
+;;
+
+let next_label (cx:ctxt) : string =
+  let i = cx.ctxt_next_label in
+    cx.ctxt_next_label <- i + 1;
+    (".L" ^ (string_of_int i))
+;;
+
+exception Ra_error of string ;;
+
+let convert_labels (cx:ctxt) : unit =
+  let quad_fixups = Array.map (fun q -> q.quad_fixup) cx.ctxt_quads in
+  let qp_code (_:Il.quad_processor) (c:Il.code) : Il.code =
+    match c with
+        Il.CodeLabel lab ->
+          let fix =
+            match quad_fixups.(lab) with
+                None ->
+                  let fix = new_fixup (next_label cx) in
+                    begin
+                      quad_fixups.(lab) <- Some fix;
+                      fix
+                    end
+              | Some f -> f
+          in
+            Il.CodePtr (Il.ImmPtr (fix, Il.CodeTy))
+      | _ -> c
+  in
+  let qp = { Il.identity_processor
+             with Il.qp_code = qp_code }
+  in
+    Il.rewrite_quads qp cx.ctxt_quads;
+    Array.iteri (fun i fix ->
+                   cx.ctxt_quads.(i) <- { cx.ctxt_quads.(i) with
+                                            Il.quad_fixup = fix })
+      quad_fixups;
+;;
+
+let convert_pre_spills
+    (cx:ctxt)
+    (mkspill:(Il.spill -> Il.mem))
+    : int =
+  let n = ref 0 in
+  let qp_mem (_:Il.quad_processor) (a:Il.mem) : Il.mem =
+    match a with
+        Il.Spill i ->
+          begin
+            if i+1 > (!n)
+            then n := i+1;
+            mkspill i
+          end
+      | _ -> a
+  in
+  let qp = Il.identity_processor in
+  let qp = { qp with
+               Il.qp_mem = qp_mem  }
+  in
+    begin
+      Il.rewrite_quads qp cx.ctxt_quads;
+      !n
+    end
+;;
+
+let kill_quad (i:int) (cx:ctxt) : unit =
+  cx.ctxt_quads.(i) <-
+    { Il.deadq with
+        Il.quad_fixup = cx.ctxt_quads.(i).Il.quad_fixup }
+;;
+
+let kill_redundant_moves (cx:ctxt) : unit =
+  let process_quad i q =
+    match q.Il.quad_body with
+        Il.Unary u when
+          ((Il.is_mov u.Il.unary_op) &&
+             (Il.Cell u.Il.unary_dst) = u.Il.unary_src) ->
+            kill_quad i cx
+      | _ -> ()
+  in
+    Array.iteri process_quad cx.ctxt_quads
+;;
+
+let quad_jump_target_labels (q:quad) : Il.label list =
+  let explicits =
+    match q.Il.quad_body with
+        Il.Jmp { Il.jmp_targ = Il.CodeLabel lab } -> [ lab ]
+      | _ -> []
+  in
+    explicits @ q.quad_implicits;
+;;
+
+let quad_used_vregs (q:quad) : Il.vreg list =
+  let vregs = ref [] in
+  let qp_reg _ r =
+    match r with
+        Il.Vreg v -> (vregs := (v :: (!vregs)); r)
+      | _ -> r
+  in
+  let qp_cell_write qp c =
+    match c with
+        Il.Reg _ -> c
+      | Il.Mem (a, b) -> Il.Mem (qp.qp_mem qp a, b)
+  in
+  let qp = { Il.identity_processor with
+               Il.qp_reg = qp_reg;
+               Il.qp_cell_write = qp_cell_write }
+  in
+    ignore (Il.process_quad qp q);
+    !vregs
+;;
+
+let quad_defined_vregs (q:quad) : Il.vreg list =
+  let vregs = ref [] in
+  let qp_cell_write _ c =
+    match c with
+        Il.Reg (Il.Vreg v, _) -> (vregs := (v :: (!vregs)); c)
+      | _ -> c
+  in
+  let qp = { Il.identity_processor with
+               Il.qp_cell_write = qp_cell_write }
+  in
+    ignore (Il.process_quad qp q);
+    !vregs
+;;
+
+let quad_is_unconditional_jump (q:quad) : bool =
+  match q.Il.quad_body with
+      Il.Jmp { jmp_op = Il.JMP } -> true
+    | Il.Ret -> true
+    | _ -> false
+;;
+
+let calculate_live_bitvectors
+    (cx:ctxt)
+    : ((Bits.t array) * (Bits.t array)) =
+
+  log cx "calculating live bitvectors";
+
+  let quads = cx.ctxt_quads in
+  let n_quads = Array.length quads in
+  let n_vregs = cx.ctxt_n_vregs in
+  let new_bitv _ = Bits.create n_vregs false in
+  let (live_in_vregs:Bits.t array) = Array.init n_quads new_bitv in
+  let (live_out_vregs:Bits.t array) = Array.init n_quads new_bitv in
+
+  let (quad_used_vrs:Bits.t array) = Array.init n_quads new_bitv in
+  let (quad_defined_vrs:Bits.t array) = Array.init n_quads new_bitv in
+  let (quad_uncond_jmp:bool array) = Array.make n_quads false in
+  let (quad_jmp_targs:(Il.label list) array) = Array.make n_quads [] in
+
+  let outer_changed = ref true in
+
+  (* Working bit-vector. *)
+  let scratch = new_bitv() in
+
+  (* bit-vector helpers. *)
+    (* Setup pass. *)
+    for i = 0 to n_quads - 1 do
+      let q = quads.(i) in
+        quad_uncond_jmp.(i) <- quad_is_unconditional_jump q;
+        quad_jmp_targs.(i) <- quad_jump_target_labels q;
+        List.iter
+          (fun v -> Bits.set quad_used_vrs.(i) v true)
+          (quad_used_vregs q);
+        List.iter
+          (fun v -> Bits.set quad_defined_vrs.(i) v true)
+          (quad_defined_vregs q)
+    done;
+
+    while !outer_changed do
+      iflog cx (fun _ -> log cx "iterating outer bitvector calculation");
+      outer_changed := false;
+      for i = 0 to n_quads - 1 do
+        Bits.clear live_in_vregs.(i);
+        Bits.clear live_out_vregs.(i)
+      done;
+      let inner_changed = ref true in
+        while !inner_changed do
+          inner_changed := false;
+          iflog cx
+            (fun _ ->
+               log cx "iterating inner bitvector calculation over %d quads"
+                 n_quads);
+          for i = n_quads - 1 downto 0 do
+
+            let note_change b = if b then inner_changed := true in
+            let live_in = live_in_vregs.(i) in
+            let live_out = live_out_vregs.(i) in
+            let used = quad_used_vrs.(i) in
+            let defined = quad_defined_vrs.(i) in
+
+              (* Union in the vregs we use. *)
+              note_change (Bits.union live_in used);
+
+              (* Union in all our jump targets. *)
+              List.iter
+                (fun i -> note_change (Bits.union live_out live_in_vregs.(i)))
+                (quad_jmp_targs.(i));
+
+              (* Union in our block successor if we have one *)
+              if i < (n_quads - 1) && (not (quad_uncond_jmp.(i)))
+              then note_change (Bits.union live_out live_in_vregs.(i+1));
+
+              (* Propagate live-out to live-in on anything we don't define. *)
+              ignore (Bits.copy scratch defined);
+              Bits.invert scratch;
+              ignore (Bits.intersect scratch live_out);
+              note_change (Bits.union live_in scratch);
+
+          done
+        done;
+        let kill_mov_to_dead_target i q =
+          match q.Il.quad_body with
+              Il.Unary { Il.unary_op=uop;
+                         Il.unary_dst=Il.Reg (Il.Vreg v, _) }
+                when
+                  ((Il.is_mov uop) &&
+                     not (Bits.get live_out_vregs.(i) v)) ->
+                  begin
+                    kill_quad i cx;
+                    outer_changed := true;
+                  end
+            | _ -> ()
+        in
+          Array.iteri kill_mov_to_dead_target quads
+    done;
+    iflog cx
+      begin
+        fun _ ->
+          log cx "finished calculating live bitvectors";
+          log cx "=========================";
+          for q = 0 to n_quads - 1 do
+            let buf = Buffer.create 128 in
+              for v = 0 to (n_vregs - 1)
+              do
+                if ((Bits.get live_in_vregs.(q) v)
+                    && (Bits.get live_out_vregs.(q) v))
+                then Printf.bprintf buf " %-2d" v
+                else Buffer.add_string buf "   "
+              done;
+              log cx "[%6d] live vregs: %s" q (Buffer.contents buf)
+          done;
+          log cx "========================="
+      end;
+    (live_in_vregs, live_out_vregs)
+;;
+
+
+let is_end_of_basic_block (q:quad) : bool =
+  match q.Il.quad_body with
+      Il.Jmp _ -> true
+    | Il.Ret -> true
+    | _ -> false
+;;
+
+let is_beginning_of_basic_block (q:quad) : bool =
+  match q.Il.quad_fixup with
+      None -> false
+    | Some _ -> true
+;;
+
+let dump_quads cx =
+  let f = cx.ctxt_abi.Abi.abi_str_of_hardreg in
+  let len = (Array.length cx.ctxt_quads) - 1 in
+  let ndigits_of n = (int_of_float (log10 (float_of_int n))) in
+  let padded_num n maxnum =
+    let ndigits = ndigits_of n in
+    let maxdigits = ndigits_of maxnum in
+    let pad = String.make (maxdigits - ndigits) ' ' in
+      Printf.sprintf "%s%d" pad n
+  in
+  let padded_str str maxlen =
+    let pad = String.make (maxlen - (String.length str)) ' ' in
+      Printf.sprintf "%s%s" pad str
+  in
+  let maxlablen = ref 0 in
+  for i = 0 to len
+  do
+    let q = cx.ctxt_quads.(i) in
+    match q.quad_fixup with
+        None -> ()
+      | Some f ->
+          maxlablen := max (!maxlablen) ((String.length f.fixup_name) + 1)
+  done;
+  for i = 0 to len
+  do
+    let q = cx.ctxt_quads.(i) in
+    let qs = (string_of_quad f q) in
+    let lab = match q.quad_fixup with
+        None -> ""
+      | Some f -> f.fixup_name ^ ":"
+    in
+      log cx "[%s] %s %s" (padded_num i len) (padded_str lab (!maxlablen)) qs
+  done
+;;
+
+let calculate_vreg_constraints (cx:ctxt) : Bits.t array =
+  let abi = cx.ctxt_abi in
+  let n_vregs = cx.ctxt_n_vregs in
+  let n_hregs = abi.Abi.abi_n_hardregs in
+  let constraints = Array.init n_vregs (fun _ -> Bits.create n_hregs true) in
+    Array.iteri
+      begin
+        fun i q ->
+          abi.Abi.abi_constrain_vregs q constraints;
+          iflog cx
+            begin
+              fun _ ->
+                let hr_str = cx.ctxt_abi.Abi.abi_str_of_hardreg in
+                  log cx "constraints for quad %d = %s"
+                    i (string_of_quad hr_str q);
+                  let qp_reg _ r =
+                    begin
+                      match r with
+                          Il.Hreg _ -> ()
+                        | Il.Vreg v ->
+                            let hregs = Bits.to_list constraints.(v) in
+                              log cx "<v%d> constrained to hregs: [%s]"
+                                v (list_to_str hregs hr_str)
+                    end;
+                    r
+                  in
+                    ignore (Il.process_quad { Il.identity_processor with
+                                                Il.qp_reg = qp_reg } q)
+            end;
+      end
+      cx.ctxt_quads;
+    constraints
+;;
+
+(* Simple local register allocator. Nothing fancy. *)
+let reg_alloc
+    (sess:Session.sess)
+    (quads:Il.quads)
+    (vregs:int)
+    (abi:Abi.abi) =
+ try
+    let cx = new_ctxt sess quads vregs abi in
+    let _ =
+      iflog cx
+        begin
+          fun _ ->
+            log cx "un-allocated quads:";
+            dump_quads cx
+        end
+    in
+
+    (* Work out pre-spilled slots and allocate 'em. *)
+    let spill_slot (s:Il.spill) = abi.Abi.abi_spill_slot s in
+    let n_pre_spills = convert_pre_spills cx spill_slot in
+
+    let (live_in_vregs, live_out_vregs) =
+      Session.time_inner "RA liveness" sess
+        (fun _ -> calculate_live_bitvectors cx)
+    in
+    let (vreg_constraints:Bits.t array) = (* vreg idx -> hreg bits.t *)
+      calculate_vreg_constraints cx
+    in
+    let inactive_hregs = ref [] in (* [hreg] *)
+    let active_hregs = ref [] in (* [hreg] *)
+    let dirty_vregs = Hashtbl.create 0 in (* vreg -> () *)
+    let hreg_to_vreg = Hashtbl.create 0 in  (* hreg -> vreg *)
+    let vreg_to_hreg = Hashtbl.create 0 in (* vreg -> hreg *)
+    let vreg_to_spill = Hashtbl.create 0 in (* vreg -> spill *)
+    let (word_ty:Il.scalar_ty) = Il.ValTy abi.Abi.abi_word_bits in
+    let vreg_spill_cell v =
+      Il.Mem ((spill_slot (Hashtbl.find vreg_to_spill v)),
+              Il.ScalarTy word_ty)
+    in
+    let newq = ref [] in
+    let fixup = ref None in
+    let prepend q =
+      newq := {q with quad_fixup = !fixup} :: (!newq);
+      fixup := None
+    in
+    let hr h = Il.Reg (Il.Hreg h, Il.voidptr_t) in
+    let hr_str = cx.ctxt_abi.Abi.abi_str_of_hardreg in
+    let clean_hreg i hreg =
+      if (Hashtbl.mem hreg_to_vreg hreg) &&
+        (hreg < cx.ctxt_abi.Abi.abi_n_hardregs)
+      then
+        let vreg = Hashtbl.find hreg_to_vreg hreg in
+          if Hashtbl.mem dirty_vregs vreg
+          then
+            begin
+              Hashtbl.remove dirty_vregs vreg;
+              if (Bits.get (live_out_vregs.(i)) vreg)
+              then
+                let spill_idx =
+                  if Hashtbl.mem vreg_to_spill vreg
+                  then Hashtbl.find vreg_to_spill vreg
+                  else
+                    begin
+                      let s = next_spill cx in
+                        Hashtbl.replace vreg_to_spill vreg s;
+                        s
+                    end
+                in
+                let spill_mem = spill_slot spill_idx in
+                let spill_cell = Il.Mem (spill_mem, Il.ScalarTy word_ty) in
+                  log cx "spilling <%d> from %s to %s"
+                    vreg (hr_str hreg) (string_of_mem hr_str spill_mem);
+                  prepend (Il.mk_quad
+                             (Il.umov spill_cell (Il.Cell (hr hreg))));
+              else ()
+            end
+          else ()
+      else ()
+    in
+
+    let inactivate_hreg hreg =
+      if (Hashtbl.mem hreg_to_vreg hreg) &&
+        (hreg < cx.ctxt_abi.Abi.abi_n_hardregs)
+      then
+        let vreg = Hashtbl.find hreg_to_vreg hreg in
+          Hashtbl.remove vreg_to_hreg vreg;
+          Hashtbl.remove hreg_to_vreg hreg;
+          active_hregs := List.filter (fun x -> x != hreg) (!active_hregs);
+          inactive_hregs := hreg :: (!inactive_hregs);
+      else ()
+    in
+
+    let spill_specific_hreg i hreg =
+      clean_hreg i hreg;
+      inactivate_hreg hreg
+    in
+
+    let rec select_constrained
+        (constraints:Bits.t)
+        (hregs:Il.hreg list)
+        : Il.hreg option =
+      match hregs with
+          [] -> None
+        | h::hs ->
+            if Bits.get constraints h
+            then Some h
+            else select_constrained constraints hs
+    in
+
+    let spill_constrained constrs i =
+      match select_constrained constrs (!active_hregs) with
+          None ->
+            raise (Ra_error ("unable to spill according to constraint"));
+        | Some h ->
+            begin
+              spill_specific_hreg i h;
+              h
+            end
+    in
+
+    let all_hregs = Bits.create abi.Abi.abi_n_hardregs true in
+
+    let spill_all_regs i =
+      while (!active_hregs) != []
+      do
+        let _ = spill_constrained all_hregs i in
+          ()
+      done
+    in
+
+    let reload vreg hreg =
+      if Hashtbl.mem vreg_to_spill vreg
+      then
+        prepend (Il.mk_quad
+                   (Il.umov
+                      (hr hreg)
+                      (Il.Cell (vreg_spill_cell vreg))))
+      else ()
+    in
+
+    let use_vreg def i vreg =
+      if Hashtbl.mem vreg_to_hreg vreg
+      then
+        begin
+          let h = Hashtbl.find vreg_to_hreg vreg in
+          iflog cx (fun _ -> log cx "found cached assignment %s for <v%d>"
+                      (hr_str h) vreg);
+            h
+        end
+      else
+        let hreg =
+          let constrs = vreg_constraints.(vreg) in
+          match select_constrained constrs (!inactive_hregs) with
+              None ->
+                let h = spill_constrained constrs i in
+                  iflog cx
+                    (fun _ -> log cx "selected %s to spill and use for <v%d>"
+                       (hr_str h) vreg);
+                  h
+            | Some h ->
+                iflog cx (fun _ -> log cx "selected inactive %s for <v%d>"
+                            (hr_str h) vreg);
+                h
+        in
+          inactive_hregs :=
+            List.filter (fun x -> x != hreg) (!inactive_hregs);
+          active_hregs := (!active_hregs) @ [hreg];
+          Hashtbl.replace hreg_to_vreg hreg vreg;
+          Hashtbl.replace vreg_to_hreg vreg hreg;
+          if def
+          then ()
+          else
+            reload vreg hreg;
+          hreg
+    in
+    let qp_reg def i _ r =
+      match r with
+          Il.Hreg h -> (spill_specific_hreg i h; r)
+        | Il.Vreg v -> (Il.Hreg (use_vreg def i v))
+    in
+    let qp_cell def i qp c =
+      match c with
+          Il.Reg (r, b) -> Il.Reg (qp_reg def i qp r, b)
+        | Il.Mem  (a, b) ->
+            let qp = { qp with Il.qp_reg = qp_reg false i } in
+              Il.Mem (qp.qp_mem qp a, b)
+    in
+    let qp i = { Il.identity_processor with
+                   Il.qp_cell_read = qp_cell false i;
+                   Il.qp_cell_write = qp_cell true i;
+                   Il.qp_reg = qp_reg false i }
+    in
+      cx.ctxt_next_spill <- n_pre_spills;
+      convert_labels cx;
+      for i = 0 to cx.ctxt_abi.Abi.abi_n_hardregs - 1
+      do
+        inactive_hregs := i :: (!inactive_hregs)
+      done;
+      for i = 0 to (Array.length cx.ctxt_quads) - 1
+      do
+        let quad = cx.ctxt_quads.(i) in
+        let clobbers = cx.ctxt_abi.Abi.abi_clobbers quad in
+        let used = quad_used_vregs quad in
+        let defined = quad_defined_vregs quad in
+          begin
+            if List.exists (fun def -> List.mem def clobbers) defined
+            then raise (Ra_error ("clobber and defined sets overlap"));
+            iflog cx
+              begin
+                fun _ ->
+                  let hr (v:int) : string =
+                    if Hashtbl.mem vreg_to_hreg v
+                    then hr_str (Hashtbl.find vreg_to_hreg v)
+                    else "??"
+                  in
+                  let vr_str (v:int) : string =
+                    Printf.sprintf "v%d=%s" v (hr v)
+                  in
+                  let lstr lab ls fn =
+                    if List.length ls = 0
+                    then ()
+                    else log cx "\t%s: [%s]" lab (list_to_str ls fn)
+                  in
+                    log cx "processing quad %d = %s"
+                      i (string_of_quad hr_str quad);
+                    (lstr "dirt" (htab_keys dirty_vregs) vr_str);
+                    (lstr "clob" clobbers hr_str);
+                    (lstr "in" (Bits.to_list live_in_vregs.(i)) vr_str);
+                    (lstr "out" (Bits.to_list live_out_vregs.(i)) vr_str);
+                    (lstr "use" used vr_str);
+                    (lstr "def" defined vr_str);
+              end;
+            List.iter (clean_hreg i) clobbers;
+            if is_beginning_of_basic_block quad
+            then
+              begin
+                spill_all_regs i;
+                fixup := quad.quad_fixup;
+                prepend (Il.process_quad (qp i) quad)
+              end
+            else
+              begin
+                fixup := quad.quad_fixup;
+                let newq = (Il.process_quad (qp i) quad) in
+                  begin
+                    if is_end_of_basic_block quad
+                    then spill_all_regs i
+                    else ()
+                  end;
+                  prepend newq
+              end
+          end;
+          List.iter inactivate_hreg clobbers;
+          List.iter (fun i -> Hashtbl.replace dirty_vregs i ()) defined;
+      done;
+      cx.ctxt_quads <- Array.of_list (List.rev (!newq));
+      kill_redundant_moves cx;
+
+      iflog cx
+        begin
+          fun _ ->
+            log cx "spills: %d pre-spilled, %d total"
+              n_pre_spills cx.ctxt_next_spill;
+            log cx "register-allocated quads:";
+            dump_quads cx;
+        end;
+      (cx.ctxt_quads, cx.ctxt_next_spill)
+
+  with
+      Ra_error s ->
+        Session.fail sess "RA Error: %s" s;
+        (quads, 0)
+
+;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/driver/lib.ml

@@ -0,0 +1,232 @@
+open Common;;
+
+let log (sess:Session.sess) =
+  Session.log "lib"
+    sess.Session.sess_log_lib
+    sess.Session.sess_log_out
+;;
+
+let iflog (sess:Session.sess) (thunk:(unit -> unit)) : unit =
+  if sess.Session.sess_log_lib
+  then thunk ()
+  else ()
+;;
+
+(* FIXME: move these to sess. *)
+let ar_cache = Hashtbl.create 0 ;;
+let sects_cache = Hashtbl.create 0;;
+let meta_cache = Hashtbl.create 0;;
+let die_cache = Hashtbl.create 0;;
+
+let get_ar
+    (sess:Session.sess)
+    (filename:filename)
+    : Asm.asm_reader option =
+  htab_search_or_add ar_cache filename
+    begin
+      fun _ ->
+        let sniff =
+          match sess.Session.sess_targ with
+              Win32_x86_pe -> Pe.sniff
+            | MacOS_x86_macho -> Macho.sniff
+            | Linux_x86_elf -> Elf.sniff
+        in
+          sniff sess filename
+    end
+;;
+
+
+let get_sects
+    (sess:Session.sess)
+    (filename:filename) :
+    (Asm.asm_reader * ((string,(int*int)) Hashtbl.t)) option =
+  htab_search_or_add sects_cache filename
+    begin
+      fun _ ->
+        match get_ar sess filename with
+            None -> None
+          | Some ar ->
+              let get_sections =
+                match sess.Session.sess_targ with
+                    Win32_x86_pe -> Pe.get_sections
+                  | MacOS_x86_macho -> Macho.get_sections
+                  | Linux_x86_elf -> Elf.get_sections
+              in
+                Some (ar, (get_sections sess ar))
+    end
+;;
+
+let get_meta
+    (sess:Session.sess)
+    (filename:filename)
+    : Ast.meta option =
+  htab_search_or_add meta_cache filename
+    begin
+      fun _ ->
+        match get_sects sess filename with
+            None -> None
+          | Some (ar, sects) ->
+              match htab_search sects ".note.rust" with
+                  Some (off, _) ->
+                    ar.Asm.asm_seek off;
+                    Some (Asm.read_rust_note ar)
+                | None -> None
+    end
+;;
+
+let get_dies_opt
+    (sess:Session.sess)
+    (filename:filename)
+    : (Dwarf.rooted_dies option) =
+  htab_search_or_add die_cache filename
+    begin
+      fun _ ->
+        match get_sects sess filename with
+            None -> None
+          | Some (ar, sects) ->
+              let debug_abbrev = Hashtbl.find sects ".debug_abbrev" in
+              let debug_info = Hashtbl.find sects ".debug_info" in
+              let abbrevs = Dwarf.read_abbrevs sess ar debug_abbrev in
+              let dies = Dwarf.read_dies sess ar debug_info abbrevs in
+                ar.Asm.asm_close ();
+                Hashtbl.remove ar_cache filename;
+                Some dies
+    end
+;;
+
+let get_dies
+    (sess:Session.sess)
+    (filename:filename)
+    : Dwarf.rooted_dies =
+  match get_dies_opt sess filename with
+      None ->
+        Printf.fprintf stderr "Error: bad crate file: %s\n%!" filename;
+        exit 1
+    | Some dies -> dies
+;;
+
+let get_file_mod
+    (sess:Session.sess)
+    (abi:Abi.abi)
+    (filename:filename)
+    (nref:node_id ref)
+    (oref:opaque_id ref)
+    : Ast.mod_items =
+  let dies = get_dies sess filename in
+  let items = Hashtbl.create 0 in
+    Dwarf.extract_mod_items nref oref abi items dies;
+    items
+;;
+
+let get_mod
+    (sess:Session.sess)
+    (abi:Abi.abi)
+    (meta:Ast.meta_pat)
+    (use_id:node_id)
+    (nref:node_id ref)
+    (oref:opaque_id ref)
+    : (filename * Ast.mod_items) =
+  let found = Queue.create () in
+  let suffix =
+    match sess.Session.sess_targ with
+        Win32_x86_pe -> ".dll"
+      | MacOS_x86_macho -> ".dylib"
+      | Linux_x86_elf -> ".so"
+  in
+  let rec meta_matches i f_meta =
+    if i >= (Array.length meta)
+    then true
+    else
+      match meta.(i) with
+          (* FIXME: bind the wildcards. *)
+          (_, None) -> meta_matches (i+1) f_meta
+        | (k, Some v) ->
+            match atab_search f_meta k with
+                None -> false
+              | Some v' ->
+                  if v = v'
+                  then meta_matches (i+1) f_meta
+                  else false
+  in
+  let file_matches file =
+    log sess "searching for metadata in %s" file;
+    match get_meta sess file with
+        None -> false
+      | Some f_meta ->
+          log sess "matching metadata in %s" file;
+          meta_matches 0 f_meta
+  in
+    iflog sess
+      begin
+        fun _ ->
+          log sess "searching for library matching:";
+          Array.iter
+            begin
+              fun (k,vo) ->
+                match vo with
+                    None -> ()
+                  | Some v ->
+                      log sess "%s = %S" k v
+            end
+            meta;
+      end;
+    Queue.iter
+      begin
+        fun dir ->
+          let dh = Unix.opendir dir in
+          let rec scan _ =
+            try
+              let file = Unix.readdir dh in
+                log sess "considering file %s" file;
+                if (Filename.check_suffix file suffix) &&
+                  (file_matches file)
+                then
+                  begin
+                    iflog sess
+                      begin
+                        fun _ ->
+                          log sess "matched against library %s" file;
+                          match get_meta sess file with
+                              None -> ()
+                            | Some meta ->
+                                Array.iter
+                                  (fun (k,v) -> log sess "%s = %S" k v)
+                                  meta;
+                      end;
+                    Queue.add file found;
+                  end;
+                scan()
+            with
+                End_of_file -> ()
+          in
+            scan ()
+      end
+      sess.Session.sess_lib_dirs;
+    match Queue.length found with
+        0 -> Common.err (Some use_id) "unsatisfied 'use' clause"
+      | 1 ->
+          let filename = Queue.pop found in
+          let items = get_file_mod sess abi filename nref oref in
+            (filename, items)
+      | _ -> Common.err (Some use_id) "multiple crates match 'use' clause"
+;;
+
+let infer_lib_name
+    (sess:Session.sess)
+    (ident:filename)
+    : filename =
+  match sess.Session.sess_targ with
+      Win32_x86_pe -> ident ^ ".dll"
+    | MacOS_x86_macho -> "lib" ^ ident ^ ".dylib"
+    | Linux_x86_elf -> "lib" ^ ident ^ ".so"
+;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/driver/llvm/glue.ml

@@ -0,0 +1,37 @@
+(*
+ * Glue for the LLVM backend.
+ *)
+
+let alt_argspecs sess = [
+  ("-llvm", Arg.Unit (fun _ -> sess.Session.sess_alt_backend <- true),
+    "emit LLVM bitcode")
+];;
+
+let alt_pipeline sess sem_cx crate =
+  let process processor =
+    processor sem_cx crate;
+    if sess.Session.sess_failed then exit 1 else ()
+  in
+  Array.iter process
+    [|
+      Resolve.process_crate;
+      Type.process_crate;
+      Effect.process_crate;
+      Typestate.process_crate;
+      Loop.process_crate;
+      Alias.process_crate;
+      Dead.process_crate;
+      Layout.process_crate
+    |];
+  Llemit.trans_and_process_crate sess sem_cx crate
+;;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)
+

src/boot/driver/main.ml

@@ -0,0 +1,421 @@
+
+open Common;;
+
+let _ =
+  Gc.set { (Gc.get()) with
+             Gc.space_overhead = 400; }
+;;
+
+let (targ:Common.target) =
+  match Sys.os_type with
+      "Unix" ->
+        (* FIXME: this is an absurd heuristic. *)
+        if Sys.file_exists "/System/Library"
+        then MacOS_x86_macho
+        else Linux_x86_elf
+    | "Win32" -> Win32_x86_pe
+    | "Cygwin" -> Win32_x86_pe
+    | _ -> Linux_x86_elf
+;;
+
+let (abi:Abi.abi) = X86.abi;;
+
+let (sess:Session.sess) =
+  {
+    Session.sess_in = None;
+    Session.sess_out = None;
+    Session.sess_library_mode = false;
+    Session.sess_alt_backend = false;
+    (* FIXME: need something fancier here for unix sub-flavours. *)
+    Session.sess_targ = targ;
+    Session.sess_log_lex = false;
+    Session.sess_log_parse = false;
+    Session.sess_log_ast = false;
+    Session.sess_log_resolve = false;
+    Session.sess_log_type = false;
+    Session.sess_log_effect = false;
+    Session.sess_log_typestate = false;
+    Session.sess_log_loop = false;
+    Session.sess_log_alias = false;
+    Session.sess_log_dead = false;
+    Session.sess_log_layout = false;
+    Session.sess_log_itype = false;
+    Session.sess_log_trans = false;
+    Session.sess_log_dwarf = false;
+    Session.sess_log_ra = false;
+    Session.sess_log_insn = false;
+    Session.sess_log_asm = false;
+    Session.sess_log_obj = false;
+    Session.sess_log_lib = false;
+    Session.sess_log_out = stdout;
+    Session.sess_trace_block = false;
+    Session.sess_trace_drop = false;
+    Session.sess_trace_tag = false;
+    Session.sess_trace_gc = false;
+    Session.sess_failed = false;
+    Session.sess_spans = Hashtbl.create 0;
+    Session.sess_report_timing = false;
+    Session.sess_report_gc = false;
+    Session.sess_report_deps = false;
+    Session.sess_timings = Hashtbl.create 0;
+    Session.sess_lib_dirs = Queue.create ();
+  }
+;;
+
+let default_output_filename (sess:Session.sess) : filename option =
+  match sess.Session.sess_in with
+      None -> None
+    | Some fname ->
+        let base = Filename.chop_extension (Filename.basename fname) in
+        let out =
+          if sess.Session.sess_library_mode
+          then
+            Lib.infer_lib_name sess base
+          else
+            base ^ (match sess.Session.sess_targ with
+                        Linux_x86_elf -> ""
+                      | MacOS_x86_macho -> ""
+                      | Win32_x86_pe -> ".exe")
+        in
+          Some out
+;;
+
+let set_default_output_filename (sess:Session.sess) : unit =
+  match sess.Session.sess_out with
+      None -> (sess.Session.sess_out <- default_output_filename sess)
+    | _ -> ()
+;;
+
+
+let dump_sig (filename:filename) : unit =
+  let items =
+    Lib.get_file_mod sess abi filename (ref (Node 0)) (ref (Opaque 0)) in
+    Printf.fprintf stdout "%s\n" (Ast.fmt_to_str Ast.fmt_mod_items items);
+    exit 0
+;;
+
+let dump_meta (filename:filename) : unit =
+  begin
+    match Lib.get_meta sess filename with
+        None -> Printf.fprintf stderr "Error: bad crate file: %s\n" filename
+      | Some meta ->
+          Array.iter
+            begin
+              fun (k,v) ->
+                Printf.fprintf stdout "%s = %S\n" k v;
+            end
+            meta
+  end;
+  exit 0
+;;
+
+let flag f opt desc =
+  (opt, Arg.Unit f, desc)
+;;
+
+let argspecs =
+  [
+    ("-t", Arg.Symbol (["linux-x86-elf"; "win32-x86-pe"; "macos-x86-macho"],
+                       fun s -> (sess.Session.sess_targ <-
+                                   (match s with
+                                        "win32-x86-pe" -> Win32_x86_pe
+                                      | "macos-x86-macho" -> MacOS_x86_macho
+                                      | _ -> Linux_x86_elf))),
+     (" target (default: " ^ (match sess.Session.sess_targ with
+                                  Win32_x86_pe -> "win32-x86-pe"
+                                | Linux_x86_elf -> "linux-x86-elf"
+                                | MacOS_x86_macho -> "macos-x86-macho"
+                             ) ^ ")"));
+    ("-o", Arg.String (fun s -> sess.Session.sess_out <- Some s),
+     "file to output (default: "
+     ^ (Session.filename_of sess.Session.sess_out) ^ ")");
+    ("-shared", Arg.Unit (fun _ -> sess.Session.sess_library_mode <- true),
+     "compile a shared-library crate");
+    ("-L", Arg.String (fun s -> Queue.add s sess.Session.sess_lib_dirs),
+     "dir to add to library path");
+    ("-litype", Arg.Unit (fun _ -> sess.Session.sess_log_itype <- true;
+                            Il.log_iltypes := true), "log IL types");
+    (flag (fun _ -> sess.Session.sess_log_lex <- true)
+       "-llex"      "log lexing");
+    (flag (fun _ -> sess.Session.sess_log_parse <- true)
+       "-lparse"    "log parsing");
+    (flag (fun _ -> sess.Session.sess_log_ast <- true)
+       "-last"      "log AST");
+    (flag (fun _ -> sess.Session.sess_log_resolve <- true)
+       "-lresolve"  "log resolution");
+    (flag (fun _ -> sess.Session.sess_log_type <- true)
+       "-ltype"     "log type checking");
+    (flag (fun _ -> sess.Session.sess_log_effect <- true)
+       "-leffect"   "log effect checking");
+    (flag (fun _ -> sess.Session.sess_log_typestate <- true)
+       "-ltypestate" "log typestate pass");
+    (flag (fun _ -> sess.Session.sess_log_loop <- true)
+       "-lloop"      "log loop analysis");
+    (flag (fun _ -> sess.Session.sess_log_alias <- true)
+       "-lalias"      "log alias analysis");
+    (flag (fun _ -> sess.Session.sess_log_dead <- true)
+       "-ldead"       "log dead analysis");
+    (flag (fun _ -> sess.Session.sess_log_layout <- true)
+       "-llayout"     "log frame layout");
+    (flag (fun _ -> sess.Session.sess_log_trans <- true)
+       "-ltrans"      "log IR translation");
+    (flag (fun _ -> sess.Session.sess_log_dwarf <- true)
+       "-ldwarf"      "log DWARF generation");
+    (flag (fun _ -> sess.Session.sess_log_ra <- true)
+       "-lra"         "log register allocation");
+    (flag (fun _ -> sess.Session.sess_log_insn <- true)
+       "-linsn"       "log instruction selection");
+    (flag (fun _ -> sess.Session.sess_log_asm <- true)
+       "-lasm"        "log assembly");
+    (flag (fun _ -> sess.Session.sess_log_obj <- true)
+       "-lobj"        "log object-file generation");
+    (flag (fun _ -> sess.Session.sess_log_lib <- true)
+       "-llib"        "log library search");
+
+    (flag (fun _ -> sess.Session.sess_trace_block <- true)
+       "-tblock"      "emit block-boundary tracing code");
+    (flag (fun _ -> sess.Session.sess_trace_drop <- true)
+       "-tdrop"       "emit slot-drop tracing code");
+    (flag (fun _ -> sess.Session.sess_trace_tag <- true)
+       "-ttag"        "emit tag-construction tracing code");
+    (flag (fun _ -> sess.Session.sess_trace_gc <- true)
+       "-tgc"         "emit GC tracing code");
+
+    ("-tall", Arg.Unit (fun _ ->
+                          sess.Session.sess_trace_block <- true;
+                          sess.Session.sess_trace_drop <- true;
+                          sess.Session.sess_trace_tag <- true ),
+     "emit all tracing code");
+
+    (flag (fun _ -> sess.Session.sess_report_timing <- true)
+       "-rtime"        "report timing of compiler phases");
+    (flag (fun _ -> sess.Session.sess_report_gc <- true)
+       "-rgc"          "report gc behavior of compiler");
+    ("-rsig", Arg.String dump_sig,
+     "report type-signature from DWARF info in compiled file, then exit");
+    ("-rmeta", Arg.String dump_meta,
+     "report metadata from DWARF info in compiled file, then exit");
+    ("-rdeps", Arg.Unit (fun _ -> sess.Session.sess_report_deps <- true),
+     "report dependencies of input, then exit");
+  ] @ (Glue.alt_argspecs sess)
+;;
+
+let exit_if_failed _ =
+  if sess.Session.sess_failed
+  then exit 1
+  else ()
+;;
+
+Arg.parse
+  argspecs
+  (fun arg -> sess.Session.sess_in <- (Some arg))
+  ("usage: " ^ Sys.argv.(0) ^ " [options] (CRATE_FILE.rc|SOURCE_FILE.rs)\n")
+;;
+
+let _ = set_default_output_filename  sess
+;;
+
+let _ =
+  if sess.Session.sess_out = None
+  then (Printf.fprintf stderr "Error: no output file specified\n"; exit 1)
+  else ()
+;;
+
+let _ =
+  if sess.Session.sess_in = None
+  then (Printf.fprintf stderr "Error: empty input filename\n"; exit 1)
+  else ()
+;;
+
+
+let (crate:Ast.crate) =
+  Session.time_inner "parse" sess
+    begin
+      fun _ ->
+        let infile = Session.filename_of sess.Session.sess_in in
+        let crate =
+          if Filename.check_suffix infile ".rc"
+          then
+            Cexp.parse_crate_file sess
+              (Lib.get_mod sess abi)
+              (Lib.infer_lib_name sess)
+          else
+            if Filename.check_suffix infile ".rs"
+            then
+              Cexp.parse_src_file sess
+                (Lib.get_mod sess abi)
+                (Lib.infer_lib_name sess)
+            else
+              begin
+                Printf.fprintf stderr
+                  "Error: unrecognized input file type: %s\n"
+                  infile;
+                exit 1
+              end
+        in
+          if sess.Session.sess_report_deps
+          then
+            let outfile = (Session.filename_of sess.Session.sess_out) in
+            let depfile =
+              match sess.Session.sess_targ with
+                  Linux_x86_elf
+                | MacOS_x86_macho -> outfile ^ ".d"
+                | Win32_x86_pe -> (Filename.chop_extension outfile) ^ ".d"
+            in
+              begin
+                Array.iter
+                  begin
+                    fun out ->
+                      Printf.fprintf stdout "%s: \\\n" out;
+                      Hashtbl.iter
+                        (fun _ file ->
+                           Printf.fprintf stdout "    %s \\\n" file)
+                        crate.node.Ast.crate_files;
+                      Printf.fprintf stdout "\n"
+                  end
+                  [| outfile; depfile|];
+                exit 0
+              end
+          else
+            crate
+    end
+;;
+
+exit_if_failed ()
+;;
+
+if sess.Session.sess_log_ast
+then
+  begin
+    Printf.fprintf stdout "Post-parse AST:\n";
+    Format.set_margin 80;
+    Printf.fprintf stdout "%s\n" (Ast.fmt_to_str Ast.fmt_crate crate)
+  end
+
+let list_to_seq ls = Asm.SEQ (Array.of_list ls);;
+let select_insns (quads:Il.quads) : Asm.frag =
+  Session.time_inner "insn" sess
+    (fun _ -> X86.select_insns sess quads)
+;;
+
+
+(* Semantic passes. *)
+let sem_cx = Semant.new_ctxt sess abi crate.node
+;;
+
+
+let main_pipeline _ =
+  let _ =
+    Array.iter
+      (fun proc ->
+         proc sem_cx crate;
+         exit_if_failed ())
+      [| Resolve.process_crate;
+         Type.process_crate;
+         Effect.process_crate;
+         Typestate.process_crate;
+         Loop.process_crate;
+         Alias.process_crate;
+         Dead.process_crate;
+         Layout.process_crate;
+         Trans.process_crate |]
+  in
+
+  (* Tying up various knots, allocating registers and selecting
+   * instructions.
+   *)
+  let process_code _ (code:Semant.code) : Asm.frag =
+    let frag =
+      match code.Semant.code_vregs_and_spill with
+          None -> select_insns code.Semant.code_quads
+        | Some (n_vregs, spill_fix) ->
+            let (quads', n_spills) =
+              (Session.time_inner "RA" sess
+                 (fun _ ->
+                    Ra.reg_alloc sess
+                      code.Semant.code_quads
+                      n_vregs abi))
+            in
+            let insns = select_insns quads' in
+              begin
+                spill_fix.fixup_mem_sz <-
+                  Some (Int64.mul
+                          (Int64.of_int n_spills)
+                          abi.Abi.abi_word_sz);
+                insns
+              end
+    in
+      Asm.ALIGN_FILE (Abi.general_code_alignment,
+                      Asm.DEF (code.Semant.code_fixup, frag))
+  in
+
+  let (file_frags:Asm.frag) =
+    let process_file file_id frag_code =
+      let file_fix = Hashtbl.find sem_cx.Semant.ctxt_file_fixups file_id in
+        Asm.DEF (file_fix,
+                 list_to_seq (reduce_hash_to_list process_code frag_code))
+    in
+      list_to_seq (reduce_hash_to_list
+                     process_file sem_cx.Semant.ctxt_file_code)
+  in
+
+    exit_if_failed ();
+    let (glue_frags:Asm.frag) =
+      list_to_seq (reduce_hash_to_list
+                     process_code sem_cx.Semant.ctxt_glue_code)
+    in
+
+      exit_if_failed ();
+      let code = Asm.SEQ [| file_frags; glue_frags |] in
+      let data = list_to_seq (reduce_hash_to_list
+                                (fun _ (_, i) -> i) sem_cx.Semant.ctxt_data)
+      in
+      (* Emitting Dwarf and PE/ELF/Macho. *)
+      let (dwarf:Dwarf.debug_records) =
+        Session.time_inner "dwarf" sess
+          (fun _ -> Dwarf.process_crate sem_cx crate)
+      in
+
+        exit_if_failed ();
+        let emitter =
+          match sess.Session.sess_targ with
+              Win32_x86_pe -> Pe.emit_file
+            | MacOS_x86_macho -> Macho.emit_file
+            | Linux_x86_elf -> Elf.emit_file
+        in
+          Session.time_inner "emit" sess
+            (fun _ -> emitter sess crate code data sem_cx dwarf);
+          exit_if_failed ()
+;;
+
+if sess.Session.sess_alt_backend
+then Glue.alt_pipeline sess sem_cx crate
+else main_pipeline ()
+;;
+
+if sess.Session.sess_report_timing
+then
+  begin
+    Printf.fprintf stdout "timing:\n\n";
+    Array.iter
+      begin
+        fun name ->
+          Printf.fprintf stdout "%20s: %f\n" name
+            (Hashtbl.find sess.Session.sess_timings name)
+      end
+      (sorted_htab_keys sess.Session.sess_timings)
+  end;
+;;
+
+if sess.Session.sess_report_gc
+then Gc.print_stat stdout;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/driver/session.ml

@@ -0,0 +1,111 @@
+(*
+ * This module goes near the bottom of the dependency DAG, and holds option,
+ * and global-state machinery for a single run of the compiler.
+ *)
+
+open Common;;
+
+type sess =
+{
+  mutable sess_in: filename option;
+  mutable sess_out: filename option;
+  mutable sess_library_mode: bool;
+  mutable sess_alt_backend: bool;
+  mutable sess_targ: target;
+  mutable sess_log_lex: bool;
+  mutable sess_log_parse: bool;
+  mutable sess_log_ast: bool;
+  mutable sess_log_resolve: bool;
+  mutable sess_log_type: bool;
+  mutable sess_log_effect: bool;
+  mutable sess_log_typestate: bool;
+  mutable sess_log_dead: bool;
+  mutable sess_log_loop: bool;
+  mutable sess_log_alias: bool;
+  mutable sess_log_layout: bool;
+  mutable sess_log_trans: bool;
+  mutable sess_log_itype: bool;
+  mutable sess_log_dwarf: bool;
+  mutable sess_log_ra: bool;
+  mutable sess_log_insn: bool;
+  mutable sess_log_asm: bool;
+  mutable sess_log_obj: bool;
+  mutable sess_log_lib: bool;
+  mutable sess_log_out: out_channel;
+  mutable sess_trace_block: bool;
+  mutable sess_trace_drop: bool;
+  mutable sess_trace_tag: bool;
+  mutable sess_trace_gc: bool;
+  mutable sess_failed: bool;
+  mutable sess_report_timing: bool;
+  mutable sess_report_gc: bool;
+  mutable sess_report_deps: bool;
+  sess_timings: (string, float) Hashtbl.t;
+  sess_spans: (node_id,span) Hashtbl.t;
+  sess_lib_dirs: filename Queue.t;
+}
+;;
+
+let add_time sess name amt =
+  let existing =
+    if Hashtbl.mem sess.sess_timings name
+    then Hashtbl.find sess.sess_timings name
+    else 0.0
+  in
+    (Hashtbl.replace sess.sess_timings name (existing +. amt))
+;;
+
+let time_inner name sess thunk =
+  let t0 = Unix.gettimeofday() in
+  let x = thunk() in
+  let t1 = Unix.gettimeofday() in
+    add_time sess name (t1 -. t0);
+    x
+;;
+
+let get_span sess id =
+  if Hashtbl.mem sess.sess_spans id
+  then (Some (Hashtbl.find sess.sess_spans id))
+  else None
+;;
+
+let log name flag chan =
+  let k1 s =
+    Printf.fprintf chan "%s: %s\n%!" name s
+  in
+  let k2 _ = () in
+    Printf.ksprintf (if flag then k1 else k2)
+;;
+
+let fail sess =
+  sess.sess_failed <- true;
+  Printf.fprintf sess.sess_log_out
+;;
+
+
+let string_of_pos (p:pos) =
+  let (filename, line, col) = p in
+  Printf.sprintf "%s:%d:%d" filename line col
+;;
+
+
+let string_of_span (s:span) =
+    let (filename, line0, col0) = s.lo in
+    let (_, line1, col1) = s.hi in
+    Printf.sprintf "%s:%d:%d - %d:%d" filename line0 col0 line1 col1
+;;
+
+let filename_of (fo:filename option) : filename =
+  match fo with
+      None -> "<none>"
+    | Some f -> f
+;;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/driver/x86/glue.ml

@@ -0,0 +1,16 @@
+(*
+ * Glue, or lack thereof, for the standard x86 backend.
+ *)
+
+let alt_argspecs _ = [];;
+let alt_pipeline _ _ _ = ();;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)
+

src/boot/fe/cexp.ml

@@ -0,0 +1,762 @@
+
+open Common;;
+open Token;;
+open Parser;;
+
+(* NB: cexps (crate-expressions / constant-expressions) are only used
+ * transiently during compilation: they are the outermost expression-language
+ * describing crate configuration and constants. They are completely evaluated
+ * at compile-time, in a little micro-interpreter defined here, with the
+ * results of evaluation being the sequence of directives controlling the rest
+ * of the compiler.
+ * 
+ * Cexps, like pexps, do not escape the language front-end.
+ * 
+ * You can think of the AST as a statement-language called "item" sandwiched
+ * between two expression-languages, "cexp" on the outside and "pexp" on the
+ * inside. The front-end evaluates cexp on the outside in order to get one big
+ * directive-list, evaluating those parts of pexp that are directly used by
+ * cexp in passing, and desugaring those remaining parts of pexp that are
+ * embedded within the items of the directives.
+ * 
+ * The rest of the compiler only deals with the directives, which are mostly
+ * just a set of containers for items. Items are what most of AST describes
+ * ("most" because the type-grammar spans both items and pexps).
+ * 
+ *)
+
+type meta = (Ast.ident * Pexp.pexp) array;;
+
+type meta_pat = (Ast.ident * (Pexp.pexp option)) array;;
+
+type auth = (Ast.name * Ast.effect);;
+
+type cexp =
+    CEXP_alt of cexp_alt identified
+  | CEXP_let of cexp_let identified
+  | CEXP_src_mod of cexp_src identified
+  | CEXP_dir_mod of cexp_dir identified
+  | CEXP_use_mod of cexp_use identified
+  | CEXP_nat_mod of cexp_nat identified
+  | CEXP_meta of meta identified
+  | CEXP_auth of auth identified
+
+and cexp_alt =
+    { alt_val: Pexp.pexp;
+      alt_arms: (Pexp.pexp * cexp array) array;
+      alt_else: cexp array }
+
+and cexp_let =
+    { let_ident: Ast.ident;
+      let_value: Pexp.pexp;
+      let_body: cexp array; }
+
+and cexp_src =
+    { src_ident: Ast.ident;
+      src_path: Pexp.pexp option }
+
+and cexp_dir =
+    { dir_ident: Ast.ident;
+      dir_path: Pexp.pexp option;
+      dir_body: cexp array }
+
+and cexp_use =
+    { use_ident: Ast.ident;
+      use_meta: meta_pat; }
+
+and cexp_nat =
+    { nat_abi: string;
+      nat_ident: Ast.ident;
+      nat_path: Pexp.pexp option;
+      (* 
+       * FIXME: possibly support embedding optional strings as
+       * symbol-names, to handle mangling schemes that aren't
+       * Token.IDENT values
+       *)
+      nat_items: Ast.mod_items;
+    }
+;;
+
+
+(* Cexp grammar. *)
+
+let parse_meta_input (ps:pstate) : (Ast.ident * Pexp.pexp option) =
+  let lab = (ctxt "meta input: label" Pexp.parse_ident ps) in
+    match peek ps with
+        EQ ->
+          bump ps;
+          let v =
+            match peek ps with
+                UNDERSCORE -> bump ps; None
+              | _ -> Some (Pexp.parse_pexp ps)
+          in
+            (lab, v)
+      | _ -> raise (unexpected ps)
+;;
+
+let parse_meta_pat (ps:pstate) : meta_pat =
+  bracketed_zero_or_more LPAREN RPAREN
+    (Some COMMA) parse_meta_input ps
+;;
+
+let parse_meta (ps:pstate) : meta =
+  Array.map
+    begin
+      fun (id,v) ->
+        match v with
+            None ->
+              raise (err ("wildcard found in meta pattern "
+                          ^ "where value expected") ps)
+          | Some v -> (id,v)
+    end
+    (parse_meta_pat ps)
+;;
+
+let parse_optional_meta_pat
+    (ps:pstate)
+    (ident:Ast.ident)
+    : meta_pat =
+  match peek ps with
+      LPAREN -> parse_meta_pat ps
+    | _ ->
+        let apos = lexpos ps in
+          [| ("name", Some (span ps apos apos (Pexp.PEXP_str ident))) |]
+;;
+
+let rec parse_cexps (ps:pstate) (term:Token.token) : cexp array =
+  let cexps = Queue.create () in
+    while ((peek ps) <> term)
+    do
+      Queue.push (parse_cexp ps) cexps
+    done;
+    expect ps term;
+    queue_to_arr cexps
+
+and parse_cexp (ps:pstate) : cexp =
+
+  let apos = lexpos ps in
+    match peek ps with
+        MOD ->
+          begin
+            bump ps;
+            let name = ctxt "mod: name" Pexp.parse_ident ps in
+            let path = ctxt "mod: path" parse_eq_pexp_opt ps
+            in
+              match peek ps with
+                  SEMI ->
+                    bump ps;
+                    let bpos = lexpos ps in
+                      CEXP_src_mod
+                        (span ps apos bpos { src_ident = name;
+                                             src_path = path })
+                | LBRACE ->
+                    let body =
+                      bracketed_zero_or_more LBRACE RBRACE
+                        None parse_cexp ps
+                    in
+                    let bpos = lexpos ps in
+                      CEXP_dir_mod
+                        (span ps apos bpos { dir_ident = name;
+                                             dir_path = path;
+                                             dir_body = body })
+                | _ -> raise (unexpected ps)
+        end
+
+      | NATIVE ->
+          begin
+            bump ps;
+            let abi =
+                match peek ps with
+                    MOD -> "cdecl"
+                  | LIT_STR s -> bump ps; s
+                  | _ -> raise (unexpected ps)
+            in
+            let _ = expect ps MOD in
+            let name = ctxt "native mod: name" Pexp.parse_ident ps in
+            let path = ctxt "native mod: path" parse_eq_pexp_opt ps in
+            let items = Hashtbl.create 0 in
+            let get_item ps =
+              let (ident, item) = Item.parse_mod_item_from_signature ps in
+                htab_put items ident item;
+            in
+              ignore (bracketed_zero_or_more
+                        LBRACE RBRACE None get_item ps);
+              let bpos = lexpos ps in
+                CEXP_nat_mod
+                  (span ps apos bpos { nat_abi = abi;
+                                       nat_ident = name;
+                                       nat_path = path;
+                                       nat_items = items })
+          end
+
+      | USE ->
+          begin
+            bump ps;
+            let ident = ctxt "use mod: name" Pexp.parse_ident ps in
+            let meta =
+              ctxt "use mod: meta" parse_optional_meta_pat ps ident
+            in
+            let bpos = lexpos ps in
+              expect ps SEMI;
+              CEXP_use_mod
+                (span ps apos bpos { use_ident = ident;
+                                     use_meta = meta })
+          end
+
+      | LET ->
+          begin
+            bump ps;
+            expect ps LPAREN;
+            let id = Pexp.parse_ident ps in
+              expect ps EQ;
+              let v = Pexp.parse_pexp ps in
+                expect ps RPAREN;
+                expect ps LBRACE;
+                let body = parse_cexps ps RBRACE in
+                let bpos = lexpos ps in
+                  CEXP_let
+                    (span ps apos bpos
+                       { let_ident = id;
+                         let_value = v;
+                         let_body = body })
+          end
+
+      | ALT ->
+          begin
+            bump ps;
+            expect ps LPAREN;
+            let v = Pexp.parse_pexp ps in
+              expect ps RPAREN;
+              expect ps LBRACE;
+              let rec consume_arms arms =
+                match peek ps with
+                    CASE ->
+                      begin
+                        bump ps;
+                        expect ps LPAREN;
+                        let cond = Pexp.parse_pexp ps in
+                          expect ps RPAREN;
+                          expect ps LBRACE;
+                          let consequent = parse_cexps ps RBRACE in
+                            let arm = (cond, consequent) in
+                            consume_arms (arm::arms)
+                      end
+                  | ELSE ->
+                      begin
+                        bump ps;
+                        expect ps LBRACE;
+                        let consequent = parse_cexps ps RBRACE in
+                          expect ps RBRACE;
+                          let bpos = lexpos ps in
+                            span ps apos bpos
+                              { alt_val = v;
+                                alt_arms = Array.of_list (List.rev arms);
+                                alt_else = consequent }
+                      end
+
+                  | _ -> raise (unexpected ps)
+              in
+                CEXP_alt (consume_arms [])
+          end
+
+      | META ->
+          bump ps;
+          let meta = parse_meta ps in
+            expect ps SEMI;
+            let bpos = lexpos ps in
+              CEXP_meta (span ps apos bpos meta)
+
+      | AUTH ->
+          bump ps;
+          let name = Pexp.parse_name ps in
+            expect ps EQ;
+            let effect = Pexp.parse_effect ps in
+              expect ps SEMI;
+              let bpos = lexpos ps in
+                CEXP_auth (span ps apos bpos (name, effect))
+
+      | _ -> raise (unexpected ps)
+
+
+and  parse_eq_pexp_opt (ps:pstate) : Pexp.pexp option =
+  match peek ps with
+      EQ ->
+        begin
+          bump ps;
+          Some (Pexp.parse_pexp ps)
+        end
+    | _ -> None
+;;
+
+
+(*
+ * Dynamic-typed micro-interpreter for the cexp language.
+ * 
+ * The product of evaluating a pexp is a pval.
+ * 
+ * The product of evlauating a cexp is a cdir array.
+ *)
+
+type pval =
+    PVAL_str of string
+  | PVAL_num of int64
+  | PVAL_bool of bool
+;;
+
+type cdir =
+    CDIR_meta of ((Ast.ident * string) array)
+  | CDIR_syntax of Ast.name
+  | CDIR_check of (Ast.name * pval array)
+  | CDIR_mod of (Ast.ident * Ast.mod_item)
+  | CDIR_auth of auth
+
+type env = { env_bindings: (Ast.ident * pval) list;
+             env_prefix: filename list;
+             env_items: (filename, Ast.mod_items) Hashtbl.t;
+             env_files: (node_id,filename) Hashtbl.t;
+             env_required: (node_id, (required_lib * nabi_conv)) Hashtbl.t;
+             env_required_syms: (node_id, string) Hashtbl.t;
+             env_ps: pstate; }
+
+let unexpected_val (expected:string) (v:pval)  =
+  let got =
+    match v with
+        PVAL_str s -> "str \"" ^ (String.escaped s) ^ "\""
+      | PVAL_num i -> "num " ^ (Int64.to_string i)
+      | PVAL_bool b -> if b then "bool true" else "bool false"
+  in
+    (* FIXME: proper error reporting, please. *)
+    bug () "expected %s, got %s" expected got
+;;
+
+let rewrap_items id items =
+  let item = decl [||] (Ast.MOD_ITEM_mod items) in
+    { id = id; node = item }
+;;
+
+
+let rec eval_cexps (env:env) (exps:cexp array) : cdir array =
+  Parser.arj (Array.map (eval_cexp env) exps)
+
+and eval_cexp (env:env) (exp:cexp) : cdir array =
+  match exp with
+      CEXP_alt {node=ca} ->
+        let v = eval_pexp env ca.alt_val in
+        let rec try_arm i =
+          if i >= Array.length ca.alt_arms
+          then ca.alt_else
+          else
+            let (arm_head, arm_body) = ca.alt_arms.(i) in
+            let v' = eval_pexp env arm_head in
+              if v' = v
+              then arm_body
+              else try_arm (i+1)
+        in
+          eval_cexps env (try_arm 0)
+
+    | CEXP_let {node=cl} ->
+        let ident = cl.let_ident in
+        let v = eval_pexp env cl.let_value in
+        let env = { env with
+                      env_bindings = ((ident,v)::env.env_bindings ) }
+        in
+          eval_cexps env cl.let_body
+
+    | CEXP_src_mod {node=s; id=id} ->
+        let name = s.src_ident in
+        let path =
+          match s.src_path with
+              None -> name ^ ".rs"
+            | Some p -> eval_pexp_to_str env p
+        in
+        let full_path =
+          List.fold_left Filename.concat ""
+            (List.rev (path :: env.env_prefix))
+        in
+        let ps = env.env_ps in
+        let p =
+          make_parser
+            ps.pstate_temp_id
+            ps.pstate_node_id
+            ps.pstate_opaque_id
+            ps.pstate_sess
+            ps.pstate_get_mod
+            ps.pstate_infer_lib_name
+            env.env_required
+            env.env_required_syms
+            full_path
+        in
+        let items = Item.parse_mod_items p EOF in
+          htab_put env.env_files id full_path;
+          [| CDIR_mod (name, rewrap_items id items) |]
+
+    | CEXP_dir_mod {node=d; id=id} ->
+        let items = Hashtbl.create 0 in
+        let name = d.dir_ident in
+        let path =
+          match d.dir_path with
+              None -> name
+            | Some p -> eval_pexp_to_str env p
+        in
+        let env = { env with
+                      env_prefix = path :: env.env_prefix } in
+        let sub_directives = eval_cexps env d.dir_body in
+        let add d =
+          match d with
+              CDIR_mod (name, item) ->
+                htab_put items name item
+            | _ -> raise (err "non-'mod' directive found in 'dir' directive"
+                            env.env_ps)
+        in
+          Array.iter add sub_directives;
+          [| CDIR_mod (name, rewrap_items id (Item.empty_view, items)) |]
+
+    | CEXP_use_mod {node=u; id=id} ->
+        let ps = env.env_ps in
+        let name = u.use_ident in
+        let (path, items) =
+          let meta_pat =
+            Array.map
+              begin
+                fun (k,vo) ->
+                  match vo with
+                      None -> (k, None)
+                    | Some p -> (k, Some (eval_pexp_to_str env p))
+              end
+              u.use_meta
+          in
+          ps.pstate_get_mod meta_pat id ps.pstate_node_id ps.pstate_opaque_id
+        in
+          iflog ps
+            begin
+              fun _ ->
+                log ps "extracted mod signature from %s (binding to %s)"
+                  path name;
+                log ps "%a" Ast.sprintf_mod_items items;
+            end;
+          let rlib = REQUIRED_LIB_rust { required_libname = path;
+                                         required_prefix = 1 }
+          in
+          let item = decl [||] (Ast.MOD_ITEM_mod (Item.empty_view, items)) in
+          let item = { id = id; node = item } in
+          let span = Hashtbl.find ps.pstate_sess.Session.sess_spans id in
+            Item.note_required_mod env.env_ps span CONV_rust rlib item;
+            [| CDIR_mod (name, item) |]
+
+    | CEXP_nat_mod {node=cn;id=id} ->
+        let conv =
+          let v = cn.nat_abi in
+          match string_to_conv v with
+              None -> unexpected_val "calling convention" (PVAL_str v)
+            | Some c -> c
+        in
+        let name = cn.nat_ident in
+        let filename =
+          match cn.nat_path with
+              None -> env.env_ps.pstate_infer_lib_name name
+            | Some p -> eval_pexp_to_str env p
+        in
+        let item =
+          decl [||] (Ast.MOD_ITEM_mod (Item.empty_view, cn.nat_items))
+        in
+        let item = { id = id; node = item } in
+        let rlib = REQUIRED_LIB_c { required_libname = filename;
+                                    required_prefix = 1 }
+        in
+        let ps = env.env_ps in
+        let span = Hashtbl.find ps.pstate_sess.Session.sess_spans id in
+          Item.note_required_mod env.env_ps span conv rlib item;
+          [| CDIR_mod (name, item) |]
+
+    | CEXP_meta m ->
+        [| CDIR_meta
+             begin
+               Array.map
+                 begin
+                   fun (id, p) -> (id, eval_pexp_to_str env p)
+                 end
+                 m.node
+             end |]
+
+    | CEXP_auth a -> [| CDIR_auth a.node |]
+
+
+and eval_pexp (env:env) (exp:Pexp.pexp) : pval =
+  match exp.node with
+    | Pexp.PEXP_binop (bop, a, b) ->
+        begin
+          let av = eval_pexp env a in
+          let bv = eval_pexp env b in
+            match (bop, av, bv) with
+                (Ast.BINOP_add, PVAL_str az, PVAL_str bz) ->
+                  PVAL_str (az ^ bz)
+              | _ ->
+                  let av = (need_num av) in
+                  let bv = (need_num bv) in
+                    PVAL_num
+                      begin
+                        match bop with
+                            Ast.BINOP_add -> Int64.add av bv
+                          | Ast.BINOP_sub -> Int64.sub av bv
+                          | Ast.BINOP_mul -> Int64.mul av bv
+                          | Ast.BINOP_div -> Int64.div av bv
+                          | _ ->
+                              bug ()
+                                "unhandled arithmetic op in Cexp.eval_pexp"
+                      end
+        end
+
+    | Pexp.PEXP_unop (uop, a) ->
+        begin
+          match uop with
+              Ast.UNOP_not ->
+                PVAL_bool (not (eval_pexp_to_bool env a))
+            | Ast.UNOP_neg ->
+                PVAL_num (Int64.neg (eval_pexp_to_num env a))
+            | _ -> bug () "Unexpected unop in Cexp.eval_pexp"
+        end
+
+    | Pexp.PEXP_lval (Pexp.PLVAL_ident ident) ->
+        begin
+          match ltab_search env.env_bindings ident with
+              None -> raise (err (Printf.sprintf "no binding for '%s' found"
+                                    ident) env.env_ps)
+            | Some v -> v
+        end
+
+    | Pexp.PEXP_lit (Ast.LIT_bool b) ->
+        PVAL_bool b
+
+    | Pexp.PEXP_lit (Ast.LIT_int (i, _)) ->
+        PVAL_num i
+
+    | Pexp.PEXP_str s ->
+        PVAL_str s
+
+    | _ -> bug () "unexpected Pexp in Cexp.eval_pexp"
+
+
+and eval_pexp_to_str (env:env) (exp:Pexp.pexp) : string =
+  match eval_pexp env exp with
+      PVAL_str s -> s
+    | v -> unexpected_val "str" v
+
+and need_num (cv:pval) : int64 =
+  match cv with
+      PVAL_num n -> n
+    | v -> unexpected_val "num" v
+
+and eval_pexp_to_num (env:env) (exp:Pexp.pexp) : int64 =
+  need_num (eval_pexp env exp)
+
+and eval_pexp_to_bool (env:env) (exp:Pexp.pexp) : bool =
+  match eval_pexp env exp with
+      PVAL_bool b -> b
+    | v -> unexpected_val "bool" v
+
+;;
+
+
+let find_main_fn
+    (ps:pstate)
+    (crate_items:Ast.mod_items)
+    : Ast.name =
+  let fns = ref [] in
+  let extend prefix_name ident =
+    match prefix_name with
+        None -> Ast.NAME_base (Ast.BASE_ident ident)
+      | Some n -> Ast.NAME_ext (n, Ast.COMP_ident ident)
+  in
+  let rec dig prefix_name items =
+    Hashtbl.iter (extract_fn prefix_name) items
+  and extract_fn prefix_name ident item =
+    if not (Array.length item.node.Ast.decl_params = 0) ||
+      Hashtbl.mem ps.pstate_required item.id
+    then ()
+    else
+      match item.node.Ast.decl_item with
+          Ast.MOD_ITEM_mod (_, items) ->
+            dig (Some (extend prefix_name ident)) items
+
+       | Ast.MOD_ITEM_fn _ ->
+            if ident = "main"
+            then fns := (extend prefix_name ident) :: (!fns)
+            else ()
+
+        | _ -> ()
+  in
+    dig None crate_items;
+    match !fns with
+        [] -> raise (err "no 'main' function found" ps)
+      | [x] -> x
+      | _ -> raise (err "multiple 'main' functions found" ps)
+;;
+
+
+let with_err_handling sess thunk =
+  try
+    thunk ()
+  with
+      Parse_err (ps, str) ->
+        Session.fail sess "Parse error: %s\n%!" str;
+        List.iter
+          (fun (cx,pos) ->
+             Session.fail sess "%s:E (parse context): %s\n%!"
+               (Session.string_of_pos pos) cx)
+          ps.pstate_ctxt;
+        let apos = lexpos ps in
+          span ps apos apos
+            { Ast.crate_items = (Item.empty_view, Hashtbl.create 0);
+              Ast.crate_meta = [||];
+              Ast.crate_auth = Hashtbl.create 0;
+              Ast.crate_required = Hashtbl.create 0;
+              Ast.crate_required_syms = Hashtbl.create 0;
+              Ast.crate_main = None;
+              Ast.crate_files = Hashtbl.create 0 }
+;;
+
+
+let parse_crate_file
+    (sess:Session.sess)
+    (get_mod:get_mod_fn)
+    (infer_lib_name:(Ast.ident -> filename))
+    : Ast.crate =
+  let fname = Session.filename_of sess.Session.sess_in in
+  let tref = ref (Temp 0) in
+  let nref = ref (Node 0) in
+  let oref = ref (Opaque 0) in
+  let required = Hashtbl.create 4 in
+  let required_syms = Hashtbl.create 4 in
+  let ps =
+    make_parser tref nref oref sess get_mod
+      infer_lib_name required required_syms fname
+  in
+
+  let files = Hashtbl.create 0 in
+  let items = Hashtbl.create 4 in
+  let target_bindings =
+    let (os, arch, libc) =
+      match sess.Session.sess_targ with
+          Linux_x86_elf -> ("linux", "x86", "libc.so.6")
+        | Win32_x86_pe -> ("win32", "x86", "msvcrt.dll")
+        | MacOS_x86_macho -> ("macos", "x86", "libc.dylib")
+    in
+      [
+        ("target_os", PVAL_str os);
+        ("target_arch", PVAL_str arch);
+        ("target_libc", PVAL_str libc)
+      ]
+  in
+  let build_bindings =
+    [
+      ("build_compiler", PVAL_str Sys.executable_name);
+      ("build_input", PVAL_str fname);
+    ]
+  in
+  let initial_bindings =
+    target_bindings
+    @ build_bindings
+  in
+  let env = { env_bindings = initial_bindings;
+              env_prefix = [Filename.dirname fname];
+              env_items = Hashtbl.create 0;
+              env_files = files;
+              env_required = required;
+              env_required_syms = required_syms;
+              env_ps = ps; }
+  in
+  let auth = Hashtbl.create 0 in
+    with_err_handling sess
+      begin
+        fun _ ->
+          let apos = lexpos ps in
+          let cexps = parse_cexps ps EOF in
+          let cdirs = eval_cexps env cexps in
+          let meta = Queue.create () in
+          let _ =
+            Array.iter
+              begin
+                fun d ->
+                  match d with
+                      CDIR_mod (name, item) -> htab_put items name item
+                    | CDIR_meta metas ->
+                        Array.iter (fun m -> Queue.add m meta) metas
+                    | CDIR_auth (n,e) ->
+                        if Hashtbl.mem auth n
+                        then raise (err "duplicate 'auth' clause" ps)
+                        else Hashtbl.add auth n e
+                    | _ ->
+                        raise
+                          (err "unhandled directive at top level" ps)
+              end
+              cdirs
+          in
+          let bpos = lexpos ps in
+          let main =
+            if ps.pstate_sess.Session.sess_library_mode
+            then None
+            else Some (find_main_fn ps items) in
+          let crate = { Ast.crate_items = (Item.empty_view, items);
+                        Ast.crate_meta = queue_to_arr meta;
+                        Ast.crate_auth = auth;
+                        Ast.crate_required = required;
+                        Ast.crate_required_syms = required_syms;
+                        Ast.crate_main = main;
+                        Ast.crate_files = files }
+          in
+          let cratei = span ps apos bpos crate in
+            htab_put files cratei.id fname;
+            cratei
+      end
+;;
+
+let parse_src_file
+    (sess:Session.sess)
+    (get_mod:get_mod_fn)
+    (infer_lib_name:(Ast.ident -> filename))
+    : Ast.crate =
+  let fname = Session.filename_of sess.Session.sess_in in
+  let tref = ref (Temp 0) in
+  let nref = ref (Node 0) in
+  let oref = ref (Opaque 0) in
+  let required = Hashtbl.create 0 in
+  let required_syms = Hashtbl.create 0 in
+  let ps =
+    make_parser tref nref oref sess get_mod
+      infer_lib_name required required_syms fname
+  in
+    with_err_handling sess
+      begin
+        fun _ ->
+          let apos = lexpos ps in
+          let items = Item.parse_mod_items ps EOF in
+          let bpos = lexpos ps in
+          let files = Hashtbl.create 0 in
+          let main =
+            if ps.pstate_sess.Session.sess_library_mode
+            then None
+            else Some (find_main_fn ps (snd items))
+          in
+          let crate = { Ast.crate_items = items;
+                        Ast.crate_required = required;
+                        Ast.crate_required_syms = required_syms;
+                        Ast.crate_auth = Hashtbl.create 0;
+                        Ast.crate_meta = [||];
+                        Ast.crate_main = main;
+                        Ast.crate_files = files }
+          in
+          let cratei = span ps apos bpos crate in
+            htab_put files cratei.id fname;
+            cratei
+      end
+;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/fe/lexer.mll

@@ -0,0 +1,362 @@
+
+
+{
+
+  open Token;;
+  open Common;;
+
+  exception Lex_err of (string * Common.pos);;
+
+  let fail lexbuf s =
+    let p = lexbuf.Lexing.lex_start_p in
+    let pos =
+      (p.Lexing.pos_fname,
+       p.Lexing.pos_lnum ,
+       (p.Lexing.pos_cnum) - (p.Lexing.pos_bol))
+    in
+      raise (Lex_err (s, pos))
+  ;;
+
+  let bump_line p = { p with
+              Lexing.pos_lnum = p.Lexing.pos_lnum + 1;
+              Lexing.pos_bol = p.Lexing.pos_cnum }
+  ;;
+
+  let keyword_table = Hashtbl.create 100
+  let _ =
+    List.iter (fun (kwd, tok) -> Common.htab_put keyword_table kwd tok)
+              [ ("mod", MOD);
+                ("use", USE);
+                ("meta", META);
+                ("auth", AUTH);
+
+                ("syntax", SYNTAX);
+
+                ("if", IF);
+                ("else", ELSE);
+                ("while", WHILE);
+                ("do", DO);
+                ("alt", ALT);
+                ("case", CASE);
+
+                ("for", FOR);
+                ("each", EACH);
+                ("put", PUT);
+                ("ret", RET);
+                ("be", BE);
+
+                ("fail", FAIL);
+                ("drop", DROP);
+
+                ("type", TYPE);
+                ("check", CHECK);
+                ("claim", CLAIM);
+                ("prove", PROVE);
+
+                ("io", IO);
+                ("state", STATE);
+                ("unsafe", UNSAFE);
+
+                ("native", NATIVE);
+                ("mutable", MUTABLE);
+                ("auto", AUTO);
+
+                ("fn", FN);
+                ("iter", ITER);
+
+                ("import", IMPORT);
+                ("export", EXPORT);
+
+                ("let", LET);
+
+                ("log", LOG);
+                ("spawn", SPAWN);
+                ("thread", THREAD);
+                ("yield", YIELD);
+                ("join", JOIN);
+
+                ("bool", BOOL);
+
+                ("int", INT);
+                ("uint", UINT);
+
+                ("char", CHAR);
+                ("str", STR);
+
+                ("rec", REC);
+                ("tup", TUP);
+                ("tag", TAG);
+                ("vec", VEC);
+                ("any", ANY);
+
+                ("obj", OBJ);
+
+                ("port", PORT);
+                ("chan", CHAN);
+
+                ("task", TASK);
+
+                ("true", LIT_BOOL true);
+                ("false", LIT_BOOL false);
+
+                ("in", IN);
+
+                ("as", AS);
+                ("with", WITH);
+
+                ("bind", BIND);
+
+                ("u8", MACH TY_u8);
+                ("u16", MACH TY_u16);
+                ("u32", MACH TY_u32);
+                ("u64", MACH TY_u64);
+                ("i8", MACH TY_i8);
+                ("i16", MACH TY_i16);
+                ("i32", MACH TY_i32);
+                ("i64", MACH TY_i64);
+                ("f32", MACH TY_f32);
+                ("f64", MACH TY_f64)
+              ]
+;;
+}
+
+let hexdig = ['0'-'9' 'a'-'f' 'A'-'F']
+let bin = "0b" ['0' '1']['0' '1' '_']*
+let hex = "0x" hexdig ['0'-'9' 'a'-'f' 'A'-'F' '_']*
+let dec = ['0'-'9']+
+let exp = ['e''E']['-''+']? dec
+let flo = (dec '.' dec (exp?)) | (dec exp)
+
+let ws = [ ' ' '\t' '\r' ]
+
+let id = ['a'-'z' 'A'-'Z' '_']['a'-'z' 'A'-'Z' '0'-'9' '_']*
+
+rule token = parse
+  ws+                          { token lexbuf }
+| '\n'                         { lexbuf.Lexing.lex_curr_p
+                                     <- (bump_line lexbuf.Lexing.lex_curr_p);
+                                 token lexbuf }
+| "//" [^'\n']*                { token lexbuf }
+
+| '+'                          { PLUS       }
+| '-'                          { MINUS      }
+| '*'                          { STAR       }
+| '/'                          { SLASH      }
+| '%'                          { PERCENT    }
+| '='                          { EQ         }
+| '<'                          { LT         }
+| "<="                         { LE         }
+| "=="                         { EQEQ       }
+| "!="                         { NE         }
+| ">="                         { GE         }
+| '>'                          { GT         }
+| '!'                          { NOT        }
+| '&'                          { AND        }
+| "&&"                         { ANDAND     }
+| '|'                          { OR         }
+| "||"                         { OROR       }
+| "<<"                         { LSL        }
+| ">>"                         { LSR        }
+| ">>>"                        { ASR        }
+| '~'                          { TILDE      }
+| '{'                          { LBRACE     }
+| '_' (dec as n)               { IDX (int_of_string n) }
+| '_'                          { UNDERSCORE }
+| '}'                          { RBRACE     }
+
+| "+="                         { OPEQ (PLUS)    }
+| "-="                         { OPEQ (MINUS)   }
+| "*="                         { OPEQ (STAR)    }
+| "/="                         { OPEQ (SLASH)   }
+| "%="                         { OPEQ (PERCENT) }
+| "&="                         { OPEQ (AND) }
+| "|="                         { OPEQ (OR)  }
+| "<<="                        { OPEQ (LSL) }
+| ">>="                        { OPEQ (LSR) }
+| ">>>="                       { OPEQ (ASR) }
+| "^="                         { OPEQ (CARET) }
+
+| '#'                          { POUND      }
+| '@'                          { AT         }
+| '^'                          { CARET      }
+| '.'                          { DOT        }
+| ','                          { COMMA      }
+| ';'                          { SEMI       }
+| ':'                          { COLON      }
+| "<-"                         { LARROW     }
+| "<|"                         { SEND       }
+| "->"                         { RARROW     }
+| '('                          { LPAREN     }
+| ')'                          { RPAREN     }
+| '['                          { LBRACKET   }
+| ']'                          { RBRACKET   }
+
+| id as i
+                               { try
+                                     Hashtbl.find keyword_table i
+                                 with
+                                     Not_found -> IDENT (i)
+                                            }
+
+| bin as n                      { LIT_INT (Int64.of_string n, n)    }
+| hex as n                      { LIT_INT (Int64.of_string n, n)    }
+| dec as n                      { LIT_INT (Int64.of_string n, n)    }
+| flo as n                      { LIT_FLO n                         }
+
+| '\''                          { char lexbuf                       }
+| '"'                           { let buf = Buffer.create 32 in
+                                    str buf lexbuf                  }
+
+| eof                           { EOF        }
+
+and str buf = parse
+    _ as ch
+    {
+      match ch with
+          '"' -> LIT_STR (Buffer.contents buf)
+        | '\\' -> str_escape buf lexbuf
+        | _ ->
+            Buffer.add_char buf ch;
+            let c = Char.code ch in
+              if bounds 0 c 0x7f
+              then str buf lexbuf
+              else
+                if ((c land 0b1110_0000) == 0b1100_0000)
+                then ext_str 1 buf lexbuf
+                else
+                  if ((c land 0b1111_0000) == 0b1110_0000)
+                  then ext_str 2 buf lexbuf
+                  else
+                    if ((c land 0b1111_1000) == 0b1111_0000)
+                    then ext_str 3 buf lexbuf
+                    else
+                      if ((c land 0b1111_1100) == 0b1111_1000)
+                      then ext_str 4 buf lexbuf
+                      else
+                        if ((c land 0b1111_1110) == 0b1111_1100)
+                        then ext_str 5 buf lexbuf
+                        else fail lexbuf "bad initial utf-8 byte"
+    }
+
+and str_escape buf = parse
+    'x' ((hexdig hexdig) as h)
+  | 'u' ((hexdig hexdig hexdig hexdig) as h)
+  | 'U'
+      ((hexdig hexdig hexdig hexdig
+        hexdig hexdig hexdig hexdig) as h)
+      {
+        Buffer.add_string buf (char_as_utf8 (int_of_string ("0x" ^ h)));
+        str buf lexbuf
+      }
+  | 'n' { Buffer.add_char buf '\n'; str buf lexbuf }
+  | 'r' { Buffer.add_char buf '\r'; str buf lexbuf }
+  | 't' { Buffer.add_char buf '\t'; str buf lexbuf }
+  | '\\' { Buffer.add_char buf '\\'; str buf lexbuf }
+  | '"' { Buffer.add_char buf '"'; str buf lexbuf }
+  | _ as c { fail lexbuf ("bad escape: \\" ^ (Char.escaped c))  }
+
+
+and ext_str n buf = parse
+    _ as ch
+      {
+        let c = Char.code ch in
+          if ((c land 0b1100_0000) == (0b1000_0000))
+          then
+            begin
+              Buffer.add_char buf ch;
+              if n = 1
+              then str buf lexbuf
+              else ext_str (n-1) buf lexbuf
+            end
+          else
+            fail lexbuf "bad trailing utf-8 byte"
+      }
+
+
+and char = parse
+    '\\' { char_escape lexbuf }
+  | _ as c
+    {
+      let c = Char.code c in
+        if bounds 0 c 0x7f
+        then end_char c lexbuf
+        else
+          if ((c land 0b1110_0000) == 0b1100_0000)
+          then ext_char 1 (c land 0b0001_1111) lexbuf
+          else
+            if ((c land 0b1111_0000) == 0b1110_0000)
+            then ext_char 2 (c land 0b0000_1111) lexbuf
+            else
+              if ((c land 0b1111_1000) == 0b1111_0000)
+              then ext_char 3 (c land 0b0000_0111) lexbuf
+              else
+                if ((c land 0b1111_1100) == 0b1111_1000)
+                then ext_char 4 (c land 0b0000_0011) lexbuf
+                else
+                  if ((c land 0b1111_1110) == 0b1111_1100)
+                  then ext_char 5 (c land 0b0000_0001) lexbuf
+                  else fail lexbuf "bad initial utf-8 byte"
+    }
+
+and char_escape = parse
+    'x' ((hexdig hexdig) as h)
+  | 'u' ((hexdig hexdig hexdig hexdig) as h)
+  | 'U'
+      ((hexdig hexdig hexdig hexdig
+        hexdig hexdig hexdig hexdig) as h)
+      {
+        end_char (int_of_string ("0x" ^ h)) lexbuf
+      }
+  | 'n' { end_char (Char.code '\n') lexbuf }
+  | 'r' { end_char (Char.code '\r') lexbuf }
+  | 't' { end_char (Char.code '\t') lexbuf }
+  | '\\' { end_char (Char.code '\\') lexbuf }
+  | '\'' { end_char (Char.code '\'') lexbuf }
+  | _ as c { fail lexbuf ("bad escape: \\" ^ (Char.escaped c))  }
+
+
+and ext_char n accum = parse
+  _ as c
+    {
+      let c = Char.code c in
+        if ((c land 0b1100_0000) == (0b1000_0000))
+        then
+          let accum = (accum lsl 6) lor (c land 0b0011_1111) in
+            if n = 1
+            then end_char accum lexbuf
+            else ext_char (n-1) accum lexbuf
+        else
+          fail lexbuf "bad trailing utf-8 byte"
+    }
+
+and end_char accum = parse
+  '\'' { LIT_CHAR accum }
+
+
+and bracequote buf depth = parse
+
+  '\\' '{'                      { Buffer.add_char buf '{';
+                                  bracequote buf depth lexbuf          }
+
+| '{'                           { Buffer.add_char buf '{';
+                                  bracequote buf (depth+1) lexbuf      }
+
+| '\\' '}'                      { Buffer.add_char buf '}';
+                                  bracequote buf depth lexbuf          }
+
+| '}'                           { if depth = 1
+                                  then BRACEQUOTE (Buffer.contents buf)
+                                  else
+                                    begin
+                                      Buffer.add_char buf '}';
+                                      bracequote buf (depth-1) lexbuf
+                                    end                                }
+
+| '\\' [^'{' '}']               { let s = Lexing.lexeme lexbuf in
+                                    Buffer.add_string buf s;
+                                    bracequote buf depth lexbuf        }
+
+
+| [^'\\' '{' '}']+              { let s = Lexing.lexeme lexbuf in
+                                    Buffer.add_string buf s;
+                                    bracequote buf depth lexbuf        }

src/boot/fe/parser.ml

@@ -0,0 +1,374 @@
+
+open Common;;
+open Token;;
+
+(* Fundamental parser types and actions *)
+
+type get_mod_fn = (Ast.meta_pat
+                   -> node_id
+                     -> (node_id ref)
+                       -> (opaque_id ref)
+                         -> (filename * Ast.mod_items))
+;;
+
+type pstate =
+    { mutable pstate_peek : token;
+      mutable pstate_ctxt : (string * pos) list;
+      mutable pstate_rstr : bool;
+      mutable pstate_depth: int;
+      pstate_lexbuf       : Lexing.lexbuf;
+      pstate_file         : filename;
+      pstate_sess         : Session.sess;
+      pstate_temp_id      : temp_id ref;
+      pstate_node_id      : node_id ref;
+      pstate_opaque_id    : opaque_id ref;
+      pstate_get_mod      : get_mod_fn;
+      pstate_infer_lib_name : (Ast.ident -> filename);
+      pstate_required       : (node_id, (required_lib * nabi_conv)) Hashtbl.t;
+      pstate_required_syms  : (node_id, string) Hashtbl.t; }
+;;
+
+let log (ps:pstate) = Session.log "parse"
+  ps.pstate_sess.Session.sess_log_parse
+  ps.pstate_sess.Session.sess_log_out
+;;
+
+let iflog ps thunk =
+  if ps.pstate_sess.Session.sess_log_parse
+  then thunk ()
+  else ()
+;;
+
+let make_parser
+    (tref:temp_id ref)
+    (nref:node_id ref)
+    (oref:opaque_id ref)
+    (sess:Session.sess)
+    (get_mod:get_mod_fn)
+    (infer_lib_name:Ast.ident -> filename)
+    (required:(node_id, (required_lib * nabi_conv)) Hashtbl.t)
+    (required_syms:(node_id, string) Hashtbl.t)
+    (fname:string)
+    : pstate =
+  let lexbuf = Lexing.from_channel (open_in fname) in
+  let spos = { lexbuf.Lexing.lex_start_p with Lexing.pos_fname = fname } in
+  let cpos = { lexbuf.Lexing.lex_curr_p with Lexing.pos_fname = fname } in
+    lexbuf.Lexing.lex_start_p <- spos;
+    lexbuf.Lexing.lex_curr_p <- cpos;
+    let first = Lexer.token lexbuf in
+    let ps =
+      { pstate_peek = first;
+        pstate_ctxt = [];
+        pstate_rstr = false;
+        pstate_depth = 0;
+        pstate_lexbuf = lexbuf;
+        pstate_file = fname;
+        pstate_sess = sess;
+        pstate_temp_id = tref;
+        pstate_node_id = nref;
+        pstate_opaque_id = oref;
+        pstate_get_mod = get_mod;
+        pstate_infer_lib_name = infer_lib_name;
+        pstate_required = required;
+        pstate_required_syms = required_syms; }
+    in
+      iflog ps (fun _ -> log ps "made parser for: %s\n%!" fname);
+      ps
+;;
+
+exception Parse_err of (pstate * string)
+;;
+
+let lexpos (ps:pstate) : pos =
+  let p = ps.pstate_lexbuf.Lexing.lex_start_p in
+    (p.Lexing.pos_fname,
+     p.Lexing.pos_lnum ,
+     (p.Lexing.pos_cnum) - (p.Lexing.pos_bol))
+;;
+
+let next_node_id (ps:pstate) : node_id =
+  let id = !(ps.pstate_node_id) in
+    ps.pstate_node_id := Node ((int_of_node id)+1);
+    id
+;;
+
+let next_opaque_id (ps:pstate) : opaque_id =
+  let id = !(ps.pstate_opaque_id) in
+    ps.pstate_opaque_id := Opaque ((int_of_opaque id)+1);
+    id
+;;
+
+let span
+    (ps:pstate)
+    (apos:pos)
+    (bpos:pos)
+    (x:'a)
+    : 'a identified =
+  let span = { lo = apos; hi = bpos } in
+  let id = next_node_id ps in
+    iflog ps (fun _ -> log ps "span for node #%d: %s"
+                (int_of_node id) (Session.string_of_span span));
+    htab_put ps.pstate_sess.Session.sess_spans id span;
+    { node = x; id = id }
+;;
+
+let decl p i =
+  { Ast.decl_params = p;
+    Ast.decl_item = i }
+;;
+
+let spans
+    (ps:pstate)
+    (things:('a identified) array)
+    (apos:pos)
+    (thing:'a)
+    : ('a identified) array =
+  Array.append things [| (span ps apos (lexpos ps) thing) |]
+;;
+
+(* 
+ * The point of this is to make a new node_id entry for a node that is a
+ * "copy" of an lval returned from somewhere else. For example if you create
+ * a temp, the lval it returns can only be used in *one* place, for the
+ * node_id denotes the place that lval is first used; subsequent uses of
+ * 'the same' reference must clone_lval it into a new node_id. Otherwise
+ * there is trouble.
+ *)
+
+let clone_span
+    (ps:pstate)
+    (oldnode:'a identified)
+    (newthing:'b)
+    : 'b identified =
+  let s = Hashtbl.find ps.pstate_sess.Session.sess_spans oldnode.id in
+    span ps s.lo s.hi newthing
+;;
+
+let rec clone_lval (ps:pstate) (lval:Ast.lval) : Ast.lval =
+  match lval with
+      Ast.LVAL_base nb ->
+        let nnb = clone_span ps nb nb.node in
+          Ast.LVAL_base nnb
+    | Ast.LVAL_ext (base, ext) ->
+        Ast.LVAL_ext ((clone_lval ps base), ext)
+;;
+
+let clone_atom (ps:pstate) (atom:Ast.atom) : Ast.atom =
+  match atom with
+      Ast.ATOM_literal _ -> atom
+    | Ast.ATOM_lval lv -> Ast.ATOM_lval (clone_lval ps lv)
+;;
+
+let ctxt (n:string) (f:pstate -> 'a) (ps:pstate) : 'a =
+  (ps.pstate_ctxt <- (n, lexpos ps) :: ps.pstate_ctxt;
+   let res = f ps in
+     ps.pstate_ctxt <- List.tl ps.pstate_ctxt;
+     res)
+;;
+
+let rstr (r:bool) (f:pstate -> 'a) (ps:pstate) : 'a =
+  let prev = ps.pstate_rstr in
+    (ps.pstate_rstr <- r;
+     let res = f ps in
+       ps.pstate_rstr <- prev;
+       res)
+;;
+
+let err (str:string) (ps:pstate) =
+  (Parse_err (ps, (str)))
+;;
+
+
+let (slot_nil:Ast.slot) =
+  { Ast.slot_mode = Ast.MODE_interior;
+    Ast.slot_mutable = false;
+    Ast.slot_ty = Some Ast.TY_nil }
+;;
+
+let (slot_auto:Ast.slot) =
+  { Ast.slot_mode = Ast.MODE_interior;
+    Ast.slot_mutable = true;
+    Ast.slot_ty = None }
+;;
+
+let build_tmp
+    (ps:pstate)
+    (slot:Ast.slot)
+    (apos:pos)
+    (bpos:pos)
+    : (temp_id * Ast.lval * Ast.stmt) =
+  let nonce = !(ps.pstate_temp_id) in
+    ps.pstate_temp_id := Temp ((int_of_temp nonce)+1);
+    iflog ps
+      (fun _ -> log ps "building temporary %d" (int_of_temp nonce));
+    let decl = Ast.DECL_slot (Ast.KEY_temp nonce, (span ps apos bpos slot)) in
+    let declstmt = span ps apos bpos (Ast.STMT_decl decl) in
+    let tmp = Ast.LVAL_base (span ps apos bpos (Ast.BASE_temp nonce)) in
+      (nonce, tmp, declstmt)
+;;
+
+(* Simple helpers *)
+
+(* FIXME: please rename these, they make eyes bleed. *)
+
+let arr (ls:'a list) : 'a array = Array.of_list ls ;;
+let arl (ls:'a list) : 'a array = Array.of_list (List.rev ls) ;;
+let arj (ar:('a array array)) = Array.concat (Array.to_list ar) ;;
+let arj1st (pairs:(('a array) * 'b) array) : (('a array) * 'b array) =
+  let (az, bz) = List.split (Array.to_list pairs) in
+    (Array.concat az, Array.of_list bz)
+
+
+(* Bottom-most parser actions. *)
+
+let peek (ps:pstate) : token =
+  iflog ps
+    begin
+      fun _ ->
+        log ps "peeking at: %s     // %s"
+          (string_of_tok ps.pstate_peek)
+          (match ps.pstate_ctxt with
+               (s, _) :: _ -> s
+             | _ -> "<empty>")
+    end;
+  ps.pstate_peek
+;;
+
+
+let bump (ps:pstate) : unit =
+  begin
+    iflog ps (fun _ -> log ps "bumping past: %s"
+                (string_of_tok ps.pstate_peek));
+    ps.pstate_peek <- Lexer.token ps.pstate_lexbuf
+  end
+;;
+
+let bump_bracequote (ps:pstate) : unit =
+  begin
+    assert (ps.pstate_peek = LBRACE);
+    iflog ps (fun _ -> log ps "bumping past: %s"
+                (string_of_tok ps.pstate_peek));
+    let buf = Buffer.create 32 in
+      ps.pstate_peek <- Lexer.bracequote buf 1 ps.pstate_lexbuf
+  end
+;;
+
+
+let expect (ps:pstate) (t:token) : unit =
+  let p = peek ps in
+    if p == t
+    then bump ps
+    else
+      let msg = ("Expected '" ^ (string_of_tok t) ^
+                   "', found '" ^ (string_of_tok p ) ^ "'") in
+        raise (Parse_err (ps, msg))
+;;
+
+let unexpected (ps:pstate) =
+  err ("Unexpected token '" ^ (string_of_tok (peek ps)) ^ "'") ps
+;;
+
+
+
+(* Parser combinators. *)
+
+let one_or_more
+    (sep:token)
+    (prule:pstate -> 'a)
+    (ps:pstate)
+    : 'a array =
+  let accum = ref [prule ps] in
+    while peek ps == sep
+    do
+      bump ps;
+      accum := (prule ps) :: !accum
+    done;
+    arl !accum
+;;
+
+let bracketed_seq
+    (mandatory:int)
+    (bra:token)
+    (ket:token)
+    (sepOpt:token option)
+    (prule:pstate -> 'a)
+    (ps:pstate)
+    : 'a array =
+  expect ps bra;
+  let accum = ref [] in
+  let dosep _ =
+    (match sepOpt with
+         None -> ()
+       | Some tok ->
+           if (!accum = [])
+           then ()
+           else expect ps tok)
+  in
+    while mandatory > List.length (!accum) do
+      dosep ();
+      accum := (prule ps) :: (!accum)
+    done;
+    while (not (peek ps = ket))
+    do
+      dosep ();
+      accum := (prule ps) :: !accum
+    done;
+    expect ps ket;
+    arl !accum
+;;
+
+
+let bracketed_zero_or_more
+    (bra:token)
+    (ket:token)
+    (sepOpt:token option)
+    (prule:pstate -> 'a)
+    (ps:pstate)
+    : 'a array =
+  bracketed_seq 0 bra ket sepOpt (ctxt "bracketed_seq" prule) ps
+;;
+
+
+let paren_comma_list
+    (prule:pstate -> 'a)
+    (ps:pstate)
+    : 'a array =
+  bracketed_zero_or_more LPAREN RPAREN (Some COMMA) prule ps
+;;
+
+let bracketed_one_or_more
+    (bra:token)
+    (ket:token)
+    (sepOpt:token option)
+    (prule:pstate -> 'a)
+    (ps:pstate)
+    : 'a array =
+  bracketed_seq 1 bra ket sepOpt (ctxt "bracketed_seq" prule) ps
+;;
+
+let bracketed_two_or_more
+    (bra:token)
+    (ket:token)
+    (sepOpt:token option)
+    (prule:pstate -> 'a)
+    (ps:pstate)
+    : 'a array =
+  bracketed_seq 2 bra ket sepOpt (ctxt "bracketed_seq" prule) ps
+;;
+
+
+let bracketed (bra:token) (ket:token) (prule:pstate -> 'a) (ps:pstate) : 'a =
+  expect ps bra;
+  let res = ctxt "bracketed" prule ps in
+    expect ps ket;
+    res
+;;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/fe/token.ml

@@ -0,0 +1,308 @@
+type token =
+
+    (* Expression operator symbols *)
+    PLUS
+  | MINUS
+  | STAR
+  | SLASH
+  | PERCENT
+  | EQ
+  | LT
+  | LE
+  | EQEQ
+  | NE
+  | GE
+  | GT
+  | NOT
+  | TILDE
+  | CARET
+  | AND
+  | ANDAND
+  | OR
+  | OROR
+  | LSL
+  | LSR
+  | ASR
+  | OPEQ of token
+  | AS
+  | WITH
+
+  (* Structural symbols *)
+  | AT
+  | DOT
+  | COMMA
+  | SEMI
+  | COLON
+  | RARROW
+  | SEND
+  | LARROW
+  | LPAREN
+  | RPAREN
+  | LBRACKET
+  | RBRACKET
+  | LBRACE
+  | RBRACE
+
+  (* Module and crate keywords *)
+  | MOD
+  | USE
+  | AUTH
+  | META
+
+  (* Metaprogramming keywords *)
+  | SYNTAX
+  | POUND
+
+  (* Statement keywords *)
+  | IF
+  | ELSE
+  | DO
+  | WHILE
+  | ALT
+  | CASE
+
+  | FAIL
+  | DROP
+
+  | IN
+  | FOR
+  | EACH
+  | PUT
+  | RET
+  | BE
+
+  (* Type and type-state keywords *)
+  | TYPE
+  | CHECK
+  | CLAIM
+  | PROVE
+
+  (* Effect keywords *)
+  | IO
+  | STATE
+  | UNSAFE
+
+  (* Type qualifiers *)
+  | NATIVE
+  | AUTO
+  | MUTABLE
+
+  (* Name management *)
+  | IMPORT
+  | EXPORT
+
+  (* Value / stmt declarators *)
+  | LET
+
+  (* Magic runtime services *)
+  | LOG
+  | SPAWN
+  | BIND
+  | THREAD
+  | YIELD
+  | JOIN
+
+  (* Literals *)
+  | LIT_INT       of (int64 * string)
+  | LIT_FLO       of string
+  | LIT_STR       of string
+  | LIT_CHAR      of int
+  | LIT_BOOL      of bool
+
+  (* Name components *)
+  | IDENT         of string
+  | IDX           of int
+  | UNDERSCORE
+
+  (* Reserved type names *)
+  | BOOL
+  | INT
+  | UINT
+  | CHAR
+  | STR
+  | MACH          of Common.ty_mach
+
+  (* Algebraic type constructors *)
+  | REC
+  | TUP
+  | TAG
+  | VEC
+  | ANY
+
+  (* Callable type constructors *)
+  | FN
+  | ITER
+
+  (* Object type *)
+  | OBJ
+
+  (* Comm and task types *)
+  | CHAN
+  | PORT
+  | TASK
+
+  | EOF
+
+  | BRACEQUOTE of string
+
+;;
+
+let rec string_of_tok t =
+  match t with
+      (* Operator symbols (mostly) *)
+      PLUS       -> "+"
+    | MINUS      -> "-"
+    | STAR       -> "*"
+    | SLASH      -> "/"
+    | PERCENT    -> "%"
+    | EQ         -> "="
+    | LT         -> "<"
+    | LE         -> "<="
+    | EQEQ       -> "=="
+    | NE         -> "!="
+    | GE         -> ">="
+    | GT         -> ">"
+    | TILDE      -> "~"
+    | CARET      -> "^"
+    | NOT        -> "!"
+    | AND        -> "&"
+    | ANDAND     -> "&&"
+    | OR         -> "|"
+    | OROR       -> "||"
+    | LSL        -> "<<"
+    | LSR        -> ">>"
+    | ASR        -> ">>>"
+    | OPEQ op    -> string_of_tok op ^ "="
+    | AS         -> "as"
+    | WITH       -> "with"
+
+    (* Structural symbols *)
+    | AT         -> "@"
+    | DOT        -> "."
+    | COMMA      -> ","
+    | SEMI       -> ";"
+    | COLON      -> ":"
+    | RARROW     -> "->"
+    | SEND       -> "<|"
+    | LARROW     -> "<-"
+    | LPAREN     -> "("
+    | RPAREN     -> ")"
+    | LBRACKET   -> "["
+    | RBRACKET   -> "]"
+    | LBRACE     -> "{"
+    | RBRACE     -> "}"
+
+    (* Module and crate keywords *)
+    | MOD        -> "mod"
+    | USE        -> "use"
+    | AUTH       -> "auth"
+
+    (* Metaprogramming keywords *)
+    | SYNTAX     -> "syntax"
+    | META       -> "meta"
+    | POUND      -> "#"
+
+    (* Control-flow keywords *)
+    | IF         -> "if"
+    | ELSE       -> "else"
+    | DO         -> "do"
+    | WHILE      -> "while"
+    | ALT        -> "alt"
+    | CASE       -> "case"
+
+    | FAIL       -> "fail"
+    | DROP       -> "drop"
+
+    | IN         -> "in"
+    | FOR        -> "for"
+    | EACH       -> "each"
+    | PUT        -> "put"
+    | RET        -> "ret"
+    | BE         -> "be"
+
+    (* Type and type-state keywords *)
+    | TYPE       -> "type"
+    | CHECK      -> "check"
+    | CLAIM      -> "claim"
+    | PROVE      -> "prove"
+
+    (* Effect keywords *)
+    | IO         -> "io"
+    | STATE      -> "state"
+    | UNSAFE     -> "unsafe"
+
+    (* Type qualifiers *)
+    | NATIVE     -> "native"
+    | AUTO       -> "auto"
+    | MUTABLE    -> "mutable"
+
+    (* Name management *)
+    | IMPORT     -> "import"
+    | EXPORT     -> "export"
+
+    (* Value / stmt declarators. *)
+    | LET        -> "let"
+
+    (* Magic runtime services *)
+    | LOG        -> "log"
+    | SPAWN      -> "spawn"
+    | BIND       -> "bind"
+    | THREAD     -> "thread"
+    | YIELD      -> "yield"
+    | JOIN       -> "join"
+
+    (* Literals *)
+    | LIT_INT (_,s)  -> s
+    | LIT_FLO n  -> n
+    | LIT_STR s  -> ("\"" ^ (String.escaped s) ^ "\"")
+    | LIT_CHAR c -> ("'" ^ (Common.escaped_char c) ^ "'")
+    | LIT_BOOL b -> if b then "true" else "false"
+
+    (* Name components *)
+    | IDENT s    -> s
+    | IDX i      -> ("_" ^ (string_of_int i))
+    | UNDERSCORE -> "_"
+
+    (* Reserved type names *)
+    | BOOL       -> "bool"
+    | INT        -> "int"
+    | UINT       -> "uint"
+    | CHAR       -> "char"
+    | STR        -> "str"
+    | MACH m     -> Common.string_of_ty_mach m
+
+    (* Algebraic type constructors *)
+    | REC        -> "rec"
+    | TUP        -> "tup"
+    | TAG        -> "tag"
+    | VEC        -> "vec"
+    | ANY        -> "any"
+
+    (* Callable type constructors *)
+    | FN         -> "fn"
+    | ITER       -> "fn"
+
+    (* Object type *)
+    | OBJ        -> "obj"
+
+    (* Ports and channels *)
+    | CHAN          -> "chan"
+    | PORT          -> "port"
+
+    (* Taskess types *)
+    | TASK         -> "task"
+
+    | BRACEQUOTE _ -> "{...bracequote...}"
+
+    | EOF          -> "<EOF>"
+;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/llvm/llabi.ml

@@ -0,0 +1,69 @@
+(*
+ * LLVM integration with the Rust runtime.
+ *)
+
+type abi = {
+  crate_ty:   Llvm.lltype;
+  task_ty:    Llvm.lltype;
+  word_ty:    Llvm.lltype;
+  rust_start: Llvm.llvalue;
+};;
+
+let declare_abi (llctx:Llvm.llcontext) (llmod:Llvm.llmodule) : abi =
+  let i32 = Llvm.i32_type llctx in
+
+  let crate_ty =
+    (* TODO: other architectures besides x86 *)
+    let crate_opaque_ty = Llvm.opaque_type llctx in
+    let crate_tyhandle = Llvm.handle_to_type (Llvm.struct_type llctx [|
+        i32;                              (* ptrdiff_t image_base_off *)
+        Llvm.pointer_type crate_opaque_ty;(* uintptr_t self_addr *)
+        i32;                              (* ptrdiff_t debug_abbrev_off *)
+        i32;                              (* size_t debug_abbrev_sz *)
+        i32;                              (* ptrdiff_t debug_info_off *)
+        i32;                              (* size_t debug_info_sz *)
+        i32;                              (* size_t activate_glue_off *)
+        i32;                              (* size_t main_exit_task_glue_off *)
+        i32;                              (* size_t unwind_glue_off *)
+        i32;                              (* size_t yield_glue_off *)
+        i32;                              (* int n_rust_syms *)
+        i32;                              (* int n_c_syms *)
+        i32                               (* int n_libs *)
+      |])
+    in
+    Llvm.refine_type crate_opaque_ty (Llvm.type_of_handle crate_tyhandle);
+    Llvm.type_of_handle crate_tyhandle
+  in
+  ignore (Llvm.define_type_name "rust_crate" crate_ty llmod);
+
+  let task_ty =
+    (* TODO: other architectures besides x86 *)
+    Llvm.struct_type llctx [|
+      i32;                    (* size_t refcnt *)
+      Llvm.pointer_type i32;  (* stk_seg *stk *)
+      Llvm.pointer_type i32;  (* uintptr_t runtime_sp *)
+      Llvm.pointer_type i32;  (* uintptr_t rust_sp *)
+      Llvm.pointer_type i32;  (* rust_rt *rt *)
+      Llvm.pointer_type i32   (* rust_crate_cache *cache *)
+    |]
+  in
+  ignore (Llvm.define_type_name "rust_task" task_ty llmod);
+
+  let rust_start_ty =
+    let task_ptr_ty = Llvm.pointer_type task_ty in
+    let llnilty = Llvm.array_type (Llvm.i1_type llctx) 0 in
+    let main_ty = Llvm.function_type (Llvm.void_type llctx)
+      [| Llvm.pointer_type llnilty; task_ptr_ty; |]
+    in
+    let args_ty = Array.map Llvm.pointer_type [| main_ty; crate_ty; |] in
+    let args_ty = Array.append args_ty [| i32; i32 |] in
+      Llvm.function_type i32 args_ty
+  in
+  {
+    crate_ty = crate_ty;
+    task_ty = task_ty;
+    word_ty = i32;
+    rust_start = Llvm.declare_function "rust_start" rust_start_ty llmod
+  }
+;;
+

src/boot/llvm/llasm.ml

@@ -0,0 +1,192 @@
+(*
+ * machine-specific assembler routines.
+ *)
+
+open Common;;
+
+type asm_glue =
+    {
+      asm_activate_glue : Llvm.llvalue;
+      asm_yield_glue : Llvm.llvalue;
+      asm_upcall_glues : Llvm.llvalue array;
+    }
+;;
+
+let n_upcall_glues = 7
+;;
+
+(* x86-specific asm. *)
+
+let x86_glue
+  (llctx:Llvm.llcontext)
+  (llmod:Llvm.llmodule)
+  (abi:Llabi.abi)
+  (sess:Session.sess)
+  : asm_glue =
+  let (prefix,align) =
+    match sess.Session.sess_targ with
+        Linux_x86_elf
+      | Win32_x86_pe -> ("",4)
+      | MacOS_x86_macho -> ("_", 16)
+  in
+  let save_callee_saves =
+    ["pushl %ebp";
+     "pushl %edi";
+     "pushl %esi";
+     "pushl %ebx";]
+  in
+  let restore_callee_saves =
+    ["popl  %ebx";
+     "popl  %esi";
+     "popl  %edi";
+     "popl  %ebp";]
+  in
+  let load_esp_from_rust_sp    = ["movl  12(%edx), %esp"] in
+  let load_esp_from_runtime_sp = ["movl   8(%edx), %esp"] in
+  let store_esp_to_rust_sp     = ["movl  %esp, 12(%edx)"] in
+  let store_esp_to_runtime_sp  = ["movl  %esp,  8(%edx)"] in
+  let list_init i f = (Array.to_list (Array.init i f)) in
+  let list_init_concat i f = List.concat (list_init i f) in
+
+  let glue =
+    [
+      ("rust_activate_glue",
+       String.concat "\n\t"
+         (["movl  4(%esp), %edx    # edx = rust_task"]
+          @ save_callee_saves
+          @ store_esp_to_runtime_sp
+          @ load_esp_from_rust_sp
+            (* 
+             * This 'add' instruction is a bit surprising.
+             * See lengthy comment in boot/be/x86.ml activate_glue.
+             *)
+          @ ["addl  $20, 12(%edx)"]
+          @ restore_callee_saves
+          @ ["ret"]));
+
+      ("rust_yield_glue",
+       String.concat "\n\t"
+
+         (["movl  0(%esp), %edx    # edx = rust_task"]
+          @ load_esp_from_rust_sp
+          @ save_callee_saves
+          @ store_esp_to_rust_sp
+          @ load_esp_from_runtime_sp
+          @ restore_callee_saves
+          @ ["ret"]))
+    ]
+    @ list_init n_upcall_glues
+      begin
+        fun i ->
+          (* 
+           * 0, 4, 8, 12 are callee-saves
+           * 16 is retpc
+           * 20 is taskptr
+           * 24 is callee
+           * 28 .. (7+i) * 4 are args
+           *)
+
+          ((Printf.sprintf "rust_upcall_%d" i),
+           String.concat "\n\t"
+             (save_callee_saves
+              @ ["movl  %esp, %ebp     # ebp = rust_sp";
+                 "movl  20(%esp), %edx # edx = rust_task"]
+              @ store_esp_to_rust_sp
+              @ load_esp_from_runtime_sp
+              @ [Printf.sprintf
+                   "subl  $%d, %%esp   # esp -= args" ((i+1)*4);
+                 "andl  $~0xf, %esp    # align esp down";
+                 "movl  %edx, (%esp)   # arg[0] = rust_task "]
+
+              @ (list_init_concat i
+                   begin
+                     fun j ->
+                       [ Printf.sprintf "movl  %d(%%ebp),%%edx" ((j+7)*4);
+                         Printf.sprintf "movl  %%edx,%d(%%esp)" ((j+1)*4) ]
+                   end)
+
+              @ ["movl  24(%ebp), %edx # edx = callee";
+                 "call  *%edx          # call *%edx";
+                 "movl  20(%ebp), %edx # edx = rust_task"]
+              @ load_esp_from_rust_sp
+              @ restore_callee_saves
+              @ ["ret"]))
+      end
+  in
+
+  let _ =
+    Llvm.set_module_inline_asm llmod
+      begin
+        String.concat "\n"
+          begin
+            List.map
+              begin
+                fun (sym,asm) ->
+                  Printf.sprintf
+                    "\t.globl %s%s\n\t.balign %d\n%s%s:\n\t%s"
+                    prefix sym align prefix sym asm
+              end
+              glue
+          end
+      end
+  in
+
+  let decl_cdecl_fn name out_ty arg_tys =
+    let ty = Llvm.function_type out_ty arg_tys in
+    let fn = Llvm.declare_function name ty llmod in
+      Llvm.set_function_call_conv Llvm.CallConv.c fn;
+      fn
+  in
+
+  let decl_glue s =
+    let task_ptr_ty = Llvm.pointer_type abi.Llabi.task_ty in
+    let void_ty = Llvm.void_type llctx in
+      decl_cdecl_fn s void_ty [| task_ptr_ty |]
+  in
+
+  let decl_upcall n =
+    let task_ptr_ty = Llvm.pointer_type abi.Llabi.task_ty in
+    let word_ty = abi.Llabi.word_ty in
+    let callee_ty = word_ty in
+    let args_ty =
+      Array.append
+        [| task_ptr_ty; callee_ty |]
+        (Array.init n (fun _ -> word_ty))
+    in
+    let name = Printf.sprintf "rust_upcall_%d" n in
+      decl_cdecl_fn name word_ty args_ty
+  in
+    {
+      asm_activate_glue = decl_glue "rust_activate_glue";
+      asm_yield_glue = decl_glue "rust_yield_glue";
+      asm_upcall_glues = Array.init n_upcall_glues decl_upcall;
+    }
+;;
+
+(* x64-specific asm. *)
+(* arm-specific asm. *)
+(* ... *)
+
+
+let get_glue
+  (llctx:Llvm.llcontext)
+  (llmod:Llvm.llmodule)
+  (abi:Llabi.abi)
+  (sess:Session.sess)
+  : asm_glue =
+  match sess.Session.sess_targ with
+      Linux_x86_elf
+    | Win32_x86_pe
+    | MacOS_x86_macho ->
+        x86_glue llctx llmod abi sess
+;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/llvm/llemit.ml

@@ -0,0 +1,36 @@
+(*
+ * LLVM emitter.
+ *)
+
+(* The top-level interface to the LLVM translation subsystem. *)
+let trans_and_process_crate
+    (sess:Session.sess)
+    (sem_cx:Semant.ctxt)
+    (crate:Ast.crate)
+    : unit =
+  let llcontext = Llvm.create_context () in
+  let emit_file (llmod:Llvm.llmodule) : unit =
+    let filename = Session.filename_of sess.Session.sess_out in
+    if not (Llvm_bitwriter.write_bitcode_file llmod filename)
+    then raise (Failure ("failed to write the LLVM bitcode '" ^ filename
+      ^ "'"))
+  in
+  let llmod = Lltrans.trans_crate sem_cx llcontext sess crate in
+  begin
+    try
+      emit_file llmod
+    with e -> Llvm.dispose_module llmod; raise e
+  end;
+  Llvm.dispose_module llmod;
+  Llvm.dispose_context llcontext
+;;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)
+

src/boot/llvm/llfinal.ml

@@ -0,0 +1,96 @@
+(*
+ * LLVM ABI-level stuff that needs to happen after modules have been
+ * translated.
+ *)
+
+let finalize_module
+    (llctx:Llvm.llcontext)
+    (llmod:Llvm.llmodule)
+    (abi:Llabi.abi)
+    (asm_glue:Llasm.asm_glue)
+    (exit_task_glue:Llvm.llvalue)
+    (crate_ptr:Llvm.llvalue)
+    : unit =
+  let i32 = Llvm.i32_type llctx in
+
+  (*
+   * Count the number of Rust functions and the number of C functions by
+   * simply (and crudely) testing whether each function in the module begins
+   * with "_rust_".
+   *)
+
+  let (rust_fn_count, c_fn_count) =
+    let count (rust_fn_count, c_fn_count) fn =
+      let begins_with prefix str =
+        let (str_len, prefix_len) =
+          (String.length str, String.length prefix)
+        in
+        prefix_len <= str_len && (String.sub str 0 prefix_len) = prefix
+      in
+      if begins_with "_rust_" (Llvm.value_name fn) then
+        (rust_fn_count + 1, c_fn_count)
+      else
+        (rust_fn_count, c_fn_count + 1)
+    in
+    Llvm.fold_left_functions count (0, 0) llmod
+  in
+
+  let crate_val =
+    let crate_addr = Llvm.const_ptrtoint crate_ptr i32 in
+    let glue_off glue =
+      let addr = Llvm.const_ptrtoint glue i32 in
+        Llvm.const_sub addr crate_addr
+    in
+    let activate_glue_off = glue_off asm_glue.Llasm.asm_activate_glue in
+    let yield_glue_off = glue_off asm_glue.Llasm.asm_yield_glue in
+    let exit_task_glue_off = glue_off exit_task_glue in
+
+    Llvm.const_struct llctx [|
+      Llvm.const_int i32 0;             (* ptrdiff_t image_base_off *)
+      crate_ptr;                        (* uintptr_t self_addr *)
+      Llvm.const_int i32 0;             (* ptrdiff_t debug_abbrev_off *)
+      Llvm.const_int i32 0;             (* size_t debug_abbrev_sz *)
+      Llvm.const_int i32 0;             (* ptrdiff_t debug_info_off *)
+      Llvm.const_int i32 0;             (* size_t debug_info_sz *)
+      activate_glue_off;                (* size_t activate_glue_off *)
+      exit_task_glue_off;               (* size_t main_exit_task_glue_off *)
+      Llvm.const_int i32 0;             (* size_t unwind_glue_off *)
+      yield_glue_off;                   (* size_t yield_glue_off *)
+      Llvm.const_int i32 rust_fn_count; (* int n_rust_syms *)
+      Llvm.const_int i32 c_fn_count;    (* int n_c_syms *)
+      Llvm.const_int i32 0              (* int n_libs *)
+    |]
+  in
+
+  Llvm.set_initializer crate_val crate_ptr;
+
+  (* Define the main function for crt0 to call. *)
+  let main_fn =
+    let main_ty = Llvm.function_type i32 [| i32; i32 |] in
+    Llvm.define_function "main" main_ty llmod
+  in
+  let argc = Llvm.param main_fn 0 in
+  let argv = Llvm.param main_fn 1 in
+  let main_builder = Llvm.builder_at_end llctx (Llvm.entry_block main_fn) in
+  let rust_main_fn =
+    match Llvm.lookup_function "_rust_main" llmod with
+        None -> raise (Failure "no main function found")
+      | Some fn -> fn
+  in
+  let rust_start = abi.Llabi.rust_start in
+  let rust_start_args = [| rust_main_fn; crate_ptr; argc; argv |] in
+    ignore (Llvm.build_call
+              rust_start rust_start_args "start_rust" main_builder);
+    ignore (Llvm.build_ret (Llvm.const_int i32 0) main_builder)
+;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)
+

src/boot/llvm/lltrans.ml

@@ -0,0 +1,938 @@
+(*
+ * LLVM translator.
+ *)
+
+open Common;;
+open Transutil;;
+
+let log cx = Session.log "trans"
+  cx.Semant.ctxt_sess.Session.sess_log_trans
+  cx.Semant.ctxt_sess.Session.sess_log_out
+;;
+
+let trans_crate
+    (sem_cx:Semant.ctxt)
+    (llctx:Llvm.llcontext)
+    (sess:Session.sess)
+    (crate:Ast.crate)
+    : Llvm.llmodule =
+
+  let iflog thunk =
+    if sess.Session.sess_log_trans
+    then thunk ()
+    else ()
+  in
+
+  (* Helpers for adding metadata. *)
+  let (dbg_mdkind:int) = Llvm.mdkind_id llctx "dbg" in
+  let set_dbg_metadata (inst:Llvm.llvalue) (md:Llvm.llvalue) : unit =
+    Llvm.set_metadata inst dbg_mdkind md
+  in
+  let md_str (s:string) : Llvm.llvalue = Llvm.mdstring llctx s in
+  let md_node (vals:Llvm.llvalue array) : Llvm.llvalue =
+    Llvm.mdnode llctx vals
+  in
+  let const_i32 (i:int) : Llvm.llvalue =
+    Llvm.const_int (Llvm.i32_type llctx) i
+  in
+  let const_i1 (i:int) : Llvm.llvalue =
+    Llvm.const_int (Llvm.i1_type llctx) i
+  in
+  let llvm_debug_version : int = 0x8 lsl 16 in
+  let const_dw_tag (tag:Dwarf.dw_tag) : Llvm.llvalue =
+    const_i32 (llvm_debug_version lor (Dwarf.dw_tag_to_int tag))
+  in
+
+  (* Translation of our node_ids into LLVM identifiers, which are strings. *)
+  let next_anon_llid = ref 0 in
+  let num_llid num klass = Printf.sprintf "%s%d" klass num in
+  let anon_llid klass =
+    let llid = num_llid !next_anon_llid klass in
+    next_anon_llid := !next_anon_llid + 1;
+    llid
+  in
+  let node_llid (node_id_opt:node_id option) : (string -> string) =
+    match node_id_opt with
+        None -> anon_llid
+      | Some (Node num) -> num_llid num
+  in
+
+  (*
+   * Returns a bogus value for use in stub code that hasn't been implemented
+   * yet.
+   *
+   * TODO: On some joyous day, remove me.
+   *)
+  let bogus = Llvm.const_null (Llvm.i32_type llctx) in
+  let bogus_ptr = Llvm.const_null (Llvm.pointer_type (Llvm.i32_type llctx)) in
+
+  let llnilty = Llvm.array_type (Llvm.i1_type llctx) 0 in
+  let llnil = Llvm.const_array (Llvm.i1_type llctx) [| |] in
+
+  let ty_of_item = Hashtbl.find sem_cx.Semant.ctxt_all_item_types in
+  let ty_of_slot n = Semant.slot_ty (Semant.get_slot sem_cx n) in
+
+  let filename = Session.filename_of sess.Session.sess_in in
+  let llmod = Llvm.create_module llctx filename in
+
+  let (abi:Llabi.abi) = Llabi.declare_abi llctx llmod in
+  let (crate_ptr:Llvm.llvalue) =
+    Llvm.declare_global abi.Llabi.crate_ty "rust_crate" llmod
+  in
+
+  let (void_ty:Llvm.lltype) = Llvm.void_type llctx in
+  let (word_ty:Llvm.lltype) = abi.Llabi.word_ty in
+  let (wordptr_ty:Llvm.lltype) = Llvm.pointer_type word_ty in
+  let (task_ty:Llvm.lltype) = abi.Llabi.task_ty in
+  let (task_ptr_ty:Llvm.lltype) = Llvm.pointer_type task_ty in
+  let fn_ty (out:Llvm.lltype) (args:Llvm.lltype array) : Llvm.lltype =
+    Llvm.function_type out args
+  in
+
+  let imm (i:int64) : Llvm.llvalue =
+    Llvm.const_int word_ty (Int64.to_int i)
+  in
+
+  let asm_glue = Llasm.get_glue llctx llmod abi sess in
+
+  let llty_str llty =
+    Llvm.string_of_lltype llty
+  in
+
+  let llval_str llv =
+    let ts = llty_str (Llvm.type_of llv) in
+      match Llvm.value_name llv with
+          "" ->
+            Printf.sprintf "<anon=%s>" ts
+        | s -> Printf.sprintf "<%s=%s>" s ts
+  in
+
+  let llvals_str llvals =
+    (String.concat ", "
+       (Array.to_list
+          (Array.map llval_str llvals)))
+  in
+
+  let build_call callee args rvid builder =
+    iflog
+      begin
+        fun _ ->
+          let name = Llvm.value_name callee in
+          log sem_cx "build_call: %s(%s)" name (llvals_str args);
+          log sem_cx "build_call: typeof(%s) = %s"
+            name (llty_str (Llvm.type_of callee))
+      end;
+    Llvm.build_call callee args rvid builder
+  in
+
+  (* Upcall translation *)
+
+  let extern_upcalls = Hashtbl.create 0 in
+  let trans_upcall
+      (llbuilder:Llvm.llbuilder)
+      (lltask:Llvm.llvalue)
+      (name:string)
+      (lldest:Llvm.llvalue option)
+      (llargs:Llvm.llvalue array) =
+    let n = Array.length llargs in
+    let llglue = asm_glue.Llasm.asm_upcall_glues.(n) in
+    let llupcall = htab_search_or_add extern_upcalls name
+      begin
+        fun _ ->
+          let args_ty =
+            Array.append
+              [| task_ptr_ty |]
+              (Array.init n (fun i -> Llvm.type_of llargs.(i)))
+          in
+          let out_ty = match lldest with
+              None -> void_ty
+            | Some v -> Llvm.type_of v
+          in
+          let fty = fn_ty out_ty args_ty in
+            (* 
+             * NB: At this point it actually doesn't matter what type
+             * we gave the upcall function, as we're just going to
+             * pointercast it to a word and pass it to the upcall-glue
+             * for now. But possibly in the future it might matter if
+             * we develop a proper upcall calling convention.
+             *)
+            Llvm.declare_function name fty llmod
+      end
+    in
+      (* Cast everything to plain words so we can hand off to the glue. *)
+    let llupcall = Llvm.const_pointercast llupcall word_ty in
+    let llargs =
+      Array.map
+        (fun arg ->
+           Llvm.build_pointercast arg word_ty
+             (anon_llid "arg") llbuilder)
+        llargs
+    in
+    let llallargs = Array.append [| lltask; llupcall |] llargs in
+    let llid = anon_llid "rv" in
+    let llrv = build_call llglue llallargs llid llbuilder in
+      Llvm.set_instruction_call_conv Llvm.CallConv.c llrv;
+      match lldest with
+          None -> ()
+        | Some lldest ->
+            let lldest =
+              Llvm.build_pointercast lldest wordptr_ty "" llbuilder
+            in
+              ignore (Llvm.build_store llrv lldest llbuilder);
+  in
+
+  let upcall
+      (llbuilder:Llvm.llbuilder)
+      (lltask:Llvm.llvalue)
+      (name:string)
+      (lldest:Llvm.llvalue option)
+      (llargs:Llvm.llvalue array)
+      : unit =
+    trans_upcall llbuilder lltask name lldest llargs
+  in
+
+  let trans_free
+      (llbuilder:Llvm.llbuilder)
+      (lltask:Llvm.llvalue)
+      (src:Llvm.llvalue)
+      : unit =
+    upcall llbuilder lltask "upcall_free" None [| src |]
+  in
+
+  (*
+   * let trans_malloc (llbuilder:Llvm.llbuilder)
+   *                  (dst:Llvm.llvalue) (nbytes:int64) : unit =
+   *   upcall llbuilder "upcall_malloc" (Some dst) [| imm nbytes |]
+   * in
+   *)
+
+  (* Type translation *)
+
+  let lltys = Hashtbl.create 0 in
+
+  let trans_mach_ty (mty:ty_mach) : Llvm.lltype =
+    let tycon =
+      match mty with
+          TY_u8 | TY_i8 -> Llvm.i8_type
+        | TY_u16 | TY_i16 -> Llvm.i16_type
+        | TY_u32 | TY_i32 -> Llvm.i32_type
+        | TY_u64 | TY_i64 -> Llvm.i64_type
+        | TY_f32 -> Llvm.float_type
+        | TY_f64 -> Llvm.double_type
+    in
+      tycon llctx
+  in
+
+
+  let rec trans_ty_full (ty:Ast.ty) : Llvm.lltype =
+    let p t = Llvm.pointer_type t in
+    let s ts = Llvm.struct_type llctx ts in
+    let opaque _ = Llvm.opaque_type llctx in
+    let vec_body_ty _ =
+      s [| word_ty; word_ty; word_ty; (opaque()) |]
+    in
+    let rc_opaque_ty =
+      s [| word_ty; (opaque()) |]
+    in
+    match ty with
+        Ast.TY_any -> opaque ()
+      | Ast.TY_nil -> llnilty
+      | Ast.TY_bool -> Llvm.i1_type llctx
+      | Ast.TY_mach mty -> trans_mach_ty mty
+      | Ast.TY_int -> word_ty
+      | Ast.TY_uint -> word_ty
+      | Ast.TY_char -> Llvm.i32_type llctx
+      | Ast.TY_vec _
+      | Ast.TY_str -> p (vec_body_ty())
+
+      | Ast.TY_fn tfn ->
+          let (tsig, _) = tfn in
+          let lloutptr = p (trans_slot None tsig.Ast.sig_output_slot) in
+          let lltaskty = p abi.Llabi.task_ty in
+          let llins = Array.map (trans_slot None) tsig.Ast.sig_input_slots in
+            fn_ty void_ty (Array.append [| lloutptr; lltaskty |] llins)
+
+      | Ast.TY_tup slots ->
+          s (Array.map (trans_slot None) slots)
+
+      | Ast.TY_rec entries ->
+          s (Array.map (fun e -> trans_slot None (snd e)) entries)
+
+      | Ast.TY_constrained (ty', _) -> trans_ty ty'
+
+      | Ast.TY_chan _ | Ast.TY_port _ | Ast.TY_task  ->
+          p rc_opaque_ty
+
+      | Ast.TY_native _ ->
+          word_ty
+
+      | Ast.TY_tag _ | Ast.TY_iso _ | Ast.TY_idx _
+      | Ast.TY_obj _ | Ast.TY_type -> (opaque()) (* TODO *)
+
+      | Ast.TY_param _ | Ast.TY_named _ ->
+          bug () "unresolved type in lltrans"
+
+  and trans_ty t =
+    htab_search_or_add lltys t (fun _ -> trans_ty_full t)
+
+  (* Translates the type of a slot into the corresponding LLVM type. If the
+   * id_opt parameter is specified, then the type will be fetched from the
+   * context. *)
+  and trans_slot (id_opt:node_id option) (slot:Ast.slot) : Llvm.lltype =
+    let ty =
+      match id_opt with
+          Some id -> ty_of_slot id
+        | None -> Semant.slot_ty slot
+    in
+    let base_llty = trans_ty ty in
+      match slot.Ast.slot_mode with
+          Ast.MODE_exterior _
+        | Ast.MODE_alias _ ->
+            Llvm.pointer_type base_llty
+        | Ast.MODE_interior _ -> base_llty
+  in
+
+  let get_element_ptr
+      (llbuilder:Llvm.llbuilder)
+      (ptr:Llvm.llvalue)
+      (i:int)
+      : Llvm.llvalue =
+    (* 
+     * GEP takes a first-index of zero. Because it must! And this is
+     * sufficiently surprising that the GEP FAQ exists. And you must
+     * read it.
+     *)
+    let deref_ptr = Llvm.const_int (Llvm.i32_type llctx) 0 in
+    let idx = Llvm.const_int (Llvm.i32_type llctx) i in
+      Llvm.build_gep ptr [| deref_ptr; idx |] (anon_llid "gep") llbuilder
+  in
+
+  let free_ty
+      (llbuilder:Llvm.llbuilder)
+      (lltask:Llvm.llvalue)
+      (ty:Ast.ty)
+      (ptr:Llvm.llvalue)
+      : unit =
+    match ty with
+        Ast.TY_port _
+      | Ast.TY_chan _
+      | Ast.TY_task -> bug () "unimplemented ty in Lltrans.free_ty"
+      | _ -> trans_free llbuilder lltask ptr
+  in
+
+  let rec iter_ty_slots_full
+      (llbuilder:Llvm.llbuilder ref)
+      (ty:Ast.ty)
+      (dst_ptr:Llvm.llvalue)
+      (src_ptr:Llvm.llvalue)
+      (f:(Llvm.llvalue
+          -> Llvm.llvalue
+            -> Ast.slot
+              -> (Ast.ty_iso option)
+                -> unit))
+      (curr_iso:Ast.ty_iso option)
+      : unit =
+
+    (* NB: must deref llbuilder at call-time; don't curry this. *)
+    let gep p i = get_element_ptr (!llbuilder) p i in
+
+    match ty with
+        Ast.TY_rec entries ->
+          iter_rec_slots gep dst_ptr src_ptr entries f curr_iso
+
+      | Ast.TY_tup slots ->
+          iter_tup_slots gep dst_ptr src_ptr slots f curr_iso
+
+      | Ast.TY_tag _
+      | Ast.TY_iso _
+      | Ast.TY_fn _
+      | Ast.TY_obj _ ->
+          bug () "unimplemented ty in Lltrans.iter_ty_slots_full"
+
+      | _ -> ()
+
+  and iter_ty_slots
+      (llbuilder:Llvm.llbuilder ref)
+      (ty:Ast.ty)
+      (ptr:Llvm.llvalue)
+      (f:Llvm.llvalue -> Ast.slot -> (Ast.ty_iso option) -> unit)
+      (curr_iso:Ast.ty_iso option)
+      : unit =
+    iter_ty_slots_full llbuilder ty ptr ptr
+      (fun _ src_ptr slot curr_iso -> f src_ptr slot curr_iso)
+      curr_iso
+
+  and drop_ty
+      (llbuilder:Llvm.llbuilder ref)
+      (lltask:Llvm.llvalue)
+      (ty:Ast.ty)
+      (ptr:Llvm.llvalue)
+      (curr_iso:Ast.ty_iso option)
+      : unit =
+    iter_ty_slots llbuilder ty ptr (drop_slot llbuilder lltask) curr_iso
+
+  and drop_slot
+      (llbuilder:Llvm.llbuilder ref)
+      (lltask:Llvm.llvalue)
+      (slot_ptr:Llvm.llvalue)
+      (slot:Ast.slot)
+      (curr_iso:Ast.ty_iso option)
+      : unit =
+
+    let llfn = Llvm.block_parent (Llvm.insertion_block (!llbuilder)) in
+    let llty = trans_slot None slot in
+    let ty = Semant.slot_ty slot in
+
+    let new_block klass =
+      let llblock = Llvm.append_block llctx (anon_llid klass) llfn in
+      let llbuilder = Llvm.builder_at_end llctx llblock in
+        (llblock, llbuilder)
+    in
+
+    let if_ptr_in_slot_not_null
+        (inner:Llvm.llvalue -> Llvm.llbuilder -> Llvm.llbuilder)
+        (llbuilder:Llvm.llbuilder)
+        : Llvm.llbuilder =
+      let ptr = Llvm.build_load slot_ptr (anon_llid "tmp") llbuilder in
+      let null = Llvm.const_pointer_null llty in
+      let test =
+        Llvm.build_icmp Llvm.Icmp.Ne null ptr (anon_llid "nullp") llbuilder
+      in
+      let (llthen, llthen_builder) = new_block "then" in
+      let (llnext, llnext_builder) = new_block "next" in
+        ignore (Llvm.build_cond_br test llthen llnext llbuilder);
+        let llthen_builder = inner ptr llthen_builder in
+          ignore (Llvm.build_br llnext llthen_builder);
+          llnext_builder
+    in
+
+    let decr_refcnt_and_if_zero
+        (rc_elt:int)
+        (inner:Llvm.llvalue -> Llvm.llbuilder -> Llvm.llbuilder)
+        (ptr:Llvm.llvalue)
+        (llbuilder:Llvm.llbuilder)
+        : Llvm.llbuilder  =
+      let rc_ptr = get_element_ptr llbuilder ptr rc_elt in
+      let rc = Llvm.build_load rc_ptr (anon_llid "rc") llbuilder in
+      let rc = Llvm.build_sub rc (imm 1L) (anon_llid "tmp") llbuilder in
+      let _ = Llvm.build_store rc rc_ptr llbuilder in
+        log sem_cx "rc type: %s" (llval_str rc);
+      let test =
+        Llvm.build_icmp Llvm.Icmp.Eq
+          rc (imm 0L) (anon_llid "zerop") llbuilder
+      in
+      let (llthen, llthen_builder) = new_block "then" in
+      let (llnext, llnext_builder) = new_block "next" in
+        ignore (Llvm.build_cond_br test llthen llnext llbuilder);
+        let llthen_builder = inner ptr llthen_builder in
+          ignore (Llvm.build_br llnext llthen_builder);
+          llnext_builder
+    in
+
+    let free_and_null_out_slot
+        (ptr:Llvm.llvalue)
+        (llbuilder:Llvm.llbuilder)
+        : Llvm.llbuilder =
+      free_ty llbuilder lltask ty ptr;
+      let null = Llvm.const_pointer_null llty in
+        ignore (Llvm.build_store null slot_ptr llbuilder);
+        llbuilder
+    in
+
+      begin
+          match slot_mem_ctrl slot with
+              MEM_rc_struct
+            | MEM_gc ->
+                llbuilder :=
+                  if_ptr_in_slot_not_null
+                    (decr_refcnt_and_if_zero
+                       Abi.exterior_rc_slot_field_refcnt
+                       free_and_null_out_slot)
+                    (!llbuilder)
+
+            | MEM_rc_opaque ->
+                llbuilder :=
+                  if_ptr_in_slot_not_null
+                    (decr_refcnt_and_if_zero
+                       Abi.exterior_rc_slot_field_refcnt
+                       free_and_null_out_slot)
+                    (!llbuilder)
+
+            | MEM_interior when Semant.type_is_structured ty ->
+                (* FIXME: to handle recursive types, need to call drop
+                   glue here, not inline. *)
+                drop_ty llbuilder lltask ty slot_ptr curr_iso
+
+            | _ -> ()
+        end
+  in
+
+  let (llitems:(node_id, Llvm.llvalue) Hashtbl.t) = Hashtbl.create 0 in
+  let declare_mod_item
+      (name:Ast.ident)
+      { node = { Ast.decl_item = (item:Ast.mod_item') }; id = id }
+      : unit =
+    let full_name = Semant.item_str sem_cx id in
+    let line_num =
+      match Session.get_span sess id with
+          None -> 0
+        | Some span ->
+            let (_, line, _) = span.lo in
+              line
+    in
+      match item with
+          Ast.MOD_ITEM_fn _ ->
+            let llty = trans_ty (ty_of_item id) in
+            let llfn = Llvm.declare_function ("_rust_" ^ name) llty llmod in
+            let meta =
+              md_node
+                [|
+                  const_dw_tag Dwarf.DW_TAG_subprogram;
+                  const_i32 0; (* unused *)
+                  const_i32 0; (* context metadata llvalue *)
+                  md_str name;
+                  md_str full_name;
+                  md_str full_name;
+                  const_i32 0; (* file metadata llvalue *)
+                  const_i32 line_num;
+                  const_i32 0; (* type descriptor metadata llvalue *)
+                  const_i1 1;  (* flag: local to compile unit? *)
+                  const_i1 1;  (* flag: defined in compile unit? *)
+                |]
+            in
+              Llvm.set_function_call_conv Llvm.CallConv.c llfn;
+              Hashtbl.add llitems id llfn;
+
+              (* FIXME: Adding metadata does not work yet. . *)
+              let _ = fun _ -> set_dbg_metadata llfn meta in
+                ()
+
+        | _ -> () (* TODO *)
+  in
+
+  let trans_fn
+      ({
+        Ast.fn_input_slots = (header_slots:Ast.header_slots);
+        Ast.fn_body = (body:Ast.block)
+      }:Ast.fn)
+      (fn_id:node_id)
+      : unit =
+    let llfn = Hashtbl.find llitems fn_id in
+    let lloutptr = Llvm.param llfn 0 in
+    let lltask = Llvm.param llfn 1 in
+
+    (* LLVM requires that functions be grouped into basic blocks terminated by
+     * terminator instructions, while our AST is less strict. So we have to do
+     * a little trickery here to wrangle the statement sequence into LLVM's
+     * format. *)
+
+    let new_block id_opt klass =
+      let llblock = Llvm.append_block llctx (node_llid id_opt klass) llfn in
+      let llbuilder = Llvm.builder_at_end llctx llblock in
+      (llblock, llbuilder)
+    in
+
+    (* Build up the slot-to-llvalue mapping, allocating space along the
+     * way. *)
+    let slot_to_llvalue = Hashtbl.create 0 in
+    let (_, llinitbuilder) = new_block None "init" in
+
+    (* Allocate space for arguments (needed because arguments are lvalues in
+     * Rust), and store them in the slot-to-llvalue mapping. *)
+    let n_implicit_args = 2 in
+    let build_arg idx llargval =
+      if idx >= n_implicit_args
+      then
+        let ({ id = id }, ident) = header_slots.(idx - 2) in
+        Llvm.set_value_name ident llargval;
+        let llarg =
+          let llty = Llvm.type_of llargval in
+          Llvm.build_alloca llty (ident ^ "_ptr") llinitbuilder
+        in
+        ignore (Llvm.build_store llargval llarg llinitbuilder);
+        Hashtbl.add slot_to_llvalue id llarg
+    in
+    Array.iteri build_arg (Llvm.params llfn);
+
+    (* Allocate space for all the blocks' slots.
+     * and zero the exteriors. *)
+    let init_block (block_id:node_id) : unit =
+      let init_slot
+          (key:Ast.slot_key)
+          (slot_id:node_id)
+          (slot:Ast.slot)
+          : unit =
+        let name = Ast.sprintf_slot_key () key in
+        let llty = trans_slot (Some slot_id) slot in
+        let llptr = Llvm.build_alloca llty name llinitbuilder in
+          begin
+            match slot_mem_ctrl slot with
+                MEM_rc_struct
+              | MEM_rc_opaque
+              | MEM_gc ->
+                  ignore (Llvm.build_store
+                            (Llvm.const_pointer_null llty)
+                            llptr llinitbuilder);
+              | _ -> ()
+          end;
+          Hashtbl.add slot_to_llvalue slot_id llptr
+      in
+        iter_block_slots sem_cx block_id init_slot
+    in
+
+    let exit_block
+        (llbuilder:Llvm.llbuilder)
+        (block_id:node_id)
+        : Llvm.llbuilder =
+      let r = ref llbuilder in
+        iter_block_slots sem_cx block_id
+          begin
+            fun _ slot_id slot ->
+              if (not (Semant.slot_is_obj_state sem_cx slot_id))
+              then
+                let ptr = Hashtbl.find slot_to_llvalue slot_id in
+                  drop_slot r lltask ptr slot None
+          end;
+        !r
+    in
+
+    List.iter init_block (Hashtbl.find sem_cx.Semant.ctxt_frame_blocks fn_id);
+
+    let static_str (s:string) : Llvm.llvalue =
+      Llvm.define_global (anon_llid "str") (Llvm.const_stringz llctx s) llmod
+    in
+
+
+    (* Translates a list of AST statements to a sequence of LLVM instructions.
+     * The supplied "terminate" function appends the appropriate terminator
+     * instruction to the instruction stream. It may or may not be called,
+     * depending on whether the AST contains a terminating instruction
+     * explicitly. *)
+    let rec trans_stmts
+        (block_id:node_id)
+        (llbuilder:Llvm.llbuilder)
+        (stmts:Ast.stmt list)
+        (terminate:(Llvm.llbuilder -> node_id -> unit))
+        : unit =
+      let trans_literal
+          (lit:Ast.lit)
+          : Llvm.llvalue =
+        match lit with
+            Ast.LIT_nil -> llnil
+          | Ast.LIT_bool value ->
+            Llvm.const_int (Llvm.i1_type llctx) (if value then 1 else 0)
+          | Ast.LIT_mach (mty, value, _) ->
+            let llty = trans_mach_ty mty in
+            Llvm.const_of_int64 llty value (mach_is_signed mty)
+          | Ast.LIT_int (value, _) ->
+            Llvm.const_of_int64 (Llvm.i32_type llctx) value true
+          | Ast.LIT_uint (value, _) ->
+            Llvm.const_of_int64 (Llvm.i32_type llctx) value false
+          | Ast.LIT_char ch ->
+            Llvm.const_int (Llvm.i32_type llctx) ch
+      in
+
+      (* Translates an lval by reference into the appropriate pointer
+       * value. *)
+      let trans_lval (lval:Ast.lval) : Llvm.llvalue =
+        iflog (fun _ -> log sem_cx "trans_lval: %a" Ast.sprintf_lval lval);
+        match lval with
+            Ast.LVAL_base { id = base_id } ->
+              let id =
+                Hashtbl.find sem_cx.Semant.ctxt_lval_to_referent base_id
+              in
+              let referent = Hashtbl.find sem_cx.Semant.ctxt_all_defns id in
+              begin
+                match referent with
+                    Semant.DEFN_slot _ -> Hashtbl.find slot_to_llvalue id
+                  | Semant.DEFN_item _ -> Hashtbl.find llitems id
+                  | _ -> bogus_ptr (* TODO *)
+              end
+          | Ast.LVAL_ext _ -> bogus_ptr (* TODO *)
+      in
+
+      let trans_atom (atom:Ast.atom) : Llvm.llvalue =
+        iflog (fun _ -> log sem_cx "trans_atom: %a" Ast.sprintf_atom atom);
+        match atom with
+            Ast.ATOM_literal { node = lit } -> trans_literal lit
+          | Ast.ATOM_lval lval ->
+              Llvm.build_load (trans_lval lval) (anon_llid "tmp") llbuilder
+      in
+
+      let trans_binary_expr
+          ((op:Ast.binop), (lhs:Ast.atom), (rhs:Ast.atom))
+          : Llvm.llvalue =
+        (* Evaluate the operands in the proper order. *)
+        let (lllhs, llrhs) =
+          match op with
+              Ast.BINOP_or | Ast.BINOP_and | Ast.BINOP_eq | Ast.BINOP_ne
+                  | Ast.BINOP_lt | Ast.BINOP_le | Ast.BINOP_ge | Ast.BINOP_gt
+                  | Ast.BINOP_lsl | Ast.BINOP_lsr | Ast.BINOP_asr
+                  | Ast.BINOP_add | Ast.BINOP_sub | Ast.BINOP_mul
+                  | Ast.BINOP_div | Ast.BINOP_mod | Ast.BINOP_xor ->
+                (trans_atom lhs, trans_atom rhs)
+            | Ast.BINOP_send ->
+                let llrhs = trans_atom rhs in
+                let lllhs = trans_atom lhs in
+                (lllhs, llrhs)
+        in
+        let llid = anon_llid "expr" in
+        match op with
+            Ast.BINOP_eq ->
+              (* TODO: equality works on more than just integers *)
+              Llvm.build_icmp Llvm.Icmp.Eq lllhs llrhs llid llbuilder
+
+            (* TODO: signed/unsigned distinction, floating point *)
+          | Ast.BINOP_add -> Llvm.build_add lllhs llrhs llid llbuilder
+          | Ast.BINOP_sub -> Llvm.build_sub lllhs llrhs llid llbuilder
+          | Ast.BINOP_mul -> Llvm.build_mul lllhs llrhs llid llbuilder
+          | Ast.BINOP_div -> Llvm.build_sdiv lllhs llrhs llid llbuilder
+          | Ast.BINOP_mod -> Llvm.build_srem lllhs llrhs llid llbuilder
+
+          | _ -> bogus (* TODO *)
+      in
+
+      let trans_unary_expr _ = bogus in (* TODO *)
+
+      let trans_expr (expr:Ast.expr) : Llvm.llvalue =
+        iflog (fun _ -> log sem_cx "trans_expr: %a" Ast.sprintf_expr expr);
+        match expr with
+            Ast.EXPR_binary binexp -> trans_binary_expr binexp
+          | Ast.EXPR_unary unexp -> trans_unary_expr unexp
+          | Ast.EXPR_atom atom -> trans_atom atom
+      in
+
+      let trans_log_str (atom:Ast.atom) : unit =
+        upcall llbuilder lltask "upcall_log_str" None [| trans_atom atom |]
+      in
+
+      let trans_log_int (atom:Ast.atom) : unit =
+        upcall llbuilder lltask "upcall_log_int" None [| trans_atom atom |]
+      in
+
+      let trans_fail
+          (llbuilder:Llvm.llbuilder)
+          (lltask:Llvm.llvalue)
+          (reason:string)
+          (stmt_id:node_id)
+          : unit =
+        let (file, line, _) =
+          match Session.get_span sem_cx.Semant.ctxt_sess stmt_id with
+              None -> ("<none>", 0, 0)
+            | Some sp -> sp.lo
+        in
+        upcall llbuilder lltask "upcall_fail" None [|
+          static_str reason;
+          static_str file;
+          Llvm.const_int (Llvm.i32_type llctx) line
+        |];
+        ignore (Llvm.build_unreachable llbuilder)
+      in
+
+      (* FIXME: this may be irrelevant; possibly LLVM will wind up
+       * using GOT and such wherever it needs to to achieve PIC
+       * data.
+       *)
+      (*
+        let crate_rel (v:Llvm.llvalue) : Llvm.llvalue =
+        let v_int = Llvm.const_pointercast v word_ty in
+        let c_int = Llvm.const_pointercast crate_ptr word_ty in
+        Llvm.const_sub v_int c_int
+        in
+      *)
+
+      match stmts with
+          [] -> terminate llbuilder block_id
+        | head::tail ->
+
+            iflog (fun _ ->
+                     log sem_cx "trans_stmt: %a" Ast.sprintf_stmt head);
+
+            let trans_tail_with_builder llbuilder' : unit =
+              trans_stmts block_id llbuilder' tail terminate
+            in
+            let trans_tail () = trans_tail_with_builder llbuilder in
+
+            match head.node with
+                Ast.STMT_init_tup (dest, atoms) ->
+                  let zero = const_i32 0 in
+                  let lldest = trans_lval dest in
+                  let trans_tup_atom idx (_, _, atom) =
+                    let indices = [| zero; const_i32 idx |] in
+                    let gep_id = anon_llid "init_tup_gep" in
+                    let ptr =
+                      Llvm.build_gep lldest indices gep_id llbuilder
+                    in
+                    ignore (Llvm.build_store (trans_atom atom) ptr llbuilder)
+                  in
+                  Array.iteri trans_tup_atom atoms;
+                  trans_tail ()
+
+              | Ast.STMT_copy (dest, src) ->
+                  let llsrc = trans_expr src in
+                  let lldest = trans_lval dest in
+                  ignore (Llvm.build_store llsrc lldest llbuilder);
+                  trans_tail ()
+
+              | Ast.STMT_call (dest, fn, args) ->
+                  let llargs = Array.map trans_atom args in
+                  let lldest = trans_lval dest in
+                  let llfn = trans_lval fn in
+                  let llallargs = Array.append [| lldest; lltask |] llargs in
+                  let llrv = build_call llfn llallargs "" llbuilder in
+                    Llvm.set_instruction_call_conv Llvm.CallConv.c llrv;
+                    trans_tail ()
+
+              | Ast.STMT_if sif ->
+                  let llexpr = trans_expr sif.Ast.if_test in
+                  let (llnext, llnextbuilder) = new_block None "next" in
+                  let branch_to_next llbuilder' _ =
+                    ignore (Llvm.build_br llnext llbuilder')
+                  in
+                  let llthen = trans_block sif.Ast.if_then branch_to_next in
+                  let llelse =
+                    match sif.Ast.if_else with
+                        None -> llnext
+                      | Some if_else -> trans_block if_else branch_to_next
+                  in
+                  ignore (Llvm.build_cond_br llexpr llthen llelse llbuilder);
+                  trans_tail_with_builder llnextbuilder
+
+              | Ast.STMT_ret atom_opt ->
+                  begin
+                    match atom_opt with
+                        None -> ()
+                      | Some atom ->
+                          ignore (Llvm.build_store (trans_atom atom)
+                                    lloutptr llbuilder)
+                  end;
+                  let llbuilder = exit_block llbuilder block_id in
+                    ignore (Llvm.build_ret_void llbuilder)
+
+              | Ast.STMT_fail ->
+                  trans_fail llbuilder lltask "explicit failure" head.id
+
+              | Ast.STMT_log a ->
+                  begin
+                    match Semant.atom_type sem_cx a with
+                        (* NB: If you extend this, be sure to update the
+                         * typechecking code in type.ml as well. *)
+                        Ast.TY_str -> trans_log_str a
+                      | Ast.TY_int | Ast.TY_uint | Ast.TY_bool | Ast.TY_char
+                      | Ast.TY_mach (TY_u8) | Ast.TY_mach (TY_u16)
+                      | Ast.TY_mach (TY_u32) | Ast.TY_mach (TY_i8)
+                      | Ast.TY_mach (TY_i16) | Ast.TY_mach (TY_i32) ->
+                          trans_log_int a
+                      | _ -> Semant.bugi sem_cx head.id
+                          "unimplemented logging type"
+                  end;
+                  trans_tail ()
+
+              | Ast.STMT_check_expr expr ->
+                  let llexpr = trans_expr expr in
+                  let (llfail, llfailbuilder) = new_block None "fail" in
+                  let reason = Ast.fmt_to_str Ast.fmt_expr expr in
+                  trans_fail llfailbuilder lltask reason head.id;
+                  let (llok, llokbuilder) = new_block None "ok" in
+                  ignore (Llvm.build_cond_br llexpr llok llfail llbuilder);
+                  trans_tail_with_builder llokbuilder
+
+              | Ast.STMT_init_str (dst, str) ->
+                  let d = trans_lval dst in
+                  let s = static_str str in
+                  let len =
+                    Llvm.const_int word_ty ((String.length str) + 1)
+                  in
+                    upcall llbuilder lltask "upcall_new_str"
+                      (Some d) [| s; len |];
+                    trans_tail ()
+
+              | _ -> trans_stmts block_id llbuilder tail terminate
+
+    (* 
+     * Translates an AST block to one or more LLVM basic blocks and returns
+     * the first basic block. The supplied callback is expected to add a
+     * terminator instruction.
+     *)
+
+    and trans_block
+        ({ node = (stmts:Ast.stmt array); id = id }:Ast.block)
+        (terminate:Llvm.llbuilder -> node_id -> unit)
+        : Llvm.llbasicblock =
+      let (llblock, llbuilder) = new_block (Some id) "bb" in
+        trans_stmts id llbuilder (Array.to_list stmts) terminate;
+        llblock
+    in
+
+    (* "Falling off the end" of a function needs to turn into an explicit
+     * return instruction. *)
+    let default_terminate llbuilder block_id =
+      let llbuilder = exit_block llbuilder block_id in
+        ignore (Llvm.build_ret_void llbuilder)
+    in
+
+    (* Build up the first body block, and link it to the end of the
+     * initialization block. *)
+    let llbodyblock = (trans_block body default_terminate) in
+      ignore (Llvm.build_br llbodyblock llinitbuilder)
+  in
+
+  let trans_mod_item
+      (_:Ast.ident)
+      { node = { Ast.decl_item = (item:Ast.mod_item') }; id = id }
+      : unit =
+    match item with
+        Ast.MOD_ITEM_fn fn -> trans_fn fn id
+      | _ -> ()
+  in
+
+  let exit_task_glue =
+    (* The exit-task glue does not get called.
+     * 
+     * Rather, control arrives at it by *returning* to the first
+     * instruction of it, when control falls off the end of the task's
+     * root function.
+     * 
+     * There is a "fake" frame set up by the runtime, underneath us,
+     * that we find ourselves in. This frame has the shape of a frame
+     * entered with 2 standard arguments (outptr + taskptr), then a
+     * retpc and N callee-saves sitting on the stack; all this is under
+     * ebp. Then there are 2 *outgoing* args at sp[0] and sp[1].
+     * 
+     * All these are fake except the taskptr, which is the one bit we
+     * want. So we construct an equally fake cdecl llvm signature here
+     * to crudely *get* the taskptr that's sitting 2 words up from sp,
+     * and pass it to upcall_exit.
+     * 
+     * The latter never returns.
+     *)
+    let llty = fn_ty void_ty [| task_ptr_ty |] in
+    let llfn = Llvm.declare_function "rust_exit_task_glue" llty llmod in
+    let lltask = Llvm.param llfn 0 in
+    let llblock = Llvm.append_block llctx "body" llfn in
+    let llbuilder = Llvm.builder_at_end llctx llblock in
+      trans_upcall llbuilder lltask "upcall_exit" None [||];
+      ignore (Llvm.build_ret_void llbuilder);
+      llfn
+  in
+
+    try
+      let crate' = crate.node in
+      let items = snd (crate'.Ast.crate_items) in
+        Hashtbl.iter declare_mod_item items;
+        Hashtbl.iter trans_mod_item items;
+        Llfinal.finalize_module
+          llctx llmod abi asm_glue exit_task_glue crate_ptr;
+        llmod
+    with e -> Llvm.dispose_module llmod; raise e
+;;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)
+

src/boot/me/alias.ml

@@ -0,0 +1,134 @@
+open Semant;;
+open Common;;
+
+let log cx = Session.log "alias"
+  cx.ctxt_sess.Session.sess_log_alias
+  cx.ctxt_sess.Session.sess_log_out
+;;
+
+let alias_analysis_visitor
+    (cx:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+  let curr_stmt = Stack.create () in
+
+  let alias_slot (slot_id:node_id) : unit =
+    begin
+      log cx "noting slot #%d as aliased" (int_of_node slot_id);
+      Hashtbl.replace cx.ctxt_slot_aliased slot_id ()
+    end
+  in
+
+  let alias lval =
+    match lval with
+        Ast.LVAL_base nb ->
+          let referent = Hashtbl.find cx.ctxt_lval_to_referent nb.id in
+            if (referent_is_slot cx referent)
+            then alias_slot referent
+      | _ -> err None "unhandled form of lval %a in alias analysis"
+          Ast.sprintf_lval lval
+  in
+
+  let alias_atom at =
+    match at with
+        Ast.ATOM_lval lv -> alias lv
+      | _ -> err None "aliasing literal"
+  in
+
+  let alias_call_args dst callee args =
+    alias dst;
+    let callee_ty = lval_ty cx callee in
+      match callee_ty with
+          Ast.TY_fn (tsig,_) ->
+            Array.iteri
+              begin
+                fun i slot ->
+                  match slot.Ast.slot_mode with
+                      Ast.MODE_alias _ ->
+                        alias_atom args.(i)
+                    | _ -> ()
+              end
+              tsig.Ast.sig_input_slots
+        | _ -> ()
+  in
+
+  let visit_stmt_pre s =
+    Stack.push s.id curr_stmt;
+    begin
+      try
+        match s.node with
+            (* FIXME (issue #26): actually all these *existing* cases
+             * can probably go now that we're using Trans.aliasing to
+             * form short-term spill-based aliases. Only aliases that
+             * survive 'into' a sub-block (those formed during iteration)
+             * need to be handled in this module.  *)
+            Ast.STMT_call (dst, callee, args)
+          | Ast.STMT_spawn (dst, _, callee, args)
+            -> alias_call_args dst callee args
+
+          | Ast.STMT_send (_, src) -> alias src
+          | Ast.STMT_recv (dst, _) -> alias dst
+          | Ast.STMT_init_port (dst) -> alias dst
+          | Ast.STMT_init_chan (dst, _) -> alias dst
+          | Ast.STMT_init_vec (dst, _, _) -> alias dst
+          | Ast.STMT_init_str (dst, _) -> alias dst
+          | Ast.STMT_for_each sfe ->
+              let (slot, _) = sfe.Ast.for_each_slot in
+                alias_slot slot.id
+          | _ -> () (* FIXME (issue #29): plenty more to handle here. *)
+      with
+          Semant_err (None, msg) ->
+            raise (Semant_err ((Some s.id), msg))
+    end;
+    inner.Walk.visit_stmt_pre s
+  in
+  let visit_stmt_post s =
+    inner.Walk.visit_stmt_post s;
+    ignore (Stack.pop curr_stmt);
+  in
+
+  let visit_lval_pre lv =
+    let slot_id = lval_to_referent cx (lval_base_id lv) in
+      if (not (Stack.is_empty curr_stmt)) && (referent_is_slot cx slot_id)
+      then
+        begin
+          let slot_depth = get_slot_depth cx slot_id in
+          let stmt_depth = get_stmt_depth cx (Stack.top curr_stmt) in
+            if slot_depth <> stmt_depth
+            then
+              begin
+                let _ = assert (slot_depth < stmt_depth) in
+                  alias_slot slot_id
+              end
+        end
+  in
+
+    { inner with
+        Walk.visit_stmt_pre = visit_stmt_pre;
+        Walk.visit_stmt_post = visit_stmt_post;
+        Walk.visit_lval_pre = visit_lval_pre
+    }
+;;
+
+let process_crate
+    (cx:ctxt)
+    (crate:Ast.crate)
+    : unit =
+  let path = Stack.create () in
+  let passes =
+    [|
+      (alias_analysis_visitor cx
+         Walk.empty_visitor);
+    |]
+  in
+    run_passes cx "alias" path passes (log cx "%s") crate
+;;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/me/dead.ml

@@ -0,0 +1,121 @@
+(* 
+ * A simple dead-code analysis that rejects code following unconditional
+ * 'ret' or 'be'. 
+ *)
+
+open Semant;;
+open Common;;
+
+let log cx = Session.log "dead"
+  cx.ctxt_sess.Session.sess_log_dead
+  cx.ctxt_sess.Session.sess_log_out
+;;
+
+let dead_code_visitor
+    ((*cx*)_:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+
+  (* FIXME: create separate table for each fn body for less garbage *)
+  let must_exit = Hashtbl.create 100 in
+
+  let all_must_exit ids =
+    arr_for_all (fun _ id -> Hashtbl.mem must_exit id) ids
+  in
+
+  let visit_block_post block =
+    let stmts = block.node in
+    let len = Array.length stmts in
+      if len > 0 then
+        Array.iteri
+          begin
+            fun i s ->
+              if (i < (len - 1)) && (Hashtbl.mem must_exit s.id) then
+                err (Some stmts.(i + 1).id) "dead statement"
+          end
+          stmts;
+      inner.Walk.visit_block_post block
+  in
+
+  let visit_stmt_post s =
+    begin
+      match s.node with
+        | Ast.STMT_block block ->
+            if Hashtbl.mem must_exit block.id then
+              Hashtbl.add must_exit s.id ()
+
+        | Ast.STMT_while { Ast.while_body = body }
+        | Ast.STMT_do_while { Ast.while_body = body }
+        | Ast.STMT_for_each { Ast.for_each_body = body }
+        | Ast.STMT_for { Ast.for_body = body } ->
+            if (Hashtbl.mem must_exit body.id) then
+              Hashtbl.add must_exit s.id ()
+
+        | Ast.STMT_if { Ast.if_then = b1; Ast.if_else = Some b2 } ->
+            if (Hashtbl.mem must_exit b1.id) && (Hashtbl.mem must_exit b2.id)
+            then Hashtbl.add must_exit s.id ()
+
+        | Ast.STMT_if _ -> ()
+
+        | Ast.STMT_ret _
+        | Ast.STMT_be _ ->
+            Hashtbl.add must_exit s.id ()
+
+        | Ast.STMT_alt_tag { Ast.alt_tag_arms = arms } ->
+            let arm_ids =
+              Array.map (fun { node = (_, block) } -> block.id) arms
+            in
+              if all_must_exit arm_ids
+              then Hashtbl.add must_exit s.id ()
+
+        | Ast.STMT_alt_type { Ast.alt_type_arms = arms;
+                              Ast.alt_type_else = alt_type_else } ->
+            let arm_ids = Array.map (fun (_, _, block) -> block.id) arms in
+            let else_ids =
+              begin
+                match alt_type_else with
+                    Some stmt -> [| stmt.id |]
+                  | None -> [| |]
+              end
+            in
+              if all_must_exit (Array.append arm_ids else_ids) then
+                Hashtbl.add must_exit s.id ()
+
+        (* FIXME: figure this one out *)
+        | Ast.STMT_alt_port _ -> ()
+
+        | _ -> ()
+    end;
+    inner.Walk.visit_stmt_post s
+
+  in
+    { inner with
+        Walk.visit_block_post = visit_block_post;
+        Walk.visit_stmt_post = visit_stmt_post }
+;;
+
+let process_crate
+    (cx:ctxt)
+    (crate:Ast.crate)
+    : unit =
+  let path = Stack.create () in
+  let passes =
+    [|
+      (dead_code_visitor cx
+         Walk.empty_visitor)
+    |]
+  in
+
+    run_passes cx "dead" path passes (log cx "%s") crate;
+    ()
+;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/me/effect.ml

@@ -0,0 +1,313 @@
+open Semant;;
+open Common;;
+
+let log cx = Session.log "effect"
+  cx.ctxt_sess.Session.sess_log_effect
+  cx.ctxt_sess.Session.sess_log_out
+;;
+
+let iflog cx thunk =
+  if cx.ctxt_sess.Session.sess_log_effect
+  then thunk ()
+  else ()
+;;
+
+let mutability_checking_visitor
+    (cx:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+  (* 
+   * This visitor enforces the following rules:
+   * 
+   * - A channel type carrying a mutable type is illegal.
+   * 
+   * - Writing to an immutable slot is illegal.
+   * 
+   * - Forming a mutable alias to an immutable slot is illegal.
+   * 
+   *)
+  let visit_ty_pre t =
+    match t with
+        Ast.TY_chan t' when type_has_state t' ->
+          err None "channel of mutable type: %a " Ast.sprintf_ty t'
+      | _ -> ()
+  in
+
+  let check_write id dst =
+    let dst_slot = lval_slot cx dst in
+      if (dst_slot.Ast.slot_mutable or
+            (Hashtbl.mem cx.ctxt_copy_stmt_is_init id))
+      then ()
+      else err (Some id) "writing to non-mutable slot"
+  in
+    (* FIXME: enforce the no-write-alias-to-immutable-slot rule. *)
+  let visit_stmt_pre s =
+    begin
+      match s.node with
+          Ast.STMT_copy (dst, _) -> check_write s.id dst
+        | Ast.STMT_copy_binop (dst, _, _) -> check_write s.id dst
+        | Ast.STMT_call (dst, _, _) -> check_write s.id dst
+        | Ast.STMT_recv (dst, _) -> check_write s.id dst
+        | _ -> ()
+    end;
+    inner.Walk.visit_stmt_pre s
+  in
+
+    { inner with
+        Walk.visit_ty_pre = visit_ty_pre;
+        Walk.visit_stmt_pre = visit_stmt_pre }
+;;
+
+let function_effect_propagation_visitor
+    (item_effect:(node_id, Ast.effect) Hashtbl.t)
+    (cx:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+  (* 
+   * This visitor calculates the effect of each function according to
+   * its statements:
+   * 
+   *    - Communication lowers to 'io'
+   *    - Native calls lower to 'unsafe'
+   *    - Calling a function with effect e lowers to e.
+   *)
+  let curr_fn = Stack.create () in
+  let visit_mod_item_pre n p i =
+    begin
+      match i.node.Ast.decl_item with
+          Ast.MOD_ITEM_fn _ -> Stack.push i.id curr_fn
+        | _ -> ()
+    end;
+    inner.Walk.visit_mod_item_pre n p i
+  in
+  let visit_mod_item_post n p i =
+    inner.Walk.visit_mod_item_post n p i;
+    match i.node.Ast.decl_item with
+        Ast.MOD_ITEM_fn _ -> ignore (Stack.pop curr_fn)
+      | _ -> ()
+  in
+  let visit_obj_drop_pre o b =
+    Stack.push b.id curr_fn;
+    inner.Walk.visit_obj_drop_pre o b
+  in
+  let visit_obj_drop_post o b =
+    inner.Walk.visit_obj_drop_post o b;
+    ignore (Stack.pop curr_fn);
+  in
+
+  let lower_to s ne =
+    let fn_id = Stack.top curr_fn in
+    let e =
+      match htab_search item_effect fn_id with
+          None -> Ast.PURE
+        | Some e -> e
+    in
+    let ne = lower_effect_of ne e in
+      if ne <> e
+      then
+        begin
+          iflog cx
+            begin
+              fun _ ->
+                let name = Hashtbl.find cx.ctxt_all_item_names fn_id in
+                  log cx "lowering calculated effect on '%a': '%a' -> '%a'"
+                    Ast.sprintf_name name
+                    Ast.sprintf_effect e
+                    Ast.sprintf_effect ne;
+                  log cx "at stmt %a" Ast.sprintf_stmt s
+            end;
+          Hashtbl.replace item_effect fn_id ne
+        end;
+  in
+
+  let visit_stmt_pre s =
+    begin
+      match s.node with
+          Ast.STMT_send _
+        | Ast.STMT_recv _ -> lower_to s Ast.IO
+
+        | Ast.STMT_call (_, fn, _) ->
+            let lower_to_callee_ty t =
+              match t with
+                  Ast.TY_fn (_, taux) ->
+                    lower_to s taux.Ast.fn_effect;
+                | _ -> bug () "non-fn callee"
+            in
+              if lval_is_slot cx fn
+              then
+                let t = lval_slot cx fn in
+                  lower_to_callee_ty (slot_ty t)
+              else
+                begin
+                  let item = lval_item cx fn in
+                  let t = Hashtbl.find cx.ctxt_all_item_types item.id in
+                    lower_to_callee_ty t;
+                    match htab_search cx.ctxt_required_items item.id with
+                        None -> ()
+                      | Some (REQUIRED_LIB_rust _, _) -> ()
+                      | Some _ -> lower_to s Ast.UNSAFE
+                end
+        | _ -> ()
+    end;
+    inner.Walk.visit_stmt_pre s
+  in
+
+    { inner with
+        Walk.visit_mod_item_pre = visit_mod_item_pre;
+        Walk.visit_mod_item_post = visit_mod_item_post;
+        Walk.visit_obj_drop_pre = visit_obj_drop_pre;
+        Walk.visit_obj_drop_post = visit_obj_drop_post;
+        Walk.visit_stmt_pre = visit_stmt_pre }
+;;
+
+let binding_effect_propagation_visitor
+    ((*cx*)_:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+  (* This visitor lowers the effect of an object or binding according
+   * to its slots: holding a 'state' slot lowers any obj item, or
+   * bind-stmt LHS, to 'state'.
+   * 
+   * Binding (or implicitly just making a native 1st-class) makes the LHS
+   * unsafe.
+   *)
+  inner
+;;
+
+let effect_checking_visitor
+    (item_auth:(node_id, Ast.effect) Hashtbl.t)
+    (item_effect:(node_id, Ast.effect) Hashtbl.t)
+    (cx:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+  (*
+   * This visitor checks that each type, item and obj declares
+   * effects consistent with what we calculated.
+   *)
+  let auth_stack = Stack.create () in
+  let visit_mod_item_pre n p i =
+    begin
+      match htab_search item_auth i.id with
+          None -> ()
+        | Some e ->
+            let curr =
+              if Stack.is_empty auth_stack
+              then Ast.PURE
+              else Stack.top auth_stack
+            in
+            let next = lower_effect_of e curr in
+              Stack.push next auth_stack;
+              iflog cx
+                begin
+                  fun _ ->
+                    let name = Hashtbl.find cx.ctxt_all_item_names i.id in
+                      log cx
+                        "entering '%a', adjusting auth effect: '%a' -> '%a'"
+                        Ast.sprintf_name name
+                        Ast.sprintf_effect curr
+                        Ast.sprintf_effect next
+                end
+    end;
+    begin
+      match i.node.Ast.decl_item with
+          Ast.MOD_ITEM_fn f ->
+            let e =
+              match htab_search item_effect i.id with
+                None -> Ast.PURE
+              | Some e -> e
+            in
+            let fe = f.Ast.fn_aux.Ast.fn_effect in
+            let ae =
+              if Stack.is_empty auth_stack
+              then None
+              else Some (Stack.top auth_stack)
+            in
+              if e <> fe && (ae <> (Some e))
+              then
+                begin
+                  let name = Hashtbl.find cx.ctxt_all_item_names i.id in
+                    err (Some i.id)
+                      "%a claims effect '%a' but calculated effect is '%a'%s"
+                      Ast.sprintf_name name
+                      Ast.sprintf_effect fe
+                      Ast.sprintf_effect e
+                      begin
+                        match ae with
+                            Some ae when ae <> fe ->
+                              Printf.sprintf " (auth effect is '%a')"
+                                Ast.sprintf_effect ae
+                          | _ -> ""
+                      end
+                end
+        | _ -> ()
+    end;
+    inner.Walk.visit_mod_item_pre n p i
+  in
+  let visit_mod_item_post n p i =
+    inner.Walk.visit_mod_item_post n p i;
+    match htab_search item_auth i.id with
+        None -> ()
+      | Some _ ->
+          let curr = Stack.pop auth_stack in
+          let next =
+            if Stack.is_empty auth_stack
+            then Ast.PURE
+            else Stack.top auth_stack
+          in
+          iflog cx
+            begin
+              fun _ ->
+                let name = Hashtbl.find cx.ctxt_all_item_names i.id in
+                  log cx
+                    "leaving '%a', restoring auth effect: '%a' -> '%a'"
+                    Ast.sprintf_name name
+                    Ast.sprintf_effect curr
+                    Ast.sprintf_effect next
+            end
+  in
+    { inner with
+        Walk.visit_mod_item_pre = visit_mod_item_pre;
+        Walk.visit_mod_item_post = visit_mod_item_post; }
+;;
+
+
+let process_crate
+    (cx:ctxt)
+    (crate:Ast.crate)
+    : unit =
+  let path = Stack.create () in
+  let item_auth = Hashtbl.create 0 in
+  let item_effect = Hashtbl.create 0 in
+  let passes =
+    [|
+      (mutability_checking_visitor cx
+         Walk.empty_visitor);
+      (function_effect_propagation_visitor item_effect cx
+         Walk.empty_visitor);
+      (binding_effect_propagation_visitor cx
+         Walk.empty_visitor);
+      (effect_checking_visitor item_auth item_effect cx
+         Walk.empty_visitor);
+    |]
+  in
+  let root_scope = [ SCOPE_crate crate ] in
+  let auth_effect name eff =
+    match lookup_by_name cx root_scope name with
+        None -> ()
+      | Some (_, id) ->
+          if referent_is_item cx id
+          then htab_put item_auth id eff
+          else err (Some id) "auth clause in crate refers to non-item"
+  in
+    Hashtbl.iter auth_effect crate.node.Ast.crate_auth;
+    run_passes cx "effect" path passes (log cx "%s") crate
+;;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/me/layout.ml

@@ -0,0 +1,470 @@
+open Semant;;
+open Common;;
+
+let log cx = Session.log "layout"
+  cx.ctxt_sess.Session.sess_log_layout
+  cx.ctxt_sess.Session.sess_log_out
+;;
+
+type slot_stack = Il.referent_ty Stack.t;;
+type frame_blocks = slot_stack Stack.t;;
+
+let layout_visitor
+    (cx:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+  (*
+   *   - Frames look, broadly, like this (growing downward):
+   *
+   *     +----------------------------+ <-- Rewind tail calls to here.
+   *     |caller args                 |
+   *     |...                         |
+   *     |...                         |
+   *     +----------------------------+ <-- fp + abi_frame_base_sz
+   *     |task ptr (implicit arg)     |        + abi_implicit_args_sz
+   *     |output ptr (implicit arg)   |
+   *     +----------------------------+ <-- fp + abi_frame_base_sz
+   *     |return pc                   |
+   *     |callee-save registers       |
+   *     |...                         |
+   *     +----------------------------+ <-- fp
+   *     |crate ptr                   |
+   *     |crate-rel frame info disp   |
+   *     +----------------------------+ <-- fp - abi_frame_info_sz
+   *     |spills determined in ra     |
+   *     |...                         |
+   *     |...                         |
+   *     +----------------------------+ <-- fp - (abi_frame_info_sz
+   *     |...                         |            + spillsz)
+   *     |frame-allocated stuff       |
+   *     |determined in resolve       |
+   *     |laid out in layout          |
+   *     |...                         |
+   *     |...                         |
+   *     +----------------------------+ <-- fp - framesz
+   *     |call space                  |      == sp + callsz
+   *     |...                         |
+   *     |...                         |
+   *     +----------------------------+ <-- fp - (framesz + callsz) == sp
+   *
+   *   - Slot offsets fall into three classes:
+   *
+   *     #1 frame-locals are negative offsets from fp
+   *        (beneath the frame-info and spills)
+   *
+   *     #2 incoming arg slots are positive offsets from fp
+   *        (above the frame-base)
+   *
+   *     #3 outgoing arg slots are positive offsets from sp
+   *
+   *   - Slots are split into two classes:
+   *
+   *     #1 those that are never aliased and fit in a word, so are
+   *        vreg-allocated
+   *
+   *     #2 all others
+   *
+   *   - Non-aliased, word-fitting slots consume no frame space
+   *     *yet*; they are given a generic value that indicates "try a
+   *     vreg". The register allocator may spill them later, if it
+   *     needs to, but that's not our concern.
+   *
+   *   - Aliased / too-big slots are frame-allocated, need to be
+   *     laid out in the frame at fixed offsets.
+   *
+   *   - The frame size is the maximum of all the block sizes contained
+   *     within it. Though at the moment it's the sum of them, due to
+   *     the blood-curdling hack we use to ensure proper unwind/drop
+   *     behavior in absence of CFI or similar precise frame-evolution
+   *     tracking. See visit_block_post below (issue #27).
+   *
+   *   - Each call is examined and the size of the call tuple required
+   *     for that call is calculated. The call size is the maximum of all
+   *     such call tuples.
+   *
+   *   - In frames that have a tail call (in fact, currently, all frames
+   *     because we're lazy) we double the call size in order to handle
+   *     the possible need to *execute* a call (to drop glue) while
+   *     destroying the frame, after we've built the outgoing args. This is
+   *     done in the backend though; the logic in this file is ignorant of the
+   *     doubling (some platforms may not require it? Hard to guess)
+   *
+   *)
+
+  let force_slot_to_mem (slot:Ast.slot) : bool =
+    (* FIXME (issue #26): For the time being we force any slot that
+     * points into memory or is of opaque/code type to be stored in the
+     * frame rather than in a vreg. This can probably be relaxed in the
+     * future.
+     *)
+    let rec st_in_mem st =
+      match st with
+          Il.ValTy _ -> false
+        | Il.AddrTy _ -> true
+
+    and rt_in_mem rt =
+      match rt with
+          Il.ScalarTy st -> st_in_mem st
+        | Il.StructTy rts
+        | Il.UnionTy rts -> List.exists rt_in_mem (Array.to_list rts)
+        | Il.OpaqueTy
+        | Il.ParamTy _
+        | Il.CodeTy -> true
+        | Il.NilTy -> false
+    in
+      rt_in_mem (slot_referent_type cx.ctxt_abi slot)
+  in
+
+  let rty_sz rty = Il.referent_ty_size cx.ctxt_abi.Abi.abi_word_bits rty in
+  let rty_layout rty =
+    Il.referent_ty_layout cx.ctxt_abi.Abi.abi_word_bits rty
+  in
+
+  let is_subword_size sz =
+    match sz with
+        SIZE_fixed i -> i64_le i cx.ctxt_abi.Abi.abi_word_sz
+      | _ -> false
+  in
+
+  let iflog thunk =
+    if cx.ctxt_sess.Session.sess_log_layout
+    then thunk ()
+    else ()
+  in
+
+  let layout_slot_ids
+      (slot_accum:slot_stack)
+      (upwards:bool)
+      (vregs_ok:bool)
+      (offset:size)
+      (slots:node_id array)
+      : unit =
+    let accum (off,align) id : (size * size) =
+      let slot = referent_to_slot cx id in
+      let rt = slot_referent_type cx.ctxt_abi slot in
+      let (elt_size, elt_align) = rty_layout rt in
+        if vregs_ok
+          && (is_subword_size elt_size)
+          && (not (type_is_structured (slot_ty slot)))
+          && (not (force_slot_to_mem slot))
+          && (not (Hashtbl.mem cx.ctxt_slot_aliased id))
+        then
+          begin
+            iflog
+              begin
+                fun _ ->
+                  let k = Hashtbl.find cx.ctxt_slot_keys id in
+                    log cx "assigning slot #%d = %a to vreg"
+                      (int_of_node id)
+                      Ast.sprintf_slot_key k;
+              end;
+            htab_put cx.ctxt_slot_vregs id (ref None);
+            (off,align)
+          end
+        else
+          begin
+            let elt_off = align_sz elt_align off in
+            let frame_off =
+              if upwards
+              then elt_off
+              else neg_sz (add_sz elt_off elt_size)
+            in
+              Stack.push (slot_referent_type cx.ctxt_abi slot) slot_accum;
+            iflog
+              begin
+                fun _ ->
+                  let k = Hashtbl.find cx.ctxt_slot_keys id in
+                    log cx "assigning slot #%d = %a frame-offset %s"
+                      (int_of_node id)
+                      Ast.sprintf_slot_key k
+                      (string_of_size frame_off);
+              end;
+              if (not (Hashtbl.mem cx.ctxt_slot_offsets id))
+              then htab_put cx.ctxt_slot_offsets id frame_off;
+              (add_sz elt_off elt_size, max_sz elt_align align)
+          end
+    in
+      ignore (Array.fold_left accum (offset, SIZE_fixed 0L) slots)
+  in
+
+  let layout_block
+      (slot_accum:slot_stack)
+      (offset:size)
+      (block:Ast.block)
+      : unit =
+    log cx "laying out block #%d at fp offset %s"
+      (int_of_node block.id) (string_of_size offset);
+    let block_slot_ids =
+      Array.of_list (htab_vals (Hashtbl.find cx.ctxt_block_slots block.id))
+    in
+      layout_slot_ids slot_accum false true offset block_slot_ids
+  in
+
+  let layout_header (id:node_id) (input_slot_ids:node_id array) : unit =
+    let rty = direct_call_args_referent_type cx id in
+    let offset =
+      match rty with
+          Il.StructTy elts ->
+            (add_sz
+               (SIZE_fixed cx.ctxt_abi.Abi.abi_frame_base_sz)
+               (Il.get_element_offset
+                  cx.ctxt_abi.Abi.abi_word_bits
+                  elts Abi.calltup_elt_args))
+        | _ -> bug () "call tuple has non-StructTy"
+    in
+      log cx "laying out header for node #%d at fp offset %s"
+        (int_of_node id) (string_of_size offset);
+      layout_slot_ids (Stack.create()) true false offset input_slot_ids
+  in
+
+  let layout_obj_state (id:node_id) (state_slot_ids:node_id array) : unit =
+    let offset =
+      let word_sz = cx.ctxt_abi.Abi.abi_word_sz in
+      let word_n (n:int) = Int64.mul word_sz (Int64.of_int n) in
+        SIZE_fixed (word_n (Abi.exterior_rc_slot_field_body
+                            + 1 (* the state tydesc. *)))
+    in
+      log cx "laying out object-state for node #%d at offset %s"
+        (int_of_node id) (string_of_size offset);
+      layout_slot_ids (Stack.create()) true false offset state_slot_ids
+  in
+
+  let (frame_stack:(node_id * frame_blocks) Stack.t) = Stack.create() in
+
+  let block_rty (block:slot_stack) : Il.referent_ty =
+    Il.StructTy (Array.of_list (stk_elts_from_bot block))
+  in
+
+  let frame_rty (frame:frame_blocks) : Il.referent_ty =
+    Il.StructTy (Array.of_list (List.map block_rty (stk_elts_from_bot frame)))
+  in
+
+  let update_frame_size _ =
+    let (frame_id, frame_blocks) = Stack.top frame_stack in
+    let frame_spill = Hashtbl.find cx.ctxt_spill_fixups frame_id in
+    let sz =
+      add_sz
+        (add_sz
+           (rty_sz (frame_rty frame_blocks))
+           (SIZE_fixup_mem_sz frame_spill))
+        (SIZE_fixed cx.ctxt_abi.Abi.abi_frame_info_sz)
+    in
+    let curr = Hashtbl.find cx.ctxt_frame_sizes frame_id in
+    let sz = max_sz curr sz in
+      log cx "extending frame #%d frame to size %s"
+        (int_of_node frame_id) (string_of_size sz);
+      Hashtbl.replace cx.ctxt_frame_sizes frame_id sz
+  in
+
+  (* 
+   * FIXME: this is a little aggressive for default callsz; it can be 
+   * narrowed in frames with no drop glue and/or no indirect drop glue.
+   *)
+
+  let glue_callsz =
+    let word = interior_slot Ast.TY_int in
+    let glue_fn =
+      mk_simple_ty_fn
+        (Array.init Abi.worst_case_glue_call_args (fun _ -> word))
+    in
+      rty_sz (indirect_call_args_referent_type cx 0 glue_fn Il.OpaqueTy)
+  in
+
+  let enter_frame id =
+      Stack.push (id, (Stack.create())) frame_stack;
+      htab_put cx.ctxt_frame_sizes id (SIZE_fixed 0L);
+      htab_put cx.ctxt_call_sizes id glue_callsz;
+      htab_put cx.ctxt_spill_fixups id (new_fixup "frame spill fixup");
+      htab_put cx.ctxt_frame_blocks id [];
+      update_frame_size ();
+  in
+
+  let leave_frame _ =
+    ignore (Stack.pop frame_stack);
+  in
+
+  let header_slot_ids hdr = Array.map (fun (sid,_) -> sid.id) hdr in
+
+  let visit_mod_item_pre n p i =
+    begin
+      match i.node.Ast.decl_item with
+          Ast.MOD_ITEM_fn f ->
+            enter_frame i.id;
+            layout_header i.id
+              (header_slot_ids f.Ast.fn_input_slots)
+
+        | Ast.MOD_ITEM_tag (header_slots, _, _) ->
+            enter_frame i.id;
+            layout_header i.id
+              (Array.map (fun sid -> sid.id) header_slots)
+
+        | Ast.MOD_ITEM_obj obj ->
+            enter_frame i.id;
+            let ids = header_slot_ids obj.Ast.obj_state in
+              layout_obj_state i.id ids;
+              Array.iter
+                (fun id -> htab_put cx.ctxt_slot_is_obj_state id ())
+                ids
+
+        | _ -> ()
+    end;
+    inner.Walk.visit_mod_item_pre n p i
+  in
+
+  let visit_mod_item_post n p i =
+    inner.Walk.visit_mod_item_post n p i;
+    begin
+      match i.node.Ast.decl_item with
+          Ast.MOD_ITEM_fn _
+        | Ast.MOD_ITEM_tag _
+        | Ast.MOD_ITEM_obj _ -> leave_frame ()
+        | _ -> ()
+    end
+  in
+
+  let visit_obj_fn_pre obj ident fn =
+    enter_frame fn.id;
+    layout_header fn.id
+      (header_slot_ids fn.node.Ast.fn_input_slots);
+    inner.Walk.visit_obj_fn_pre obj ident fn
+  in
+
+  let visit_obj_fn_post obj ident fn =
+    inner.Walk.visit_obj_fn_post obj ident fn;
+    leave_frame ()
+  in
+
+  let visit_obj_drop_pre obj b =
+    enter_frame b.id;
+    inner.Walk.visit_obj_drop_pre obj b
+  in
+
+  let visit_obj_drop_post obj b =
+    inner.Walk.visit_obj_drop_post obj b;
+    leave_frame ()
+  in
+
+  let visit_block_pre b =
+    if Hashtbl.mem cx.ctxt_block_is_loop_body b.id
+    then enter_frame b.id;
+    let (frame_id, frame_blocks) = Stack.top frame_stack in
+    let frame_spill = Hashtbl.find cx.ctxt_spill_fixups frame_id in
+    let spill_sz = SIZE_fixup_mem_sz frame_spill in
+    let info_sz = SIZE_fixed cx.ctxt_abi.Abi.abi_frame_info_sz in
+    let locals_off = add_sz spill_sz info_sz in
+    let off =
+      if Stack.is_empty frame_blocks
+      then locals_off
+      else
+        add_sz locals_off (rty_sz (frame_rty frame_blocks))
+    in
+    let block_slots = Stack.create() in
+    let frame_block_ids = Hashtbl.find cx.ctxt_frame_blocks frame_id in
+      Hashtbl.replace cx.ctxt_frame_blocks frame_id (b.id :: frame_block_ids);
+      layout_block block_slots off b;
+      Stack.push block_slots frame_blocks;
+      update_frame_size ();
+      inner.Walk.visit_block_pre b
+  in
+
+  let visit_block_post b =
+    inner.Walk.visit_block_post b;
+    if Hashtbl.mem cx.ctxt_block_is_loop_body b.id
+    then leave_frame();
+    (* FIXME (issue #27): In earlier versions of this file, multiple
+     * lexical blocks in the same frame would reuse space from one to
+     * the next so long as they were not nested; The (commented-out)
+     * code here supports that logic. Unfortunately since our marking
+     * and unwinding strategy is very simplistic for now (analogous to
+     * shadow stacks) we're going to give each lexical block in a frame
+     * its own space in the frame, even if they seem like they *should*
+     * be able to reuse space. This makes it possible to arrive at the
+     * frame and work out which variables are live (and which frame
+     * memory corresponds to them) w/o paying attention to the current
+     * pc in the function; a greatly-simplifying assumption.
+     * 
+     * This is of course not optimal for the long term, but in the
+     * longer term we'll have time to form proper DWARF CFI
+     * records. We're in a hurry at the moment.  *)
+    (*
+      let stk = Stack.top block_stacks in
+      ignore (Stack.pop stk)
+    *)
+  in
+
+  let visit_stmt_pre (s:Ast.stmt) : unit =
+
+    (* Call-size calculation. *)
+    begin
+      let callees =
+        match s.node with
+            Ast.STMT_call (_, lv, _)
+          | Ast.STMT_spawn (_, _, lv, _) -> [| lv |]
+          | Ast.STMT_check (_, calls) -> Array.map (fun (lv, _) -> lv) calls
+          | _ -> [| |]
+      in
+        Array.iter
+          begin
+            fun (callee:Ast.lval) ->
+              let lv_ty = lval_ty cx callee in
+              let abi = cx.ctxt_abi in
+              let static = lval_is_static cx callee in
+              let closure = if static then None else Some Il.OpaqueTy in
+              let n_ty_params =
+                match resolve_lval cx callee with
+                    DEFN_item i -> Array.length i.Ast.decl_params
+                  | _ -> 0
+              in
+              let rty =
+                call_args_referent_type cx n_ty_params lv_ty closure
+              in
+              let sz = Il.referent_ty_size abi.Abi.abi_word_bits rty in
+              let frame_id = fst (Stack.top frame_stack) in
+              let curr = Hashtbl.find cx.ctxt_call_sizes frame_id in
+                log cx "extending frame #%d call size to %s"
+                  (int_of_node frame_id) (string_of_size (max_sz curr sz));
+                Hashtbl.replace cx.ctxt_call_sizes frame_id (max_sz curr sz)
+          end
+          callees
+    end;
+    inner.Walk.visit_stmt_pre s
+  in
+
+
+    { inner with
+        Walk.visit_mod_item_pre = visit_mod_item_pre;
+        Walk.visit_mod_item_post = visit_mod_item_post;
+
+        Walk.visit_obj_fn_pre = visit_obj_fn_pre;
+        Walk.visit_obj_fn_post = visit_obj_fn_post;
+        Walk.visit_obj_drop_pre = visit_obj_drop_pre;
+        Walk.visit_obj_drop_post = visit_obj_drop_post;
+
+        Walk.visit_stmt_pre = visit_stmt_pre;
+        Walk.visit_block_pre = visit_block_pre;
+        Walk.visit_block_post = visit_block_post }
+;;
+
+let process_crate
+    (cx:ctxt)
+    (crate:Ast.crate)
+    : unit =
+  let path = Stack.create () in
+  let passes =
+    [|
+      (layout_visitor cx
+         Walk.empty_visitor)
+    |];
+  in
+    run_passes cx "layout" path passes (log cx "%s") crate
+;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/me/loop.ml

@@ -0,0 +1,163 @@
+(*
+ * Computes iterator-loop nesting depths and max depth of each function.
+ *)
+
+open Semant;;
+open Common;;
+
+let log cx = Session.log "loop"
+  cx.ctxt_sess.Session.sess_log_loop
+  cx.ctxt_sess.Session.sess_log_out
+;;
+
+type fn_ctxt = { current_depth: int;  }
+;;
+
+let incr_depth (fcx:fn_ctxt) =
+    { current_depth = fcx.current_depth + 1; }
+;;
+
+let decr_depth (fcx:fn_ctxt) =
+  { current_depth = fcx.current_depth - 1; }
+;;
+
+let top_fcx = { current_depth = 0; }
+;;
+
+let loop_depth_visitor
+    (cx:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+
+  let (fcxs : fn_ctxt Stack.t) = Stack.create () in
+
+  let push_loop () =
+    let fcx = Stack.pop fcxs in
+      Stack.push (incr_depth fcx) fcxs
+  in
+
+  let pop_loop () =
+    let fcx = Stack.pop fcxs in
+      Stack.push (decr_depth fcx) fcxs
+  in
+
+  let visit_mod_item_pre
+      (ident:Ast.ident)
+      (ty_params:(Ast.ty_param identified) array)
+      (item:Ast.mod_item)
+      : unit =
+    Stack.push top_fcx fcxs;
+    inner.Walk.visit_mod_item_pre ident ty_params item
+  in
+
+  let visit_mod_item_post
+      (ident:Ast.ident)
+      (ty_params:(Ast.ty_param identified) array)
+      (item:Ast.mod_item)
+      : unit =
+    inner.Walk.visit_mod_item_post ident ty_params item;
+    ignore (Stack.pop fcxs);
+  in
+
+  let visit_obj_fn_pre
+      (obj:Ast.obj identified)
+      (ident:Ast.ident)
+      (fn:Ast.fn identified)
+      : unit =
+    Stack.push top_fcx fcxs;
+    inner.Walk.visit_obj_fn_pre obj ident fn
+  in
+
+  let visit_obj_fn_post
+      (obj:Ast.obj identified)
+      (ident:Ast.ident)
+      (fn:Ast.fn identified)
+      : unit =
+    inner.Walk.visit_obj_fn_pre obj ident fn;
+    ignore (Stack.pop fcxs)
+  in
+
+  let visit_obj_drop_pre
+      (obj:Ast.obj identified)
+      (b:Ast.block)
+      : unit =
+    Stack.push top_fcx fcxs;
+    inner.Walk.visit_obj_drop_pre obj b
+  in
+
+  let visit_obj_drop_post
+      (obj:Ast.obj identified)
+      (b:Ast.block)
+      : unit =
+    inner.Walk.visit_obj_drop_post obj b;
+    ignore (Stack.pop fcxs)
+  in
+
+  let visit_slot_identified_pre sloti =
+    let fcx = Stack.top fcxs in
+      htab_put cx.ctxt_slot_loop_depths sloti.id fcx.current_depth;
+      inner.Walk.visit_slot_identified_pre sloti
+  in
+
+  let visit_stmt_pre s =
+    let fcx = Stack.top fcxs in
+      htab_put cx.ctxt_stmt_loop_depths s.id fcx.current_depth;
+      begin
+        match s.node with
+          | Ast.STMT_for_each fe ->
+              htab_put cx.ctxt_block_is_loop_body fe.Ast.for_each_body.id ();
+          | _ -> ()
+    end;
+    inner.Walk.visit_stmt_pre s
+  in
+
+  let visit_block_pre b =
+    if Hashtbl.mem cx.ctxt_block_is_loop_body b.id
+    then push_loop ();
+    inner.Walk.visit_block_pre b
+  in
+
+  let visit_block_post b =
+    inner.Walk.visit_block_post b;
+    if Hashtbl.mem cx.ctxt_block_is_loop_body b.id
+    then pop_loop ()
+  in
+
+    { inner with
+        Walk.visit_mod_item_pre = visit_mod_item_pre;
+        Walk.visit_mod_item_post = visit_mod_item_post;
+        Walk.visit_obj_fn_pre = visit_obj_fn_pre;
+        Walk.visit_obj_fn_post = visit_obj_fn_post;
+        Walk.visit_obj_drop_pre = visit_obj_drop_pre;
+        Walk.visit_obj_drop_post = visit_obj_drop_post;
+        Walk.visit_slot_identified_pre = visit_slot_identified_pre;
+        Walk.visit_stmt_pre = visit_stmt_pre;
+        Walk.visit_block_pre = visit_block_pre;
+        Walk.visit_block_post = visit_block_post }
+;;
+
+let process_crate
+    (cx:ctxt)
+    (crate:Ast.crate)
+    : unit =
+  let path = Stack.create () in
+  let passes =
+    [|
+      (loop_depth_visitor cx
+         Walk.empty_visitor)
+    |]
+  in
+
+    run_passes cx "loop" path passes (log cx "%s") crate;
+    ()
+;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/me/resolve.ml

@@ -0,0 +1,959 @@
+open Semant;;
+open Common;;
+
+(*
+ * Resolution passes:
+ *
+ *   - build multiple 'scope' hashtables mapping slot_key -> node_id
+ *   - build single 'type inference' hashtable mapping node_id -> slot
+ *
+ *   (note: not every slot is identified; only those that are declared
+ *    in statements and/or can participate in local type inference.
+ *    Those in function signatures are not, f.e. Also no type values
+ *    are identified, though module items are. )
+ *
+ *)
+
+
+let log cx = Session.log "resolve"
+  cx.ctxt_sess.Session.sess_log_resolve
+  cx.ctxt_sess.Session.sess_log_out
+;;
+
+let iflog cx thunk =
+  if cx.ctxt_sess.Session.sess_log_resolve
+  then thunk ()
+  else ()
+;;
+
+
+let block_scope_forming_visitor
+    (cx:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+  let visit_block_pre b =
+    if not (Hashtbl.mem cx.ctxt_block_items b.id)
+    then htab_put cx.ctxt_block_items b.id (Hashtbl.create 0);
+    if not (Hashtbl.mem cx.ctxt_block_slots b.id)
+    then htab_put cx.ctxt_block_slots b.id (Hashtbl.create 0);
+    inner.Walk.visit_block_pre b
+  in
+    { inner with Walk.visit_block_pre = visit_block_pre }
+;;
+
+
+let stmt_collecting_visitor
+    (cx:ctxt)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+  let block_ids = Stack.create () in
+  let visit_block_pre (b:Ast.block) =
+    Stack.push b.id block_ids;
+    inner.Walk.visit_block_pre b
+  in
+  let visit_block_post (b:Ast.block) =
+    inner.Walk.visit_block_post b;
+    ignore (Stack.pop block_ids)
+  in
+
+  let visit_for_block
+      ((si:Ast.slot identified),(ident:Ast.ident))
+      (block_id:node_id)
+      : unit =
+    let slots = Hashtbl.find cx.ctxt_block_slots block_id in
+    let key = Ast.KEY_ident ident in
+      log cx "found decl of '%s' in for-loop block header" ident;
+      htab_put slots key si.id;
+      htab_put cx.ctxt_slot_keys si.id key
+  in
+
+  let visit_stmt_pre stmt =
+    begin
+      htab_put cx.ctxt_all_stmts stmt.id stmt;
+      match stmt.node with
+          Ast.STMT_decl d ->
+            begin
+              let bid = Stack.top block_ids in
+              let items = Hashtbl.find cx.ctxt_block_items bid in
+              let slots = Hashtbl.find cx.ctxt_block_slots bid in
+              let check_and_log_ident id ident =
+                if Hashtbl.mem items ident ||
+                  Hashtbl.mem slots (Ast.KEY_ident ident)
+                then
+                  err (Some id)
+                    "duplicate declaration '%s' in block" ident
+                else
+                  log cx "found decl of '%s' in block" ident
+              in
+              let check_and_log_tmp id tmp =
+                if Hashtbl.mem slots (Ast.KEY_temp tmp)
+                then
+                  err (Some id)
+                    "duplicate declaration of temp #%d in block"
+                    (int_of_temp tmp)
+                else
+                  log cx "found decl of temp #%d in block" (int_of_temp tmp)
+              in
+              let check_and_log_key id key =
+                match key with
+                    Ast.KEY_ident i -> check_and_log_ident id i
+                  | Ast.KEY_temp t -> check_and_log_tmp id t
+              in
+                match d with
+                    Ast.DECL_mod_item (ident, item) ->
+                      check_and_log_ident item.id ident;
+                      htab_put items ident item.id
+                  | Ast.DECL_slot (key, sid) ->
+                      check_and_log_key sid.id key;
+                      htab_put slots key sid.id;
+                      htab_put cx.ctxt_slot_keys sid.id key
+            end
+        | Ast.STMT_for f ->
+            visit_for_block f.Ast.for_slot f.Ast.for_body.id
+        | Ast.STMT_for_each f ->
+            visit_for_block f.Ast.for_each_slot f.Ast.for_each_head.id
+        | Ast.STMT_alt_tag { Ast.alt_tag_arms = arms } ->
+            let rec resolve_pat block pat =
+              match pat with
+                  Ast.PAT_slot ({ id = slot_id }, ident) ->
+                    let slots = Hashtbl.find cx.ctxt_block_slots block.id in
+                    let key = Ast.KEY_ident ident in
+                    htab_put slots key slot_id;
+                    htab_put cx.ctxt_slot_keys slot_id key
+                | Ast.PAT_tag (_, pats) -> Array.iter (resolve_pat block) pats
+                | Ast.PAT_lit _ | Ast.PAT_wild -> ()
+            in
+            Array.iter (fun { node = (p, b) } -> resolve_pat b p) arms
+        | _ -> ()
+    end;
+    inner.Walk.visit_stmt_pre stmt
+  in
+    { inner with
+        Walk.visit_block_pre = visit_block_pre;
+        Walk.visit_block_post = visit_block_post;
+        Walk.visit_stmt_pre = visit_stmt_pre }
+;;
+
+
+let all_item_collecting_visitor
+    (cx:ctxt)
+    (path:Ast.name_component Stack.t)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+
+  let items = Stack.create () in
+
+  let push_on_item_arg_list item_id arg_id =
+    let existing =
+      match htab_search cx.ctxt_frame_args item_id with
+          None -> []
+        | Some x -> x
+    in
+      htab_put cx.ctxt_slot_is_arg arg_id ();
+      Hashtbl.replace cx.ctxt_frame_args item_id (arg_id :: existing)
+  in
+
+  let note_header item_id header =
+    Array.iter
+      (fun (sloti,ident) ->
+         let key = Ast.KEY_ident ident in
+           htab_put cx.ctxt_slot_keys sloti.id key;
+           push_on_item_arg_list item_id sloti.id)
+      header;
+  in
+
+  let visit_mod_item_pre n p i =
+    Stack.push i.id items;
+    Array.iter (fun p -> htab_put cx.ctxt_all_defns p.id
+                  (DEFN_ty_param p.node)) p;
+    htab_put cx.ctxt_all_defns i.id (DEFN_item i.node);
+    htab_put cx.ctxt_all_item_names i.id (Walk.path_to_name path);
+    log cx "collected item #%d: %s" (int_of_node i.id) n;
+    begin
+      (* FIXME: this is incomplete. *)
+      match i.node.Ast.decl_item with
+          Ast.MOD_ITEM_fn f ->
+            note_header i.id f.Ast.fn_input_slots;
+        | Ast.MOD_ITEM_obj ob ->
+            note_header i.id ob.Ast.obj_state;
+        | Ast.MOD_ITEM_tag (header_slots, _, _) ->
+            let skey i = Printf.sprintf "_%d" i in
+              note_header i.id
+                (Array.mapi (fun i s -> (s, skey i)) header_slots)
+        | _ -> ()
+    end;
+      inner.Walk.visit_mod_item_pre n p i
+  in
+
+  let visit_mod_item_post n p i =
+    inner.Walk.visit_mod_item_post n p i;
+    ignore (Stack.pop items)
+  in
+
+  let visit_obj_fn_pre obj ident fn =
+    htab_put cx.ctxt_all_defns fn.id (DEFN_obj_fn (obj.id, fn.node));
+    htab_put cx.ctxt_all_item_names fn.id (Walk.path_to_name path);
+    note_header fn.id fn.node.Ast.fn_input_slots;
+    inner.Walk.visit_obj_fn_pre obj ident fn
+  in
+
+  let visit_obj_drop_pre obj b =
+    htab_put cx.ctxt_all_defns b.id (DEFN_obj_drop obj.id);
+    htab_put cx.ctxt_all_item_names b.id (Walk.path_to_name path);
+    inner.Walk.visit_obj_drop_pre obj b
+  in
+
+  let visit_stmt_pre s =
+    begin
+      match s.node with
+          Ast.STMT_for_each fe ->
+            let id = fe.Ast.for_each_body.id in
+              htab_put cx.ctxt_all_defns id
+                (DEFN_loop_body (Stack.top items));
+              htab_put cx.ctxt_all_item_names id
+                (Walk.path_to_name path);
+        | _ -> ()
+    end;
+    inner.Walk.visit_stmt_pre s;
+  in
+
+    { inner with
+        Walk.visit_mod_item_pre = visit_mod_item_pre;
+        Walk.visit_mod_item_post = visit_mod_item_post;
+        Walk.visit_obj_fn_pre = visit_obj_fn_pre;
+        Walk.visit_obj_drop_pre = visit_obj_drop_pre;
+        Walk.visit_stmt_pre = visit_stmt_pre; }
+;;
+
+
+let lookup_type_node_by_name
+    (cx:ctxt)
+    (scopes:scope list)
+    (name:Ast.name)
+    : node_id =
+  iflog cx (fun _ ->
+              log cx "lookup_simple_type_by_name %a"
+                Ast.sprintf_name name);
+  match lookup_by_name cx scopes name with
+      None -> err None "unknown name: %a" Ast.sprintf_name name
+    | Some (_, id) ->
+        match htab_search cx.ctxt_all_defns id with
+            Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_type _ })
+          | Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_obj _ })
+          | Some (DEFN_ty_param _) -> id
+          | _ ->
+              err None "Found non-type binding for %a"
+                Ast.sprintf_name name
+;;
+
+
+let get_ty_references
+    (t:Ast.ty)
+    (cx:ctxt)
+    (scopes:scope list)
+    : node_id list =
+  let base = ty_fold_list_concat () in
+  let ty_fold_named n =
+    [ lookup_type_node_by_name cx scopes n ]
+  in
+  let fold = { base with ty_fold_named = ty_fold_named } in
+    fold_ty fold t
+;;
+
+
+let type_reference_and_tag_extracting_visitor
+    (cx:ctxt)
+    (scopes:(scope list) ref)
+    (node_to_references:(node_id,node_id list) Hashtbl.t)
+    (all_tags:(node_id,(Ast.ty_tag * (scope list))) Hashtbl.t)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+  let visit_mod_item_pre id params item =
+    begin
+      match item.node.Ast.decl_item with
+          Ast.MOD_ITEM_type ty ->
+            begin
+              log cx "extracting references for type node %d"
+                (int_of_node item.id);
+              let referenced = get_ty_references ty cx (!scopes) in
+                List.iter
+                  (fun i -> log cx "type %d references type %d"
+                     (int_of_node item.id) (int_of_node i)) referenced;
+                htab_put node_to_references item.id referenced;
+                match ty with
+                    Ast.TY_tag ttag ->
+                      htab_put all_tags item.id (ttag, (!scopes))
+                  | _ -> ()
+            end
+        | _ -> ()
+    end;
+    inner.Walk.visit_mod_item_pre id params item
+  in
+    { inner with
+        Walk.visit_mod_item_pre = visit_mod_item_pre }
+;;
+
+
+type recur_info =
+    { recur_all_nodes: node_id list;
+      recur_curr_iso: (node_id array) option; }
+;;
+
+let empty_recur_info =
+  { recur_all_nodes = [];
+    recur_curr_iso = None }
+;;
+
+let push_node r n =
+  { r with recur_all_nodes = n :: r.recur_all_nodes }
+;;
+
+let set_iso r i =
+  { r with recur_curr_iso = Some i }
+;;
+
+
+let index_in_curr_iso (recur:recur_info) (node:node_id) : int option =
+  match recur.recur_curr_iso with
+      None -> None
+    | Some iso ->
+        let rec search i =
+          if i >= (Array.length iso)
+          then None
+          else
+            if iso.(i) = node
+            then Some i
+            else search (i+1)
+        in
+          search 0
+;;
+
+let need_ty_tag t =
+  match t with
+      Ast.TY_tag ttag -> ttag
+    | _ -> err None "needed ty_tag"
+;;
+
+
+let rec ty_iso_of
+    (cx:ctxt)
+    (recursive_tag_groups:(node_id,(node_id,unit) Hashtbl.t) Hashtbl.t)
+    (all_tags:(node_id,(Ast.ty_tag * (scope list))) Hashtbl.t)
+    (n:node_id)
+    : Ast.ty =
+  let _ = iflog cx (fun _ -> log cx "+++ ty_iso_of #%d" (int_of_node n)) in
+  let group_table = Hashtbl.find recursive_tag_groups n in
+  let group_array = Array.of_list (htab_keys group_table) in
+  let compare_nodes a_id b_id =
+    (* FIXME: this should sort by the sorted name-lists of the
+     *constructors* of the tag, not the tag type name. *)
+    let a_name = Hashtbl.find cx.ctxt_all_item_names a_id in
+    let b_name = Hashtbl.find cx.ctxt_all_item_names b_id in
+      compare a_name b_name
+  in
+  let recur = set_iso (push_node empty_recur_info n) group_array in
+  let resolve_member member =
+    let (tag, scopes) = Hashtbl.find all_tags member in
+    let ty = Ast.TY_tag tag in
+    let ty = resolve_type cx scopes recursive_tag_groups all_tags recur ty in
+      need_ty_tag ty
+  in
+    Array.sort compare_nodes group_array;
+    log cx "resolving node %d, %d-member iso group"
+      (int_of_node n) (Array.length group_array);
+    Array.iteri (fun i n -> log cx "member %d: %d" i
+                   (int_of_node n)) group_array;
+    let group = Array.map resolve_member group_array in
+    let rec search i =
+      if i >= (Array.length group_array)
+      then err None "node is not a member of its own iso group"
+      else
+        if group_array.(i) = n
+        then i
+        else search (i+1)
+    in
+    let iso =
+      Ast.TY_iso { Ast.iso_index = (search 0);
+                   Ast.iso_group = group }
+    in
+    iflog cx (fun _ ->
+                log cx "--- ty_iso_of #%d ==> %a"
+                  (int_of_node n) Ast.sprintf_ty iso);
+      iso
+
+
+and lookup_type_by_name
+    (cx:ctxt)
+    (scopes:scope list)
+    (recursive_tag_groups:(node_id,(node_id,unit) Hashtbl.t) Hashtbl.t)
+    (all_tags:(node_id,(Ast.ty_tag * (scope list))) Hashtbl.t)
+    (recur:recur_info)
+    (name:Ast.name)
+    : ((scope list) * node_id * Ast.ty) =
+  iflog cx (fun _ ->
+              log cx "+++ lookup_type_by_name %a"
+                Ast.sprintf_name name);
+  match lookup_by_name cx scopes name with
+      None -> err None "unknown name: %a" Ast.sprintf_name name
+    | Some (scopes', id) ->
+        let ty, params =
+          match htab_search cx.ctxt_all_defns id with
+              Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_type t;
+                                Ast.decl_params = params }) ->
+                (t, Array.map (fun p -> p.node) params)
+            | Some (DEFN_item { Ast.decl_item = Ast.MOD_ITEM_obj ob;
+                                Ast.decl_params = params }) ->
+                (Ast.TY_obj (ty_obj_of_obj ob),
+                 Array.map (fun p -> p.node) params)
+            | Some (DEFN_ty_param (_, x)) ->
+                (Ast.TY_param x, [||])
+            | _ ->
+                err None "Found non-type binding for %a"
+                  Ast.sprintf_name name
+        in
+        let args =
+          match name with
+              Ast.NAME_ext (_, Ast.COMP_app (_, args)) -> args
+            | Ast.NAME_base (Ast.BASE_app (_, args)) -> args
+            | _ -> [| |]
+        in
+        let args =
+          iflog cx (fun _ -> log cx
+                      "lookup_type_by_name %a resolving %d type args"
+                      Ast.sprintf_name name
+                      (Array.length args));
+          Array.mapi
+            begin
+              fun i t ->
+                let t =
+                  resolve_type cx scopes recursive_tag_groups
+                    all_tags recur t
+                in
+                  iflog cx (fun _ -> log cx
+                              "lookup_type_by_name resolved arg %d to %a" i
+                              Ast.sprintf_ty t);
+                  t
+            end
+            args
+        in
+          iflog cx
+            begin
+              fun _ ->
+                log cx
+                  "lookup_type_by_name %a found ty %a"
+                  Ast.sprintf_name name Ast.sprintf_ty ty;
+                log cx "applying %d type args to %d params"
+                  (Array.length args) (Array.length params);
+                log cx "params: %s"
+                  (Ast.fmt_to_str Ast.fmt_decl_params params);
+                log cx "args: %s"
+                  (Ast.fmt_to_str Ast.fmt_app_args args);
+            end;
+          let ty = rebuild_ty_under_params ty params args true in
+            iflog cx (fun _ -> log cx "--- lookup_type_by_name %a ==> %a"
+                        Ast.sprintf_name name
+                        Ast.sprintf_ty ty);
+            (scopes', id, ty)
+
+and resolve_type
+    (cx:ctxt)
+    (scopes:(scope list))
+    (recursive_tag_groups:(node_id,(node_id,unit) Hashtbl.t) Hashtbl.t)
+    (all_tags:(node_id,(Ast.ty_tag * (scope list))) Hashtbl.t)
+    (recur:recur_info)
+    (t:Ast.ty)
+    : Ast.ty =
+  let _ = iflog cx (fun _ -> log cx "+++ resolve_type %a" Ast.sprintf_ty t) in
+  let base = ty_fold_rebuild (fun t -> t) in
+  let ty_fold_named name =
+    let (scopes, node, t) =
+      lookup_type_by_name cx scopes recursive_tag_groups all_tags recur name
+    in
+      iflog cx (fun _ ->
+                  log cx "resolved type name '%a' to item %d with ty %a"
+                  Ast.sprintf_name name (int_of_node node) Ast.sprintf_ty t);
+      match index_in_curr_iso recur node with
+          Some i -> Ast.TY_idx i
+        | None ->
+            if Hashtbl.mem recursive_tag_groups node
+            then
+              begin
+                let ttag = need_ty_tag t in
+                  Hashtbl.replace all_tags node (ttag, scopes);
+                  ty_iso_of cx recursive_tag_groups all_tags node
+              end
+            else
+              if List.mem node recur.recur_all_nodes
+              then (err (Some node) "infinite recursive type definition: '%a'"
+                      Ast.sprintf_name name)
+              else
+                let recur = push_node recur node in
+                  iflog cx (fun _ -> log cx "recursively resolving type %a"
+                              Ast.sprintf_ty t);
+                  resolve_type cx scopes recursive_tag_groups all_tags recur t
+  in
+  let fold =
+    { base with
+        ty_fold_named = ty_fold_named; }
+  in
+  let t' = fold_ty fold t in
+    iflog cx (fun _ ->
+                log cx "--- resolve_type %a ==> %a"
+                  Ast.sprintf_ty t Ast.sprintf_ty t');
+    t'
+;;
+
+
+let type_resolving_visitor
+    (cx:ctxt)
+    (scopes:(scope list) ref)
+    (recursive_tag_groups:(node_id,(node_id,unit) Hashtbl.t) Hashtbl.t)
+    (all_tags:(node_id,(Ast.ty_tag * (scope list))) Hashtbl.t)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+
+  let resolve_ty (t:Ast.ty) : Ast.ty =
+    resolve_type cx (!scopes) recursive_tag_groups all_tags empty_recur_info t
+  in
+
+  let resolve_slot (s:Ast.slot) : Ast.slot =
+    match s.Ast.slot_ty with
+        None -> s
+      | Some ty -> { s with Ast.slot_ty = Some (resolve_ty ty) }
+  in
+
+  let resolve_slot_identified
+      (s:Ast.slot identified)
+      : (Ast.slot identified) =
+    try
+      let slot = resolve_slot s.node in
+        { s with node = slot }
+    with
+        Semant_err (None, e) -> raise (Semant_err ((Some s.id), e))
+  in
+
+  let visit_slot_identified_pre slot =
+    let slot = resolve_slot_identified slot in
+      htab_put cx.ctxt_all_defns slot.id (DEFN_slot slot.node);
+      log cx "collected resolved slot #%d with type %s" (int_of_node slot.id)
+        (match slot.node.Ast.slot_ty with
+             None -> "??"
+           | Some t -> (Ast.fmt_to_str Ast.fmt_ty t));
+      inner.Walk.visit_slot_identified_pre slot
+  in
+
+  let visit_mod_item_pre id params item =
+    begin
+      try
+        match item.node.Ast.decl_item with
+            Ast.MOD_ITEM_type ty ->
+              let ty =
+                resolve_type cx (!scopes) recursive_tag_groups
+                  all_tags empty_recur_info ty
+              in
+                log cx "resolved item %s, defining type %a"
+                  id Ast.sprintf_ty ty;
+                htab_put cx.ctxt_all_type_items item.id ty;
+                htab_put cx.ctxt_all_item_types item.id Ast.TY_type
+
+          (* 
+           * Don't resolve the "type" of a mod item; just resolve its
+           * members.
+           *)
+          | Ast.MOD_ITEM_mod _ -> ()
+
+          | Ast.MOD_ITEM_tag (header_slots, _, nid)
+              when Hashtbl.mem recursive_tag_groups nid ->
+              begin
+                match ty_of_mod_item true item with
+                    Ast.TY_fn (tsig, taux) ->
+                      let input_slots =
+                        Array.map
+                          (fun sloti -> resolve_slot sloti.node)
+                          header_slots
+                      in
+                      let output_slot =
+                        interior_slot (ty_iso_of cx recursive_tag_groups
+                                         all_tags nid)
+                      in
+                      let ty =
+                        Ast.TY_fn
+                          ({tsig with
+                              Ast.sig_input_slots = input_slots;
+                              Ast.sig_output_slot = output_slot }, taux)
+                      in
+                        log cx "resolved recursive tag %s, type as %a"
+                          id Ast.sprintf_ty ty;
+                        htab_put cx.ctxt_all_item_types item.id ty
+                  | _ -> bug () "recursive tag with non-function type"
+              end
+
+          | _ ->
+              let t = ty_of_mod_item true item in
+              let ty =
+                resolve_type cx (!scopes) recursive_tag_groups
+                  all_tags empty_recur_info t
+              in
+                log cx "resolved item %s, type as %a" id Ast.sprintf_ty ty;
+                htab_put cx.ctxt_all_item_types item.id ty;
+      with
+          Semant_err (None, e) -> raise (Semant_err ((Some item.id), e))
+    end;
+    inner.Walk.visit_mod_item_pre id params item
+  in
+
+  let visit_obj_fn_pre obj ident fn =
+    let fty =
+      resolve_type cx (!scopes) recursive_tag_groups all_tags
+        empty_recur_info (Ast.TY_fn (ty_fn_of_fn fn.node))
+    in
+      log cx "resolved obj fn %s as %a" ident Ast.sprintf_ty fty;
+      htab_put cx.ctxt_all_item_types fn.id fty;
+      inner.Walk.visit_obj_fn_pre obj ident fn
+  in
+
+  let visit_obj_drop_pre obj b =
+    let fty = mk_simple_ty_fn [| |] in
+      htab_put cx.ctxt_all_item_types b.id fty;
+      inner.Walk.visit_obj_drop_pre obj b
+  in
+
+  let visit_stmt_pre stmt =
+    begin
+      match stmt.node with
+          Ast.STMT_for_each fe ->
+            let id = fe.Ast.for_each_body.id in
+            let fty = mk_simple_ty_iter [| |] in
+              htab_put cx.ctxt_all_item_types id fty;
+        | Ast.STMT_copy (_, Ast.EXPR_unary (Ast.UNOP_cast t, _)) ->
+            let ty = resolve_ty t.node in
+              htab_put cx.ctxt_all_cast_types t.id ty
+        | _ -> ()
+    end;
+    inner.Walk.visit_stmt_pre stmt
+  in
+
+  let visit_lval_pre lv =
+    let rec rebuild_lval' lv =
+      match lv with
+          Ast.LVAL_ext (base, ext) ->
+            let ext =
+              match ext with
+                  Ast.COMP_named (Ast.COMP_ident _)
+                | Ast.COMP_named (Ast.COMP_idx _)
+                | Ast.COMP_atom (Ast.ATOM_literal _) -> ext
+                | Ast.COMP_atom (Ast.ATOM_lval lv) ->
+                    Ast.COMP_atom (Ast.ATOM_lval (rebuild_lval lv))
+                | Ast.COMP_named (Ast.COMP_app (ident, params)) ->
+                    Ast.COMP_named
+                      (Ast.COMP_app (ident, Array.map resolve_ty params))
+            in
+              Ast.LVAL_ext (rebuild_lval' base, ext)
+
+        | Ast.LVAL_base nb ->
+            let node =
+              match nb.node with
+                  Ast.BASE_ident _
+                | Ast.BASE_temp _ -> nb.node
+                | Ast.BASE_app (ident, params) ->
+                    Ast.BASE_app (ident, Array.map resolve_ty params)
+            in
+              Ast.LVAL_base {nb with node = node}
+
+    and rebuild_lval lv =
+      let id = lval_base_id lv in
+      let lv' = rebuild_lval' lv in
+        iflog cx (fun _ -> log cx "rebuilt lval %a as %a (#%d)"
+                    Ast.sprintf_lval lv Ast.sprintf_lval lv'
+                    (int_of_node id));
+        htab_put cx.ctxt_all_lvals id lv';
+        lv'
+    in
+      ignore (rebuild_lval lv);
+      inner.Walk.visit_lval_pre lv
+  in
+
+    { inner with
+        Walk.visit_slot_identified_pre = visit_slot_identified_pre;
+        Walk.visit_mod_item_pre = visit_mod_item_pre;
+        Walk.visit_obj_fn_pre = visit_obj_fn_pre;
+        Walk.visit_obj_drop_pre = visit_obj_drop_pre;
+        Walk.visit_stmt_pre = visit_stmt_pre;
+        Walk.visit_lval_pre = visit_lval_pre; }
+;;
+
+
+let lval_base_resolving_visitor
+    (cx:ctxt)
+    (scopes:(scope list) ref)
+    (inner:Walk.visitor)
+    : Walk.visitor =
+  let lookup_referent_by_ident id ident =
+    log cx "looking up slot or item with ident '%s'" ident;
+    match lookup cx (!scopes) (Ast.KEY_ident ident) with
+        None -> err (Some id) "unresolved identifier '%s'" ident
+      | Some (_, id) -> (log cx "resolved to node id #%d"
+                           (int_of_node id); id)
+  in
+  let lookup_slot_by_temp id temp =
+    log cx "looking up temp slot #%d" (int_of_temp temp);
+    let res = lookup cx (!scopes) (Ast.KEY_temp temp) in
+      match res with
+          None -> err
+            (Some id) "unresolved temp node #%d" (int_of_temp temp)
+        | Some (_, id) ->
+            (log cx "resolved to node id #%d" (int_of_node id); id)
+  in
+  let lookup_referent_by_name_base id nb =
+    match nb with
+        Ast.BASE_ident ident
+      | Ast.BASE_app (ident, _) -> lookup_referent_by_ident id ident
+      | Ast.BASE_temp temp -> lookup_slot_by_temp id temp
+  in
+
+  let visit_lval_pre lv =
+    let rec lookup_lval lv =
+      iflog cx (fun _ ->
+                  log cx "looking up lval #%d"
+                    (int_of_node (lval_base_id lv)));
+      match lv with
+          Ast.LVAL_ext (base, ext) ->
+            begin
+              lookup_lval base;
+              match ext with
+                  Ast.COMP_atom (Ast.ATOM_lval lv') -> lookup_lval lv'
+                | _ -> ()
+            end
+        | Ast.LVAL_base nb ->
+            let referent_id = lookup_referent_by_name_base nb.id nb.node in
+              iflog cx (fun _ -> log cx "resolved lval #%d to referent #%d"
+                          (int_of_node nb.id) (int_of_node referent_id));
+              htab_put cx.ctxt_lval_to_referent nb.id referent_id
+    in
+      lookup_lval lv;
+      inner.Walk.visit_lval_pre lv
+  in
+    { inner with
+        Walk.visit_lval_pre = visit_lval_pre }
+;;
+
+
+
+(*
+ * iso-recursion groups are very complicated.
+ * 
+ *   - iso groups are always rooted at *named* ty_tag nodes
+ * 
+ *   - consider: 
+ * 
+ *    type colour = tag(red, green, blue);
+ *    type list = tag(cons(colour, @list), nil())
+ * 
+ *    this should include list as an iso but not colour,
+ *    should result in:
+ * 
+ *    type list = iso[<0>:tag(cons(tag(red,green,blue),@#1))]
+ * 
+ *   - consider:
+ * 
+ *    type colour = tag(red, green, blue);
+ *    type tree = tag(children(@list), leaf(colour))
+ *    type list = tag(cons(@tree, @list), nil())
+ * 
+ *    this should result in:
+ * 
+ *    type list = iso[<0>:tag(cons(@#2, @#1),nil());
+ *                    1: tag(children(@#1),leaf(tag(red,green,blue)))]
+ * 
+ *  - how can you calculate these?
+ * 
+ *    - start by making a map from named-tag-node-id -> referenced-other-nodes
+ *    - for each member in the set, if you can get from itself to itself, keep
+ *      it, otherwise it's non-recursive => non-interesting, delete it.
+ *    - group the members (now all recursive) by dependency
+ *    - assign index-number to each elt of group
+ *    - fully resolve each elt of group, turning names into numbers or chasing
+ *      through to fully-resolving targets as necessary
+ *    - place group in iso, store differently-indexed value in table for each
+ * 
+ * 
+ *  - what are the illegal forms?
+ *    - recursion that takes indefinite storage to form a tag, eg.
+ * 
+ *      type t = tag(foo(t));
+ *
+ *    - recursion that makes a tag unconstructable, eg:
+ * 
+ *      type t = tag(foo(@t));
+ *)
+
+let resolve_recursion
+    (cx:ctxt)
+    (node_to_references:(node_id,node_id list) Hashtbl.t)
+    (recursive_tag_groups:(node_id,(node_id,unit) Hashtbl.t) Hashtbl.t)
+    : unit =
+
+  let recursive_tag_types = Hashtbl.create 0 in
+
+  let rec can_reach
+      (target:node_id)
+      (visited:node_id list)
+      (curr:node_id)
+      : bool =
+    if List.mem curr visited
+    then false
+    else
+      match htab_search node_to_references curr with
+          None -> false
+        | Some referenced ->
+            if List.mem target referenced
+            then true
+            else List.exists (can_reach target (curr :: visited)) referenced
+  in
+
+  let extract_recursive_tags _ =
+    Hashtbl.iter
+      begin fun id _ ->
+        if can_reach id [] id
+        then begin
+          match Hashtbl.find cx.ctxt_all_defns id with
+              DEFN_item
+                { Ast.decl_item = Ast.MOD_ITEM_type (Ast.TY_tag _) } ->
+                log cx "type %d is a recursive tag" (int_of_node id);
+                Hashtbl.replace recursive_tag_types id ()
+            | _ ->
+                log cx "type %d is recursive, but not a tag" (int_of_node id);
+        end
+        else log cx "type %d is non-recursive" (int_of_node id);
+      end
+      node_to_references
+  in
+
+  let group_recursive_tags _ =
+    while (Hashtbl.length recursive_tag_types) != 0 do
+      let keys = htab_keys recursive_tag_types in
+      let root = List.hd keys in
+      let group = Hashtbl.create 0 in
+      let rec walk visited node =
+        if List.mem node visited
+        then ()
+        else
+          begin
+            if Hashtbl.mem recursive_tag_types node
+            then
+              begin
+                Hashtbl.remove recursive_tag_types node;
+                htab_put recursive_tag_groups node group;
+                htab_put group node ();
+                log cx "recursion group rooted at tag %d contains tag %d"
+                  (int_of_node root) (int_of_node node);
+              end;
+            match htab_search node_to_references node with
+                None -> ()
+              | Some referenced ->
+                  List.iter (walk (node :: visited)) referenced
+          end
+      in
+        walk [] root;
+    done
+  in
+
+    begin
+      extract_recursive_tags ();
+      group_recursive_tags ();
+      log cx "found %d independent type-recursion groups"
+        (Hashtbl.length recursive_tag_groups);
+    end
+;;
+
+let pattern_resolving_visitor
+    (cx:ctxt)
+    (scopes:scope list ref)
+    (inner:Walk.visitor) : Walk.visitor =
+  let visit_stmt_pre stmt =
+    begin
+      match stmt.node with
+        Ast.STMT_alt_tag { Ast.alt_tag_lval = _; Ast.alt_tag_arms = arms } ->
+          let resolve_arm { node = arm } =
+            match fst arm with
+                Ast.PAT_tag (ident, _) ->
+                  begin
+                    match lookup_by_ident cx !scopes ident with
+                        None ->
+                          err None "unresolved tag constructor '%s'" ident
+                      | Some (_, tag_id) ->
+                          match Hashtbl.find cx.ctxt_all_defns tag_id with
+                              DEFN_item {
+                                  Ast.decl_item = Ast.MOD_ITEM_tag _
+                                } -> ()
+                            | _ ->
+                                err None "'%s' is not a tag constructor" ident
+                  end
+              | _ -> ()
+
+          in
+          Array.iter resolve_arm arms
+      | _ -> ()
+    end;
+    inner.Walk.visit_stmt_pre stmt
+  in
+  { inner with Walk.visit_stmt_pre = visit_stmt_pre }
+;;
+
+let process_crate
+    (cx:ctxt)
+    (crate:Ast.crate)
+    : unit =
+  let (scopes:(scope list) ref) = ref [] in
+  let path = Stack.create () in
+
+  let node_to_references = Hashtbl.create 0 in
+  let all_tags = Hashtbl.create 0 in
+  let recursive_tag_groups = Hashtbl.create 0 in
+
+  let passes_0 =
+    [|
+      (block_scope_forming_visitor cx Walk.empty_visitor);
+      (stmt_collecting_visitor cx
+         (all_item_collecting_visitor cx path
+            Walk.empty_visitor));
+      (scope_stack_managing_visitor scopes
+         (type_reference_and_tag_extracting_visitor
+            cx scopes node_to_references all_tags
+            Walk.empty_visitor))
+    |]
+  in
+  let passes_1 =
+    [|
+      (scope_stack_managing_visitor scopes
+         (type_resolving_visitor cx scopes
+            recursive_tag_groups all_tags
+            (lval_base_resolving_visitor cx scopes
+               Walk.empty_visitor)));
+    |]
+  in
+  let passes_2 =
+    [|
+      (scope_stack_managing_visitor scopes
+        (pattern_resolving_visitor cx scopes
+          Walk.empty_visitor))
+    |]
+  in
+    log cx "running primary resolve passes";
+    run_passes cx "resolve collect" path passes_0 (log cx "%s") crate;
+    resolve_recursion cx node_to_references recursive_tag_groups;
+    log cx "running secondary resolve passes";
+    run_passes cx "resolve bind" path passes_1 (log cx "%s") crate;
+    log cx "running tertiary resolve passes";
+    run_passes cx "resolve patterns" path passes_2 (log cx "%s") crate
+;;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)
+

src/boot/me/transutil.ml

@@ -0,0 +1,238 @@
+open Common;;
+open Semant;;
+
+(* A note on GC:
+ * 
+ * We employ -- or "will employ" when the last few pieces of it are done -- a
+ * "simple" precise, mark-sweep, single-generation, per-task (thereby
+ * preemptable and relatively quick) GC scheme on mutable memory.
+ * 
+ * - For the sake of this note, call any exterior of 'state' effect a gc_val.
+ *
+ * - gc_vals come from the same malloc as all other values but undergo
+ *   different storage management.
+ *
+ *  - Every frame has a frame_glue_fns pointer in its fp[-1] slot, written on
+ *    function-entry.
+ *
+ *  - gc_vals have *three* extra words at their head, not one.
+ *
+ *  - A pointer to a gc_val, however, points to the third of these three
+ *    words. So a certain quantity of code can treat gc_vals the same way it
+ *    would treat refcounted exterior vals.
+ *
+ *  - The first word at the head of a gc_val is used as a refcount, as in
+ *    non-gc allocations.
+ *
+ *  - The (-1)st word at the head of a gc_val is a pointer to a tydesc,
+ *    with the low bit of that pointer used as a mark bit.
+ *
+ *  - The (-2)nd word at the head of a gc_val is a linked-list pointer to the
+ *    gc_val that was allocated (temporally) just before it. Following this
+ *    list traces through all the currently active gc_vals in a task.
+ *
+ *  - The task has a gc_alloc_chain field that points to the most-recent
+ *    gc_val allocated.
+ *
+ *  - GC glue has two phases, mark and sweep:
+ * 
+ *    - The mark phase walks down the frame chain, like the unwinder. It calls
+ *      each frame's mark glue as it's passing through. This will mark all the
+ *      reachable parts of the task's gc_vals.
+ * 
+ *    - The sweep phase walks down the task's gc_alloc_chain checking to see
+ *      if each allocation has been marked. If marked, it has its mark-bit
+ *      reset and the sweep passes it by. If unmarked, it has its tydesc
+ *      free_glue called on its body, and is unlinked from the chain. The
+ *      free-glue will cause the allocation to (recursively) drop all of its
+ *      references and/or run dtors.
+ * 
+ *    - Note that there is no "special gc state" at work here; the task looks
+ *      like it's running normal code that happens to not perform any gc_val
+ *      allocation. Mark-bit twiddling is open-coded into all the mark
+ *      functions, which know their contents; we only have to do O(frames)
+ *      indirect calls to mark, the rest are static. Sweeping costs O(gc-heap)
+ *      indirect calls, unfortunately, because the set of sweep functions to
+ *      call is arbitrary based on allocation order.
+ *)
+
+
+type mem_ctrl =
+    MEM_rc_opaque
+  | MEM_rc_struct
+  | MEM_gc
+  | MEM_interior
+;;
+
+type clone_ctrl =
+    CLONE_none
+  | CLONE_chan of Il.cell
+  | CLONE_all of Il.cell
+;;
+
+type call_ctrl =
+    CALL_direct
+  | CALL_vtbl
+  | CALL_indirect
+;;
+
+type for_each_ctrl =
+    {
+      for_each_fixup: fixup;
+      for_each_depth: int;
+    }
+;;
+
+let word_sz (abi:Abi.abi) : int64 =
+  abi.Abi.abi_word_sz
+;;
+
+let word_n (abi:Abi.abi) (n:int) : int64 =
+  Int64.mul (word_sz abi) (Int64.of_int n)
+;;
+
+let word_bits (abi:Abi.abi) : Il.bits =
+  abi.Abi.abi_word_bits
+;;
+
+let word_ty_mach (abi:Abi.abi) : ty_mach =
+  match word_bits abi with
+      Il.Bits8 -> TY_u8
+    | Il.Bits16 -> TY_u16
+    | Il.Bits32 -> TY_u32
+    | Il.Bits64 -> TY_u64
+;;
+
+let word_ty_signed_mach (abi:Abi.abi) : ty_mach =
+  match word_bits abi with
+      Il.Bits8 -> TY_i8
+    | Il.Bits16 -> TY_i16
+    | Il.Bits32 -> TY_i32
+    | Il.Bits64 -> TY_i64
+;;
+
+
+let slot_mem_ctrl (slot:Ast.slot) : mem_ctrl =
+  let ty = slot_ty slot in
+    match ty with
+        Ast.TY_port _
+      | Ast.TY_chan _
+      | Ast.TY_task
+      | Ast.TY_vec _
+      | Ast.TY_str -> MEM_rc_opaque
+      | _ ->
+          match slot.Ast.slot_mode with
+              Ast.MODE_exterior _ when type_is_structured ty ->
+                if type_has_state ty
+                then MEM_gc
+                else MEM_rc_struct
+            | Ast.MODE_exterior _ ->
+                MEM_rc_opaque
+            | _ ->
+                MEM_interior
+;;
+
+
+let iter_block_slots
+    (cx:Semant.ctxt)
+    (block_id:node_id)
+    (fn:Ast.slot_key -> node_id -> Ast.slot -> unit)
+    : unit =
+  let block_slots = Hashtbl.find cx.ctxt_block_slots block_id in
+    Hashtbl.iter
+      begin
+        fun key slot_id ->
+          let slot = referent_to_slot cx slot_id in
+            fn key slot_id slot
+      end
+      block_slots
+;;
+
+let iter_frame_slots
+    (cx:Semant.ctxt)
+    (frame_id:node_id)
+    (fn:Ast.slot_key -> node_id -> Ast.slot -> unit)
+    : unit =
+  let blocks = Hashtbl.find cx.ctxt_frame_blocks frame_id in
+    List.iter (fun block -> iter_block_slots cx block fn) blocks
+;;
+
+let iter_arg_slots
+    (cx:Semant.ctxt)
+    (frame_id:node_id)
+    (fn:Ast.slot_key -> node_id -> Ast.slot -> unit)
+    : unit =
+  match htab_search cx.ctxt_frame_args frame_id with
+      None -> ()
+    | Some ls ->
+        List.iter
+          begin
+            fun slot_id ->
+              let key = Hashtbl.find cx.ctxt_slot_keys slot_id in
+              let slot = referent_to_slot cx slot_id in
+                fn key slot_id slot
+          end
+          ls
+;;
+
+let iter_frame_and_arg_slots
+    (cx:Semant.ctxt)
+    (frame_id:node_id)
+    (fn:Ast.slot_key -> node_id -> Ast.slot -> unit)
+    : unit =
+  iter_frame_slots cx frame_id fn;
+  iter_arg_slots cx frame_id fn;
+;;
+
+let next_power_of_two (x:int64) : int64 =
+  let xr = ref (Int64.sub x 1L) in
+    xr := Int64.logor (!xr) (Int64.shift_right_logical (!xr) 1);
+    xr := Int64.logor (!xr) (Int64.shift_right_logical (!xr) 2);
+    xr := Int64.logor (!xr) (Int64.shift_right_logical (!xr) 4);
+    xr := Int64.logor (!xr) (Int64.shift_right_logical (!xr) 8);
+    xr := Int64.logor (!xr) (Int64.shift_right_logical (!xr) 16);
+    xr := Int64.logor (!xr) (Int64.shift_right_logical (!xr) 32);
+    Int64.add 1L (!xr)
+;;
+
+let iter_tup_slots
+    (get_element_ptr:'a -> int -> 'a)
+    (dst_ptr:'a)
+    (src_ptr:'a)
+    (slots:Ast.ty_tup)
+    (f:'a -> 'a -> Ast.slot -> (Ast.ty_iso option) -> unit)
+    (curr_iso:Ast.ty_iso option)
+    : unit =
+  Array.iteri
+    begin
+      fun i slot ->
+        f (get_element_ptr dst_ptr i)
+          (get_element_ptr src_ptr i)
+          slot curr_iso
+    end
+    slots
+;;
+
+let iter_rec_slots
+    (get_element_ptr:'a -> int -> 'a)
+    (dst_ptr:'a)
+    (src_ptr:'a)
+    (entries:Ast.ty_rec)
+    (f:'a -> 'a -> Ast.slot -> (Ast.ty_iso option) -> unit)
+    (curr_iso:Ast.ty_iso option)
+    : unit =
+  iter_tup_slots get_element_ptr dst_ptr src_ptr
+    (Array.map snd entries) f curr_iso
+;;
+
+
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/me/walk.ml

@@ -0,0 +1,687 @@
+
+open Common;;
+
+(*
+ * The purpose of this module is just to decouple the AST from the
+ * various passes that are interested in visiting "parts" of it.
+ * If the AST shifts, we have better odds of the shift only affecting
+ * this module rather than all of its clients. Similarly if the
+ * clients only need to visit part, they only have to define the
+ * part of the walk they're interested in, making it cheaper to define
+ * multiple passes.
+ *)
+
+type visitor =
+    {
+      visit_stmt_pre: Ast.stmt -> unit;
+      visit_stmt_post: Ast.stmt -> unit;
+      visit_slot_identified_pre: (Ast.slot identified) -> unit;
+      visit_slot_identified_post: (Ast.slot identified) -> unit;
+      visit_expr_pre: Ast.expr -> unit;
+      visit_expr_post: Ast.expr -> unit;
+      visit_ty_pre: Ast.ty -> unit;
+      visit_ty_post: Ast.ty -> unit;
+      visit_constr_pre: node_id option -> Ast.constr -> unit;
+      visit_constr_post: node_id option -> Ast.constr -> unit;
+      visit_pat_pre: Ast.pat -> unit;
+      visit_pat_post: Ast.pat -> unit;
+      visit_block_pre: Ast.block -> unit;
+      visit_block_post: Ast.block -> unit;
+
+      visit_lit_pre: Ast.lit -> unit;
+      visit_lit_post: Ast.lit -> unit;
+      visit_lval_pre: Ast.lval -> unit;
+      visit_lval_post: Ast.lval -> unit;
+      visit_mod_item_pre:
+        (Ast.ident
+         -> ((Ast.ty_param identified) array)
+           -> Ast.mod_item
+             -> unit);
+      visit_mod_item_post:
+        (Ast.ident
+         -> ((Ast.ty_param identified) array)
+           -> Ast.mod_item
+             -> unit);
+      visit_obj_fn_pre:
+        (Ast.obj identified) -> Ast.ident -> (Ast.fn identified) -> unit;
+      visit_obj_fn_post:
+        (Ast.obj identified) -> Ast.ident -> (Ast.fn identified) -> unit;
+      visit_obj_drop_pre:
+        (Ast.obj identified) -> Ast.block -> unit;
+      visit_obj_drop_post:
+        (Ast.obj identified) -> Ast.block -> unit;
+      visit_crate_pre: Ast.crate -> unit;
+      visit_crate_post: Ast.crate -> unit;
+    }
+;;
+
+
+let empty_visitor =
+  { visit_stmt_pre = (fun _ -> ());
+    visit_stmt_post = (fun _ -> ());
+    visit_slot_identified_pre = (fun _ -> ());
+    visit_slot_identified_post = (fun _ -> ());
+    visit_expr_pre = (fun _ -> ());
+    visit_expr_post = (fun _ -> ());
+    visit_ty_pre = (fun _ -> ());
+    visit_ty_post = (fun _ -> ());
+    visit_constr_pre = (fun _ _ -> ());
+    visit_constr_post = (fun _ _ -> ());
+    visit_pat_pre = (fun _ -> ());
+    visit_pat_post = (fun _ -> ());
+    visit_block_pre = (fun _ -> ());
+    visit_block_post = (fun _ -> ());
+    visit_lit_pre = (fun _ -> ());
+    visit_lit_post = (fun _ -> ());
+    visit_lval_pre = (fun _ -> ());
+    visit_lval_post = (fun _ -> ());
+    visit_mod_item_pre = (fun _ _ _ -> ());
+    visit_mod_item_post = (fun _ _ _ -> ());
+    visit_obj_fn_pre = (fun _ _ _ -> ());
+    visit_obj_fn_post = (fun _ _ _ -> ());
+    visit_obj_drop_pre = (fun _ _ -> ());
+    visit_obj_drop_post = (fun _ _ -> ());
+    visit_crate_pre = (fun _ -> ());
+    visit_crate_post = (fun _ -> ()); }
+;;
+
+let path_managing_visitor
+    (path:Ast.name_component Stack.t)
+    (inner:visitor)
+    : visitor =
+  let visit_mod_item_pre ident params item =
+    Stack.push (Ast.COMP_ident ident) path;
+    inner.visit_mod_item_pre ident params item
+  in
+  let visit_mod_item_post ident params item =
+    inner.visit_mod_item_post ident params item;
+    ignore (Stack.pop path)
+  in
+  let visit_obj_fn_pre obj ident fn =
+    Stack.push (Ast.COMP_ident ident) path;
+    inner.visit_obj_fn_pre obj ident fn
+  in
+  let visit_obj_fn_post obj ident fn =
+    inner.visit_obj_fn_post obj ident fn;
+    ignore (Stack.pop path)
+  in
+  let visit_obj_drop_pre obj b =
+    Stack.push (Ast.COMP_ident "drop") path;
+    inner.visit_obj_drop_pre obj b
+  in
+  let visit_obj_drop_post obj b =
+    inner.visit_obj_drop_post obj b;
+    ignore (Stack.pop path)
+  in
+    { inner with
+        visit_mod_item_pre = visit_mod_item_pre;
+        visit_mod_item_post = visit_mod_item_post;
+        visit_obj_fn_pre = visit_obj_fn_pre;
+        visit_obj_fn_post = visit_obj_fn_post;
+        visit_obj_drop_pre = visit_obj_drop_pre;
+        visit_obj_drop_post = visit_obj_drop_post;
+    }
+;;
+
+let rec name_of ncs =
+  match ncs with
+      [] -> bug () "Walk.name_of_ncs: empty path"
+    | [(Ast.COMP_ident i)] -> Ast.NAME_base (Ast.BASE_ident i)
+    | [(Ast.COMP_app x)] -> Ast.NAME_base (Ast.BASE_app x)
+    | [(Ast.COMP_idx _)] ->
+        bug () "Walk.name_of_ncs: path-name contains COMP_idx"
+    | nc::ncs -> Ast.NAME_ext (name_of ncs, nc)
+;;
+
+let path_to_name
+    (path:Ast.name_component Stack.t)
+    : Ast.name =
+  name_of (stk_elts_from_top path)
+;;
+
+
+let mod_item_logging_visitor
+    (logfn:string->unit)
+    (path:Ast.name_component Stack.t)
+    (inner:visitor)
+    : visitor =
+  let path_name _ = Ast.fmt_to_str Ast.fmt_name (path_to_name path) in
+  let visit_mod_item_pre name params item =
+    logfn (Printf.sprintf "entering %s" (path_name()));
+    inner.visit_mod_item_pre name params item;
+    logfn (Printf.sprintf "entered %s" (path_name()));
+  in
+  let visit_mod_item_post name params item =
+    logfn (Printf.sprintf "leaving %s" (path_name()));
+    inner.visit_mod_item_post name params item;
+    logfn (Printf.sprintf "left %s" (path_name()));
+  in
+  let visit_obj_fn_pre obj ident fn =
+    logfn (Printf.sprintf "entering %s" (path_name()));
+    inner.visit_obj_fn_pre obj ident fn;
+    logfn (Printf.sprintf "entered %s" (path_name()));
+  in
+  let visit_obj_fn_post obj ident fn =
+    logfn (Printf.sprintf "leaving %s" (path_name()));
+    inner.visit_obj_fn_post obj ident fn;
+    logfn (Printf.sprintf "left %s" (path_name()));
+  in
+  let visit_obj_drop_pre obj b =
+    logfn (Printf.sprintf "entering %s" (path_name()));
+    inner.visit_obj_drop_pre obj b;
+    logfn (Printf.sprintf "entered %s" (path_name()));
+  in
+  let visit_obj_drop_post obj fn =
+    logfn (Printf.sprintf "leaving %s" (path_name()));
+    inner.visit_obj_drop_post obj fn;
+    logfn (Printf.sprintf "left %s" (path_name()));
+  in
+    { inner with
+        visit_mod_item_pre = visit_mod_item_pre;
+        visit_mod_item_post = visit_mod_item_post;
+        visit_obj_fn_pre = visit_obj_fn_pre;
+        visit_obj_fn_post = visit_obj_fn_post;
+        visit_obj_drop_pre = visit_obj_drop_pre;
+        visit_obj_drop_post = visit_obj_drop_post;
+    }
+;;
+
+
+let walk_bracketed
+    (pre:'a -> unit)
+    (children:unit -> unit)
+    (post:'a -> unit)
+    (x:'a)
+    : unit =
+  begin
+    pre x;
+    children ();
+    post x
+  end
+;;
+
+
+let walk_option
+    (walker:'a -> unit)
+    (opt:'a option)
+    : unit =
+  match opt with
+      None -> ()
+    | Some v -> walker v
+;;
+
+
+let rec walk_crate
+    (v:visitor)
+    (crate:Ast.crate)
+    : unit =
+    walk_bracketed
+      v.visit_crate_pre
+      (fun _ -> walk_mod_items v (snd crate.node.Ast.crate_items))
+      v.visit_crate_post
+      crate
+
+and walk_mod_items
+    (v:visitor)
+    (items:Ast.mod_items)
+    : unit =
+  Hashtbl.iter (walk_mod_item v) items
+
+
+and walk_mod_item
+    (v:visitor)
+    (name:Ast.ident)
+    (item:Ast.mod_item)
+    : unit =
+  let children _ =
+    match item.node.Ast.decl_item with
+        Ast.MOD_ITEM_type ty -> walk_ty v ty
+      | Ast.MOD_ITEM_fn f -> walk_fn v f item.id
+      | Ast.MOD_ITEM_tag (htup, ttag, _) ->
+          walk_header_tup v htup;
+          walk_ty_tag v ttag
+      | Ast.MOD_ITEM_mod (_, items) ->
+          walk_mod_items v items
+      | Ast.MOD_ITEM_obj ob ->
+          walk_header_slots v ob.Ast.obj_state;
+          walk_constrs v (Some item.id) ob.Ast.obj_constrs;
+          let oid = { node = ob; id = item.id } in
+            Hashtbl.iter (walk_obj_fn v oid) ob.Ast.obj_fns;
+            match ob.Ast.obj_drop with
+                None -> ()
+              | Some d ->
+                  v.visit_obj_drop_pre oid d;
+                  walk_block v d;
+                  v.visit_obj_drop_post oid d
+
+  in
+    walk_bracketed
+      (v.visit_mod_item_pre name item.node.Ast.decl_params)
+      children
+      (v.visit_mod_item_post name item.node.Ast.decl_params)
+      item
+
+
+and walk_ty_tup v ttup = Array.iter (walk_slot v) ttup
+
+and walk_ty_tag v ttag = Hashtbl.iter (fun _ t -> walk_ty_tup v t) ttag
+
+and walk_ty
+    (v:visitor)
+    (ty:Ast.ty)
+    : unit =
+  let children _ =
+    match ty with
+        Ast.TY_tup ttup -> walk_ty_tup v ttup
+      | Ast.TY_vec s -> walk_slot v s
+      | Ast.TY_rec trec -> Array.iter (fun (_, s) -> walk_slot v s) trec
+      | Ast.TY_tag ttag -> walk_ty_tag v ttag
+      | Ast.TY_iso tiso -> Array.iter (walk_ty_tag v) tiso.Ast.iso_group
+      | Ast.TY_fn tfn -> walk_ty_fn v tfn
+      | Ast.TY_obj (_, fns) ->
+          Hashtbl.iter (fun _ tfn -> walk_ty_fn v tfn) fns
+      | Ast.TY_chan t -> walk_ty v t
+      | Ast.TY_port t -> walk_ty v t
+      | Ast.TY_constrained (t,cs) ->
+          begin
+            walk_ty v t;
+            walk_constrs v None cs
+          end
+      | Ast.TY_named _ -> ()
+      | Ast.TY_param _ -> ()
+      | Ast.TY_native _ -> ()
+      | Ast.TY_idx _ -> ()
+      | Ast.TY_mach _ -> ()
+      | Ast.TY_type -> ()
+      | Ast.TY_str -> ()
+      | Ast.TY_char -> ()
+      | Ast.TY_int -> ()
+      | Ast.TY_uint -> ()
+      | Ast.TY_bool -> ()
+      | Ast.TY_nil -> ()
+      | Ast.TY_task -> ()
+      | Ast.TY_any -> ()
+  in
+    walk_bracketed
+      v.visit_ty_pre
+      children
+      v.visit_ty_post
+      ty
+
+
+and walk_ty_sig
+    (v:visitor)
+    (s:Ast.ty_sig)
+    : unit =
+  begin
+    Array.iter (walk_slot v) s.Ast.sig_input_slots;
+    walk_constrs v None s.Ast.sig_input_constrs;
+    walk_slot v s.Ast.sig_output_slot;
+  end
+
+
+and walk_ty_fn
+    (v:visitor)
+    (tfn:Ast.ty_fn)
+    : unit =
+  let (tsig, _) = tfn in
+  walk_ty_sig v tsig
+
+
+and walk_constrs
+    (v:visitor)
+    (formal_base:node_id option)
+    (cs:Ast.constrs)
+    : unit =
+  Array.iter (walk_constr v formal_base) cs
+
+and walk_check_calls
+    (v:visitor)
+    (calls:Ast.check_calls)
+    : unit =
+  Array.iter
+    begin
+      fun (f, args) ->
+        walk_lval v f;
+        Array.iter (walk_atom v) args
+    end
+    calls
+
+
+and walk_constr
+    (v:visitor)
+    (formal_base:node_id option)
+    (c:Ast.constr)
+    : unit =
+  walk_bracketed
+    (v.visit_constr_pre formal_base)
+    (fun _ -> ())
+    (v.visit_constr_post formal_base)
+    c
+
+and walk_header_slots
+    (v:visitor)
+    (hslots:Ast.header_slots)
+    : unit =
+  Array.iter (fun (s,_) -> walk_slot_identified v s) hslots
+
+and walk_header_tup
+    (v:visitor)
+    (htup:Ast.header_tup)
+    : unit =
+  Array.iter (walk_slot_identified v) htup
+
+and walk_obj_fn
+    (v:visitor)
+    (obj:Ast.obj identified)
+    (ident:Ast.ident)
+    (f:Ast.fn identified)
+    : unit =
+  v.visit_obj_fn_pre obj ident f;
+  walk_fn v f.node f.id;
+  v.visit_obj_fn_post obj ident f
+
+and walk_fn
+    (v:visitor)
+    (f:Ast.fn)
+    (id:node_id)
+    : unit =
+  walk_header_slots v f.Ast.fn_input_slots;
+  walk_constrs v (Some id) f.Ast.fn_input_constrs;
+  walk_slot_identified v f.Ast.fn_output_slot;
+  walk_block v f.Ast.fn_body
+
+and walk_slot_identified
+    (v:visitor)
+    (s:Ast.slot identified)
+    : unit =
+  walk_bracketed
+    v.visit_slot_identified_pre
+    (fun _ -> walk_slot v s.node)
+    v.visit_slot_identified_post
+    s
+
+
+and walk_slot
+    (v:visitor)
+    (s:Ast.slot)
+    : unit =
+  walk_option (walk_ty v) s.Ast.slot_ty
+
+
+and walk_stmt
+    (v:visitor)
+    (s:Ast.stmt)
+    : unit =
+  let walk_stmt_for
+      (s:Ast.stmt_for)
+      : unit =
+    let (si,_) = s.Ast.for_slot in
+    let (ss,lv) = s.Ast.for_seq in
+      walk_slot_identified v si;
+      Array.iter (walk_stmt v) ss;
+      walk_lval v lv;
+      walk_block v s.Ast.for_body
+  in
+  let walk_stmt_for_each
+      (s:Ast.stmt_for_each)
+      : unit =
+    let (si,_) = s.Ast.for_each_slot in
+    let (f,az) = s.Ast.for_each_call in
+      walk_slot_identified v si;
+      walk_lval v f;
+      Array.iter (walk_atom v) az;
+      walk_block v s.Ast.for_each_head
+  in
+  let walk_stmt_while
+      (s:Ast.stmt_while)
+      : unit =
+    let (ss,e) = s.Ast.while_lval in
+      Array.iter (walk_stmt v) ss;
+      walk_expr v e;
+      walk_block v s.Ast.while_body
+  in
+  let children _ =
+    match s.node with
+        Ast.STMT_log a ->
+          walk_atom v a
+
+      | Ast.STMT_init_rec (lv, atab, base) ->
+          walk_lval v lv;
+          Array.iter (fun (_, _, _, a) -> walk_atom v a) atab;
+          walk_option (walk_lval v) base;
+
+      | Ast.STMT_init_vec (lv, _, atoms) ->
+          walk_lval v lv;
+          Array.iter (walk_atom v) atoms
+
+      | Ast.STMT_init_tup (lv, mut_atoms) ->
+          walk_lval v lv;
+          Array.iter (fun (_, _, a) -> walk_atom v a) mut_atoms
+
+      | Ast.STMT_init_str (lv, _) ->
+          walk_lval v lv
+
+      | Ast.STMT_init_port lv ->
+          walk_lval v lv
+
+      | Ast.STMT_init_chan (chan,port) ->
+          walk_option (walk_lval v) port;
+          walk_lval v chan;
+
+      | Ast.STMT_for f ->
+          walk_stmt_for f
+
+      | Ast.STMT_for_each f ->
+          walk_stmt_for_each f
+
+      | Ast.STMT_while w ->
+          walk_stmt_while w
+
+      | Ast.STMT_do_while w ->
+          walk_stmt_while w
+
+      | Ast.STMT_if i ->
+          begin
+            walk_expr v i.Ast.if_test;
+            walk_block v i.Ast.if_then;
+            walk_option (walk_block v) i.Ast.if_else
+          end
+
+      | Ast.STMT_block b ->
+          walk_block v b
+
+      | Ast.STMT_copy (lv,e) ->
+          walk_lval v lv;
+          walk_expr v e
+
+      | Ast.STMT_copy_binop (lv,_,a) ->
+          walk_lval v lv;
+          walk_atom v a
+
+      | Ast.STMT_call (dst,f,az) ->
+          walk_lval v dst;
+          walk_lval v f;
+          Array.iter (walk_atom v) az
+
+      | Ast.STMT_bind (dst, f, az) ->
+          walk_lval v dst;
+          walk_lval v f;
+          Array.iter (walk_opt_atom v) az
+
+      | Ast.STMT_spawn (dst,_,p,az) ->
+          walk_lval v dst;
+          walk_lval v p;
+          Array.iter (walk_atom v) az
+
+      | Ast.STMT_ret ao ->
+          walk_option (walk_atom v) ao
+
+      | Ast.STMT_put at ->
+          walk_option (walk_atom v) at
+
+      | Ast.STMT_put_each (lv, ats) ->
+          walk_lval v lv;
+          Array.iter (walk_atom v) ats
+
+      (* FIXME: this should have a param array, and invoke the visitors. *)
+      | Ast.STMT_decl (Ast.DECL_mod_item (id, mi)) ->
+          walk_mod_item v id mi
+
+      | Ast.STMT_decl (Ast.DECL_slot (_, slot)) ->
+          walk_slot_identified v slot
+
+      | Ast.STMT_yield
+      | Ast.STMT_fail ->
+          ()
+
+      | Ast.STMT_join task ->
+          walk_lval v task
+
+      | Ast.STMT_send (dst,src) ->
+          walk_lval v dst;
+          walk_lval v src
+
+      | Ast.STMT_recv (dst,src) ->
+          walk_lval v dst;
+          walk_lval v src
+
+      | Ast.STMT_be (lv, ats) ->
+          walk_lval v lv;
+          Array.iter (walk_atom v) ats
+
+      | Ast.STMT_check_expr e ->
+          walk_expr v e
+
+      | Ast.STMT_check (cs, calls) ->
+          walk_constrs v None cs;
+          walk_check_calls v calls
+
+      | Ast.STMT_check_if (cs,calls,b) ->
+          walk_constrs v None cs;
+          walk_check_calls v calls;
+          walk_block v b
+
+      | Ast.STMT_prove cs ->
+          walk_constrs v None cs
+
+      | Ast.STMT_alt_tag
+          { Ast.alt_tag_lval = lval; Ast.alt_tag_arms = arms } ->
+          walk_lval v lval;
+          let walk_arm { node = (pat, block) } =
+            walk_pat v pat;
+            walk_block v block
+          in
+          Array.iter walk_arm arms
+
+      (* FIXME (issue #20): finish this as needed. *)
+      | Ast.STMT_slice _
+      | Ast.STMT_note _
+      | Ast.STMT_alt_type _
+      | Ast.STMT_alt_port _ ->
+          bug () "unimplemented statement type in Walk.walk_stmt"
+  in
+    walk_bracketed
+      v.visit_stmt_pre
+      children
+      v.visit_stmt_post
+      s
+
+
+and walk_expr
+    (v:visitor)
+    (e:Ast.expr)
+    : unit =
+  let children _ =
+    match e with
+        Ast.EXPR_binary (_,aa,ab) ->
+          walk_atom v aa;
+          walk_atom v ab
+      | Ast.EXPR_unary (_,a) ->
+          walk_atom v a
+      | Ast.EXPR_atom a ->
+          walk_atom v a
+  in
+  walk_bracketed
+    v.visit_expr_pre
+    children
+    v.visit_expr_post
+    e
+
+and walk_atom
+    (v:visitor)
+    (a:Ast.atom)
+    : unit =
+  match a with
+      Ast.ATOM_literal ls -> walk_lit v ls.node
+    | Ast.ATOM_lval lv -> walk_lval v lv
+
+
+and walk_opt_atom
+    (v:visitor)
+    (ao:Ast.atom option)
+    : unit =
+  match ao with
+      None -> ()
+    | Some a -> walk_atom v a
+
+
+and walk_lit
+    (v:visitor)
+    (li:Ast.lit)
+    : unit =
+  walk_bracketed
+    v.visit_lit_pre
+    (fun _ -> ())
+    v.visit_lit_post
+    li
+
+
+and walk_lval
+    (v:visitor)
+    (lv:Ast.lval)
+    : unit =
+  walk_bracketed
+    v.visit_lval_pre
+    (fun _ -> ())
+    v.visit_lval_post
+    lv
+
+
+and walk_pat
+    (v:visitor)
+    (p:Ast.pat)
+    : unit =
+  let rec walk p =
+    match p with
+        Ast.PAT_lit lit -> walk_lit v lit
+      | Ast.PAT_tag (_, pats) -> Array.iter walk pats
+      | Ast.PAT_slot (si, _) -> walk_slot_identified v si
+      | Ast.PAT_wild -> ()
+  in
+  walk_bracketed
+    v.visit_pat_pre
+    (fun _ -> walk p)
+    v.visit_pat_post
+    p
+
+
+and walk_block
+    (v:visitor)
+    (b:Ast.block)
+    : unit =
+  walk_bracketed
+    v.visit_block_pre
+    (fun _ -> (Array.iter (walk_stmt v) b.node))
+    v.visit_block_post
+    b
+;;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/util/bits.ml

@@ -0,0 +1,107 @@
+type t = {
+  storage: int array;
+  nbits: int;
+}
+;;
+
+let int_bits =
+  if max_int = (1 lsl 30) - 1
+  then 31
+  else 63
+;;
+
+let create nbits flag =
+  { storage = Array.make (nbits / int_bits + 1) (if flag then lnot 0 else 0);
+    nbits = nbits }
+;;
+
+(* 
+ * mutate v0 in place: v0.(i) <- v0.(i) op v1.(i), returning bool indicating
+ * whether any bits in v0 changed in the process. 
+ *)
+let process (op:int -> int -> int) (v0:t) (v1:t) : bool =
+  let changed = ref false in
+    assert (v0.nbits = v1.nbits);
+    assert ((Array.length v0.storage) = (Array.length v1.storage));
+    Array.iteri
+      begin
+        fun i w1 ->
+          let w0 = v0.storage.(i) in
+          let w0' = op w0 w1 in
+            if not (w0' = w0)
+            then changed := true;
+            v0.storage.(i) <- w0';
+      end
+      v1.storage;
+    !changed
+;;
+
+let union = process (lor) ;;
+let intersect = process (land) ;;
+let copy = process (fun _ w1 -> w1) ;;
+
+let get (v:t) (i:int) : bool =
+  assert (i >= 0);
+  assert (i < v.nbits);
+  let w = i / int_bits in
+  let b = i mod int_bits in
+  let x = 1 land (v.storage.(w) lsr b) in
+    x = 1
+;;
+
+let equal (v1:t) (v0:t) : bool =
+  v0 = v1
+;;
+
+let clear (v:t) : unit =
+  for i = 0 to (Array.length v.storage) - 1
+  do
+    v.storage.(i) <- 0
+  done
+;;
+
+let invert (v:t) : unit =
+  for i = 0 to (Array.length v.storage) - 1
+  do
+    v.storage.(i) <- lnot v.storage.(i)
+  done
+;;
+
+let set (v:t) (i:int) (x:bool) : unit =
+  assert (i >= 0);
+  assert (i < v.nbits);
+  let w = i / int_bits in
+  let b = i mod int_bits in
+  let w0 = v.storage.(w) in
+  let flag = 1 lsl b in
+    v.storage.(w) <-
+      if x
+      then w0 lor flag
+      else w0 land (lnot flag)
+;;
+
+let to_list (v:t) : int list =
+  if v.nbits = 0
+  then []
+  else
+    let accum = ref [] in
+    let word = ref v.storage.(0) in
+      for i = 0 to (v.nbits-1) do
+        if i mod int_bits = 0
+        then word := v.storage.(i / int_bits);
+        if (1 land (!word)) = 1
+        then accum := i :: (!accum);
+        word := (!word) lsr 1;
+      done;
+      !accum
+;;
+
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/boot/util/common.ml

@@ -0,0 +1,709 @@
+(*
+ * This module goes near the *bottom* of the dependency DAG, and holds basic
+ * types shared across all phases of the compiler.
+ *)
+
+type filename = string
+type pos = (filename * int * int)
+type span = {lo: pos; hi: pos}
+
+type node_id = Node of int
+type temp_id = Temp of int
+type opaque_id = Opaque of int
+type constr_id = Constr of int
+
+let int_of_node (Node i) = i
+let int_of_temp (Temp i) = i
+let int_of_opaque (Opaque i) = i
+let int_of_constr (Constr i) = i
+
+type 'a identified = { node: 'a; id: node_id }
+;;
+
+let bug _ =
+  let k s = failwith s
+  in Printf.ksprintf k
+;;
+
+exception Semant_err of ((node_id option) * string)
+;;
+
+let err (idopt:node_id option) =
+  let k s =
+    raise (Semant_err (idopt, s))
+  in
+    Printf.ksprintf k
+;;
+
+(* Some ubiquitous low-level types. *)
+
+type target =
+    Linux_x86_elf
+  | Win32_x86_pe
+  | MacOS_x86_macho
+;;
+
+type ty_mach =
+    TY_u8
+  | TY_u16
+  | TY_u32
+  | TY_u64
+  | TY_i8
+  | TY_i16
+  | TY_i32
+  | TY_i64
+  | TY_f32
+  | TY_f64
+;;
+
+let mach_is_integral (mach:ty_mach) : bool =
+  match mach with
+      TY_i8 | TY_i16 | TY_i32 | TY_i64
+    | TY_u8 | TY_u16 | TY_u32 | TY_u64 -> true
+    | TY_f32 | TY_f64 -> false
+;;
+
+
+let mach_is_signed (mach:ty_mach) : bool =
+  match mach with
+      TY_i8 | TY_i16 | TY_i32 | TY_i64 -> true
+    | TY_u8 | TY_u16 | TY_u32 | TY_u64
+    | TY_f32 | TY_f64 -> false
+;;
+
+let string_of_ty_mach (mach:ty_mach) : string =
+  match mach with
+    TY_u8 -> "u8"
+  | TY_u16 -> "u16"
+  | TY_u32 -> "u32"
+  | TY_u64 -> "u64"
+  | TY_i8 -> "i8"
+  | TY_i16 -> "i16"
+  | TY_i32 -> "i32"
+  | TY_i64 -> "i64"
+  | TY_f32 -> "f32"
+  | TY_f64 -> "f64"
+;;
+
+let bytes_of_ty_mach (mach:ty_mach) : int =
+  match mach with
+    TY_u8 -> 1
+  | TY_u16 -> 2
+  | TY_u32 -> 4
+  | TY_u64 -> 8
+  | TY_i8 -> 1
+  | TY_i16 -> 2
+  | TY_i32 -> 4
+  | TY_i64 -> 8
+  | TY_f32 -> 4
+  | TY_f64 -> 8
+;;
+
+type ty_param_idx = int
+;;
+
+type nabi_conv =
+    CONV_rust
+  | CONV_cdecl
+;;
+
+type nabi = { nabi_indirect: bool;
+              nabi_convention: nabi_conv }
+;;
+
+let string_to_conv (a:string) : nabi_conv option =
+  match a with
+      "cdecl" -> Some CONV_cdecl
+    | "rust" -> Some CONV_rust
+    | _ -> None
+
+(* FIXME: remove this when native items go away. *)
+let string_to_nabi (s:string) (indirect:bool) : nabi option =
+  match string_to_conv s with
+      None -> None
+    | Some c ->
+        Some { nabi_indirect = indirect;
+               nabi_convention = c }
+;;
+
+type required_lib_spec =
+    {
+      required_libname: string;
+      required_prefix: int;
+    }
+;;
+
+type required_lib =
+    REQUIRED_LIB_rustrt
+  | REQUIRED_LIB_crt
+  | REQUIRED_LIB_rust of required_lib_spec
+  | REQUIRED_LIB_c of required_lib_spec
+;;
+
+type segment =
+    SEG_text
+  | SEG_data
+;;
+
+type fixup =
+    { fixup_name: string;
+      mutable fixup_file_pos: int option;
+      mutable fixup_file_sz: int option;
+      mutable fixup_mem_pos: int64 option;
+      mutable fixup_mem_sz: int64 option }
+;;
+
+
+let new_fixup (s:string)
+    : fixup =
+  { fixup_name = s;
+    fixup_file_pos = None;
+    fixup_file_sz = None;
+    fixup_mem_pos = None;
+    fixup_mem_sz = None }
+;;
+
+
+(*
+ * Auxiliary hashtable functions.
+ *)
+
+let htab_keys (htab:('a,'b) Hashtbl.t) : ('a list) =
+  Hashtbl.fold (fun k _ accum -> k :: accum) htab []
+;;
+
+let sorted_htab_keys (tab:('a, 'b) Hashtbl.t) : 'a array =
+  let keys = Array.of_list (htab_keys tab) in
+    Array.sort compare keys;
+    keys
+;;
+
+let htab_vals (htab:('a,'b) Hashtbl.t) : ('b list)  =
+  Hashtbl.fold (fun _ v accum -> v :: accum) htab []
+;;
+
+let htab_pairs (htab:('a,'b) Hashtbl.t) : (('a * 'b) list) =
+  Hashtbl.fold (fun k v accum -> (k,v) :: accum) htab []
+;;
+
+let htab_search (htab:('a,'b) Hashtbl.t) (k:'a) : ('b option) =
+  if Hashtbl.mem htab k
+  then Some (Hashtbl.find htab k)
+  else None
+;;
+
+let htab_search_or_default
+    (htab:('a,'b) Hashtbl.t)
+    (k:'a)
+    (def:unit -> 'b)
+    : 'b =
+  match htab_search htab k with
+      Some v -> v
+    | None -> def()
+;;
+
+let htab_search_or_add
+    (htab:('a,'b) Hashtbl.t)
+    (k:'a)
+    (mk:unit -> 'b)
+    : 'b =
+  let def () =
+    let v = mk() in
+      Hashtbl.add htab k v;
+      v
+  in
+    htab_search_or_default htab k def
+;;
+
+let htab_put (htab:('a,'b) Hashtbl.t) (a:'a) (b:'b) : unit =
+  assert (not (Hashtbl.mem htab a));
+  Hashtbl.add htab a b
+;;
+
+let htab_map
+    (htab:('a,'b) Hashtbl.t)
+    (f:'a -> 'b -> ('c * 'd))
+    : (('c,'d) Hashtbl.t) =
+  let ntab = Hashtbl.create (Hashtbl.length htab) in
+  let g a b =
+    let (c,d) = f a b in
+      htab_put ntab c d
+  in
+    Hashtbl.iter g htab;
+    ntab
+;;
+
+
+let htab_fold
+    (fn:'a -> 'b -> 'c -> 'c)
+    (init:'c)
+    (h:('a, 'b) Hashtbl.t) : 'c =
+  let accum = ref init in
+  let f a b = accum := (fn a b (!accum)) in
+    Hashtbl.iter f h;
+    !accum
+;;
+
+
+let reduce_hash_to_list
+    (fn:'a -> 'b -> 'c)
+    (h:('a, 'b) Hashtbl.t)
+    : ('c list) =
+  htab_fold (fun a b ls -> (fn a b) :: ls) [] h
+;;
+
+(* 
+ * Auxiliary association-array and association-list operations.
+ *)
+let atab_search (atab:('a * 'b) array) (a:'a) : ('b option) =
+  let lim = Array.length atab in
+  let rec step i =
+    if i = lim
+    then None
+    else
+      let (k,v) = atab.(i) in
+        if k = a
+        then Some v
+        else step (i+1)
+  in
+    step 0
+
+let atab_find (atab:('a * 'b) array) (a:'a) : 'b =
+  match atab_search atab a with
+      None -> bug () "atab_find: element not found"
+    | Some b -> b
+
+let atab_mem (atab:('a * 'b) array) (a:'a) : bool =
+  match atab_search atab a with
+      None -> false
+    | Some _ -> true
+
+let rec ltab_search (ltab:('a * 'b) list) (a:'a) : ('b option) =
+  match ltab with
+      [] -> None
+    | (k,v)::_ when k = a -> Some v
+    | _::lz -> ltab_search lz a
+
+let ltab_put (ltab:('a * 'b) list) (a:'a) (b:'b) : (('a * 'b) list) =
+  assert ((ltab_search ltab a) = None);
+  (a,b)::ltab
+
+(*
+ * Auxiliary list functions.
+ *)
+
+let rec list_search (list:'a list) (f:'a -> 'b option) : ('b option) =
+  match list with
+      [] -> None
+    | a::az ->
+        match f a with
+            Some b -> Some b
+          | None -> list_search az f
+
+let rec list_search_ctxt
+    (list:'a list)
+    (f:'a -> 'b option)
+    : ((('a list) * 'b) option) =
+  match list with
+      [] -> None
+    | a::az ->
+        match f a with
+            Some b -> Some (list, b)
+          | None -> list_search_ctxt az f
+
+let rec list_drop n ls =
+  if n = 0
+  then ls
+  else list_drop (n-1) (List.tl ls)
+;;
+
+
+(*
+ * Auxiliary option functions.
+ *)
+
+let bool_of_option x =
+  match x with
+      Some _ -> true
+    | None -> false
+
+
+(*
+ * Auxiliary stack functions.
+ *)
+
+let stk_fold (s:'a Stack.t) (f:'a -> 'b -> 'b) (x:'b) : 'b =
+  let r = ref x in
+    Stack.iter (fun e -> r := f e (!r)) s;
+    !r
+
+let stk_elts_from_bot (s:'a Stack.t) : ('a list) =
+  stk_fold s (fun x y -> x::y) []
+
+let stk_elts_from_top (s:'a Stack.t) : ('a list) =
+  List.rev (stk_elts_from_bot s)
+
+let stk_search (s:'a Stack.t) (f:'a -> 'b option) : 'b option =
+  stk_fold s (fun e accum -> match accum with None -> (f e) | x -> x) None
+
+
+(*
+ * Auxiliary array functions.
+ *)
+
+let arr_search (a:'a array) (f:int -> 'a -> 'b option) : 'b option =
+  let max = Array.length a in
+  let rec iter i =
+    if i < max
+    then
+      let v = a.(i) in
+      let r = f i v in
+        match r with
+            Some _ -> r
+          | None -> iter (i+1)
+    else
+      None
+  in
+    iter 0
+;;
+
+let arr_idx (arr:'a array) (a:'a) : int =
+  let find i v = if v = a then Some i else None in
+    match arr_search arr find with
+        None -> bug () "arr_idx: element not found"
+      | Some i -> i
+;;
+
+let arr_map_partial (a:'a array) (f:'a -> 'b option) : 'b array =
+  let accum a ls =
+    match f a with
+        None -> ls
+      | Some b -> b :: ls
+  in
+    Array.of_list (Array.fold_right accum a [])
+;;
+
+let arr_filter_some (a:'a option array) : 'a array =
+  arr_map_partial a (fun x -> x)
+;;
+
+let arr_find_dups (a:'a array) : ('a * 'a) option =
+  let copy = Array.copy a in
+    Array.sort compare copy;
+    let lasti = (Array.length copy) - 1 in
+    let rec find_dups i =
+      if i < lasti then
+        let this = copy.(i) in
+        let next = copy.(i+1) in
+          (if (this = next) then
+             Some (this, next)
+           else
+             find_dups (i+1))
+      else
+        None
+    in
+      find_dups 0
+;;
+
+let arr_check_dups (a:'a array) (f:'a -> 'a -> unit) : unit =
+  match arr_find_dups a with
+      Some (x, y) -> f x y
+    | None -> ()
+;;
+
+let arr_map2 (f:'a -> 'b -> 'c) (a:'a array) (b:'b array) : 'c array =
+  assert ((Array.length a) = (Array.length b));
+  Array.init (Array.length a) (fun i -> f a.(i) b.(i))
+;;
+
+let arr_for_all (f:int -> 'a -> bool) (a:'a array) : bool =
+  let len = Array.length a in
+  let rec loop i =
+    (i >= len) || ((f i a.(i)) && (loop (i+1)))
+  in
+    loop 0
+;;
+
+let arr_exists (f:int -> 'a -> bool) (a:'a array) : bool =
+  let len = Array.length a in
+  let rec loop i =
+    (i < len) && ((f i a.(i)) || (loop (i+1)))
+  in
+    loop 0
+;;
+
+(* 
+ * Auxiliary queue functions. 
+ *)
+
+let queue_to_list (q:'a Queue.t) : 'a list =
+  List.rev (Queue.fold (fun ls elt -> elt :: ls)  []  q)
+;;
+
+let queue_to_arr (q:'a Queue.t) : 'a array =
+  Array.init (Queue.length q) (fun _ -> Queue.take q)
+;;
+
+(*
+ * Auxiliary int64 functions
+ *)
+
+let i64_lt (a:int64) (b:int64) : bool = (Int64.compare a b) < 0
+let i64_le (a:int64) (b:int64) : bool = (Int64.compare a b) <= 0
+let i64_ge (a:int64) (b:int64) : bool = (Int64.compare a b) >= 0
+let i64_gt (a:int64) (b:int64) : bool = (Int64.compare a b) > 0
+let i64_max (a:int64) (b:int64) : int64 =
+  (if (Int64.compare a b) > 0 then a else b)
+let i64_min (a:int64) (b:int64) : int64 =
+  (if (Int64.compare a b) < 0 then a else b)
+let i64_align (align:int64) (v:int64) : int64 =
+  (assert (align <> 0L));
+  let mask = Int64.sub align 1L in
+    Int64.logand (Int64.lognot mask) (Int64.add v mask)
+;;
+
+let rec i64_for (lo:int64) (hi:int64) (thunk:int64 -> unit) : unit =
+  if i64_lt lo hi then
+    begin
+      thunk lo;
+      i64_for (Int64.add lo 1L) hi thunk;
+    end
+;;
+
+let rec i64_for_rev (hi:int64) (lo:int64) (thunk:int64 -> unit) : unit =
+  if i64_ge hi lo then
+    begin
+      thunk hi;
+      i64_for_rev (Int64.sub hi 1L) lo thunk;
+    end
+;;
+
+
+(*
+ * Auxiliary int32 functions
+ *)
+
+let i32_lt (a:int32) (b:int32) : bool = (Int32.compare a b) < 0
+let i32_le (a:int32) (b:int32) : bool = (Int32.compare a b) <= 0
+let i32_ge (a:int32) (b:int32) : bool = (Int32.compare a b) >= 0
+let i32_gt (a:int32) (b:int32) : bool = (Int32.compare a b) > 0
+let i32_max (a:int32) (b:int32) : int32 =
+  (if (Int32.compare a b) > 0 then a else b)
+let i32_min (a:int32) (b:int32) : int32 =
+  (if (Int32.compare a b) < 0 then a else b)
+let i32_align (align:int32) (v:int32) : int32 =
+  (assert (align <> 0l));
+  let mask = Int32.sub align 1l in
+    Int32.logand (Int32.lognot mask) (Int32.add v mask)
+;;
+
+(*
+ * Int-as-unichar functions.
+ *)
+
+let bounds lo c hi = (lo <= c) && (c <= hi)
+;;
+
+let escaped_char i =
+  if bounds 0 i 0x7f
+  then Char.escaped (Char.chr i)
+  else
+    if bounds 0 i 0xffff
+    then Printf.sprintf "\\u%4.4X" i
+    else Printf.sprintf "\\U%8.8X" i
+;;
+
+let char_as_utf8 i =
+  let buf = Buffer.create 8 in
+  let addb i =
+    Buffer.add_char buf (Char.chr (i land 0xff))
+  in
+  let fini _ =
+    Buffer.contents buf
+  in
+  let rec add_trailing_bytes n i =
+    if n = 0
+    then fini()
+    else
+      begin
+        addb (0b1000_0000 lor ((i lsr ((n-1) * 6)) land 0b11_1111));
+        add_trailing_bytes (n-1) i
+      end
+  in
+    if bounds 0 i 0x7f
+    then (addb i; fini())
+    else
+      if bounds 0x80 i 0x7ff
+      then (addb ((0b1100_0000) lor (i lsr 6));
+            add_trailing_bytes 1 i)
+      else
+        if bounds 0x800 i 0xffff
+        then (addb ((0b1110_0000) lor (i lsr 12));
+              add_trailing_bytes 2 i)
+        else
+          if bounds 0x1000 i 0x1f_ffff
+          then (addb ((0b1111_0000) lor (i lsr 18));
+                add_trailing_bytes 3 i)
+          else
+            if bounds 0x20_0000 i 0x3ff_ffff
+            then (addb ((0b1111_1000) lor (i lsr 24));
+                  add_trailing_bytes 4 i)
+            else
+              if bounds 0x400_0000 i 0x7fff_ffff
+              then (addb ((0b1111_1100) lor (i lsr 30));
+                    add_trailing_bytes 5 i)
+              else bug () "bad unicode character 0x%X" i
+;;
+
+(*
+ * Size-expressions.
+ *)
+
+
+type size =
+    SIZE_fixed of int64
+  | SIZE_fixup_mem_sz of fixup
+  | SIZE_fixup_mem_pos of fixup
+  | SIZE_param_size of ty_param_idx
+  | SIZE_param_align of ty_param_idx
+  | SIZE_rt_neg of size
+  | SIZE_rt_add of size * size
+  | SIZE_rt_mul of size * size
+  | SIZE_rt_max of size * size
+  | SIZE_rt_align of size * size
+;;
+
+let rec string_of_size (s:size) : string =
+  match s with
+      SIZE_fixed i -> Printf.sprintf "%Ld" i
+    | SIZE_fixup_mem_sz f -> Printf.sprintf "%s.mem_sz" f.fixup_name
+    | SIZE_fixup_mem_pos f -> Printf.sprintf "%s.mem_pos" f.fixup_name
+    | SIZE_param_size i -> Printf.sprintf "ty[%d].size" i
+    | SIZE_param_align i -> Printf.sprintf "ty[%d].align" i
+    | SIZE_rt_neg a ->
+        Printf.sprintf "-(%s)" (string_of_size a)
+    | SIZE_rt_add (a, b) ->
+        Printf.sprintf "(%s + %s)" (string_of_size a) (string_of_size b)
+    | SIZE_rt_mul (a, b) ->
+        Printf.sprintf "(%s * %s)" (string_of_size a) (string_of_size b)
+    | SIZE_rt_max (a, b) ->
+        Printf.sprintf "max(%s,%s)" (string_of_size a) (string_of_size b)
+    | SIZE_rt_align (align, off) ->
+        Printf.sprintf "align(%s,%s)"
+          (string_of_size align) (string_of_size off)
+;;
+
+let neg_sz (a:size) : size =
+  match a with
+      SIZE_fixed a -> SIZE_fixed (Int64.neg a)
+    | _ -> SIZE_rt_neg a
+;;
+
+let add_sz (a:size) (b:size) : size =
+  match (a, b) with
+      (SIZE_fixed a, SIZE_fixed b) -> SIZE_fixed (Int64.add a b)
+
+    | ((SIZE_rt_add ((SIZE_fixed a), c)), SIZE_fixed b)
+    | ((SIZE_rt_add (c, (SIZE_fixed a))), SIZE_fixed b)
+    | (SIZE_fixed a, (SIZE_rt_add ((SIZE_fixed b), c)))
+    | (SIZE_fixed a, (SIZE_rt_add (c, (SIZE_fixed b)))) ->
+        SIZE_rt_add (SIZE_fixed (Int64.add a b), c)
+
+    | (SIZE_fixed 0L, b) -> b
+    | (a, SIZE_fixed 0L) -> a
+    | (a, SIZE_fixed b) -> SIZE_rt_add (SIZE_fixed b, a)
+    | (a, b) -> SIZE_rt_add (a, b)
+;;
+
+let mul_sz (a:size) (b:size) : size =
+  match (a, b) with
+      (SIZE_fixed a, SIZE_fixed b) -> SIZE_fixed (Int64.mul a b)
+    | (a, SIZE_fixed b) -> SIZE_rt_mul (SIZE_fixed b, a)
+    | (a, b) -> SIZE_rt_mul (a, b)
+;;
+
+let rec max_sz (a:size) (b:size) : size =
+  let rec no_negs x =
+    match x with
+        SIZE_fixed _
+      | SIZE_fixup_mem_sz _
+      | SIZE_fixup_mem_pos _
+      | SIZE_param_size _
+      | SIZE_param_align _ -> true
+      | SIZE_rt_neg _ -> false
+      | SIZE_rt_add (a,b) -> (no_negs a) && (no_negs b)
+      | SIZE_rt_mul (a,b) -> (no_negs a) && (no_negs b)
+      | SIZE_rt_max (a,b) -> (no_negs a) && (no_negs b)
+      | SIZE_rt_align (a,b) -> (no_negs a) && (no_negs b)
+  in
+    match (a, b) with
+        (SIZE_rt_align _, SIZE_fixed 1L) -> a
+      | (SIZE_fixed 1L, SIZE_rt_align _) -> b
+      | (SIZE_param_align _, SIZE_fixed 1L) -> a
+      | (SIZE_fixed 1L, SIZE_param_align _) -> b
+      | (a, SIZE_rt_max (b, c)) when a = b -> max_sz a c
+      | (a, SIZE_rt_max (b, c)) when a = c -> max_sz a b
+      | (SIZE_rt_max (b, c), a) when a = b -> max_sz a c
+      | (SIZE_rt_max (b, c), a) when a = c -> max_sz a b
+      | (SIZE_fixed a, SIZE_fixed b) -> SIZE_fixed (i64_max a b)
+      | (SIZE_fixed 0L, b) when no_negs b -> b
+      | (a, SIZE_fixed 0L) when no_negs a -> b
+      | (a, SIZE_fixed b) -> max_sz (SIZE_fixed b) a
+      | (a, b) when a = b -> a
+      | (a, b) -> SIZE_rt_max (a, b)
+;;
+
+(* FIXME: audit this carefuly; I am not terribly certain of the
+ * algebraic simplification going on here. Sadly, without it
+ * the diagnostic output from translation becomes completely
+ * illegible.
+ *)
+
+let align_sz (a:size) (b:size) : size =
+  let rec alignment_of s =
+    match s with
+        SIZE_rt_align (SIZE_fixed n, s) ->
+          let inner_alignment = alignment_of s in
+            if (Int64.rem n inner_alignment) = 0L
+            then inner_alignment
+            else n
+      | SIZE_rt_add (SIZE_fixed n, s)
+      | SIZE_rt_add (s, SIZE_fixed n) ->
+          let inner_alignment = alignment_of s in
+            if (Int64.rem n inner_alignment) = 0L
+            then inner_alignment
+            else 1L (* This could be lcd(...) or such. *)
+      | SIZE_rt_max (a, SIZE_fixed 1L) -> alignment_of a
+      | SIZE_rt_max (SIZE_fixed 1L, b) -> alignment_of b
+      | _ -> 1L
+  in
+    match (a, b) with
+        (SIZE_fixed a, SIZE_fixed b) -> SIZE_fixed (i64_align a b)
+      | (SIZE_fixed x, _) when i64_lt x 1L -> bug () "alignment less than 1"
+      | (SIZE_fixed 1L, b) -> b (* everything is 1-aligned. *)
+      | (_, SIZE_fixed 0L) -> b (* 0 is everything-aligned. *)
+      | (SIZE_fixed a, b) ->
+          let inner_alignment = alignment_of b in
+          if (Int64.rem a inner_alignment) = 0L
+          then b
+          else SIZE_rt_align (SIZE_fixed a, b)
+      | (SIZE_rt_max (a, SIZE_fixed 1L), b) -> SIZE_rt_align (a, b)
+      | (SIZE_rt_max (SIZE_fixed 1L, a), b) -> SIZE_rt_align (a, b)
+      | (a, b) -> SIZE_rt_align (a, b)
+;;
+
+let force_sz (a:size) : int64 =
+  match a with
+      SIZE_fixed i -> i
+    | _ -> bug () "force_sz: forced non-fixed size expression %s"
+        (string_of_size a)
+;;
+
+(*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C ../.. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ *)

src/comp/driver/rustc.rs

@@ -0,0 +1,12 @@
+// -*- rust -*-
+
+fn main(vec[str] args) -> () {
+  let int i = 0;
+  for (str filename in args) {
+    if (i > 0) {
+      auto br = std._io.mk_buf_reader(filename);
+      log "opened file: " + filename;
+    }
+    i += 1;
+  }
+}

src/comp/rustc.rc

@@ -0,0 +1,20 @@
+
+// -*- rust -*-
+
+use std;
+
+mod fe {
+    mod lexer;
+    mod parser;
+}
+
+mod driver {
+    mod rustc;
+}
+
+// Local Variables:
+// fill-column: 78;
+// indent-tabs-mode: nil
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:

src/etc/tidy.py

@@ -0,0 +1,25 @@
+#!/usr/bin/python
+
+import sys, fileinput
+
+err=0
+cols=78
+
+def report_err(s):
+    global err
+    print("%s:%d: %s" % (fileinput.filename(), fileinput.filelineno(), s))
+    err=1
+
+for line in fileinput.input(openhook=fileinput.hook_encoded("utf-8")):
+    if line.find('\t') != -1 and fileinput.filename().find("Makefile") == -1:
+        report_err("tab character")
+
+    if line.find('\r') != -1:
+        report_err("CR character")
+
+    if len(line)-1 > cols:
+        report_err("line longer than %d chars" % cols)
+
+
+sys.exit(err)
+

src/etc/x86.supp

@@ -0,0 +1,14 @@
+{
+   our-failure-to-setup-freeres-structure
+   Memcheck:Free
+   fun:free
+   ...
+   fun:_vgnU_freeres
+}
+
+{
+ leaked-TLS-chunk-x86-exit-path-fails-to-clean-up
+ Memcheck:Leak
+ fun:calloc
+ fun:_dl_allocate_tls
+}

src/lib/_int.rs

@@ -0,0 +1,20 @@
+fn add(int x, int y) -> int { ret x + y; }
+fn sub(int x, int y) -> int { ret x - y; }
+fn mul(int x, int y) -> int { ret x * y; }
+fn div(int x, int y) -> int { ret x / y; }
+fn rem(int x, int y) -> int { ret x % y; }
+
+fn lt(int x, int y) -> bool { ret x < y; }
+fn le(int x, int y) -> bool { ret x <= y; }
+fn eq(int x, int y) -> bool { ret x == y; }
+fn ne(int x, int y) -> bool { ret x != y; }
+fn ge(int x, int y) -> bool { ret x >= y; }
+fn gt(int x, int y) -> bool { ret x > y; }
+
+iter range(mutable int lo, int hi) -> int {
+  while (lo < hi) {
+    put lo;
+    lo += 1;
+  }
+}
+

src/lib/_io.rs

@@ -0,0 +1,36 @@
+type buf_reader = obj {
+  fn read(vec[u8] buf) -> uint;
+};
+
+type buf_writer = obj {
+  fn write(vec[u8] buf) -> uint;
+};
+
+fn mk_buf_reader(str s) -> buf_reader {
+
+  obj fd_reader(int fd) {
+    fn read(vec[u8] v) -> uint {
+      auto len = _vec.len[u8](v);
+      auto buf = _vec.buf[u8](v);
+      auto count = os.libc.read(fd, buf, len);
+      if (count < 0) {
+        log "error filling buffer";
+        log sys.rustrt.last_os_error();
+        fail;
+      } else {
+        ret uint(count);
+      }
+    }
+    drop {
+      os.libc.close(fd);
+    }
+  }
+
+  auto fd = os.libc.open(_str.buf(s), 0);
+  if (fd < 0) {
+    log "error opening file";
+    log sys.rustrt.last_os_error();
+    fail;
+  }
+  ret fd_reader(fd);
+}

src/lib/_str.rs

@@ -0,0 +1,23 @@
+import rustrt.sbuf;
+
+native "rust" mod rustrt {
+  type sbuf;
+  fn str_buf(str s) -> sbuf;
+  fn str_len(str s) -> uint;
+  fn str_alloc(int n_bytes) -> str;
+}
+
+fn is_utf8(vec[u8] v) -> bool {
+}
+
+fn alloc(int n_bytes) -> str {
+  ret rustrt.str_alloc(n_bytes);
+}
+
+fn len(str s) -> uint {
+  ret rustrt.str_len(s);
+}
+
+fn buf(str s) -> sbuf {
+  ret rustrt.str_buf(s);
+}

src/lib/_u8.rs

@@ -0,0 +1,20 @@
+fn add(u8 x, u8 y) -> u8 { ret x + y; }
+fn sub(u8 x, u8 y) -> u8 { ret x - y; }
+fn mul(u8 x, u8 y) -> u8 { ret x * y; }
+fn div(u8 x, u8 y) -> u8 { ret x / y; }
+fn rem(u8 x, u8 y) -> u8 { ret x % y; }
+
+fn lt(u8 x, u8 y) -> bool { ret x < y; }
+fn le(u8 x, u8 y) -> bool { ret x <= y; }
+fn eq(u8 x, u8 y) -> bool { ret x == y; }
+fn ne(u8 x, u8 y) -> bool { ret x != y; }
+fn ge(u8 x, u8 y) -> bool { ret x >= y; }
+fn gt(u8 x, u8 y) -> bool { ret x > y; }
+
+iter range(mutable u8 lo, u8 hi) -> u8 {
+  while (lo < hi) {
+    put lo;
+    lo += u8(1);
+  }
+}
+

src/lib/_vec.rs

@@ -0,0 +1,30 @@
+import vbuf = rustrt.vbuf;
+
+native "rust" mod rustrt {
+  type vbuf;
+  fn vec_buf[T](vec[T] v) -> vbuf;
+  fn vec_len[T](vec[T] v) -> uint;
+  fn vec_alloc[T](int n_elts) -> vec[T];
+}
+
+fn alloc[T](int n_elts) -> vec[T] {
+  ret rustrt.vec_alloc[T](n_elts);
+}
+
+fn init[T](&T t, int n_elts) -> vec[T] {
+  let vec[T] v = alloc[T](n_elts);
+  let int i = n_elts;
+  while (i > 0) {
+    i -= 1;
+    v += vec(t);
+  }
+  ret v;
+}
+
+fn len[T](vec[T] v) -> uint {
+  ret rustrt.vec_len[T](v);
+}
+
+fn buf[T](vec[T] v) -> vbuf {
+  ret rustrt.vec_buf[T](v);
+}

src/lib/linux_os.rs

@@ -0,0 +1,19 @@
+import _str.sbuf;
+import _vec.vbuf;
+
+native mod libc = "libc.so.6" {
+
+  fn open(sbuf s, int flags) -> int;
+  fn read(int fd, vbuf buf, uint count) -> int;
+  fn write(int fd, vbuf buf, uint count) -> int;
+  fn close(int fd) -> int;
+
+  type dir;
+  // readdir is a mess; handle via wrapper function in rustrt.
+  fn opendir(sbuf d) -> dir;
+  fn closedir(dir d) -> int;
+
+  fn getenv(sbuf n) -> sbuf;
+  fn setenv(sbuf n, sbuf v, int overwrite) -> int;
+  fn unsetenv(sbuf n) -> int;
+}

src/lib/macos_os.rs

@@ -0,0 +1,19 @@
+import _str.sbuf;
+import _vec.vbuf;
+
+native mod libc = "libc.dylib" {
+
+  fn open(sbuf s, int flags) -> int;
+  fn read(int fd, vbuf buf, uint count) -> int;
+  fn write(int fd, vbuf buf, uint count) -> int;
+  fn close(int fd) -> int;
+
+  type dir;
+  // readdir is a mess; handle via wrapper function in rustrt.
+  fn opendir(sbuf d) -> dir;
+  fn closedir(dir d) -> int;
+
+  fn getenv(sbuf n) -> sbuf;
+  fn setenv(sbuf n, sbuf v, int overwrite) -> int;
+  fn unsetenv(sbuf n) -> int;
+}

src/lib/std.rc

@@ -0,0 +1,35 @@
+meta (name = "std",
+      desc = "Rust standard library",
+      uuid = "122bed0b-c19b-4b82-b0b7-7ae8aead7297",
+      url = "http://rust-lang.org/src/std",
+      ver = "0.0.1");
+
+// Built-in types support modules.
+
+mod _int;
+mod _u8;
+mod _vec;
+mod _str;
+
+// General IO and system-services modules.
+
+mod _io;
+mod sys;
+
+// Authorize various rule-bendings.
+
+auth _io = unsafe;
+auth _str = unsafe;
+auth _vec = unsafe;
+
+// Target-OS module.
+
+alt (target_os) {
+  case ("win32") {
+    mod os = "win32_os.rs";
+  } case ("macos") {
+    mod os = "macos_os.rs";
+  } else {
+    mod os = "linux_os.rs";
+  }
+}

src/lib/sys.rs

@@ -0,0 +1,7 @@
+native "rust" mod rustrt {
+  fn last_os_error() -> str;
+  fn size_of[T]() -> uint;
+  fn align_of[T]() -> uint;
+  fn refcount[T](@T t) -> uint;
+}
+

src/lib/win32_os.rs

@@ -0,0 +1,9 @@
+import _str.sbuf;
+import _vec.vbuf;
+
+native mod libc = "msvcrt.dll" {
+  fn open(sbuf s, int flags) -> int = "_open";
+  fn read(int fd, vbuf buf, uint count) -> int = "_read";
+  fn write(int fd, vbuf buf, uint count) -> int = "_write";
+  fn close(int fd) -> int = "_close";
+}

src/rt/bigint/bigint.h

@@ -0,0 +1,294 @@
+/* bigint.h - include file for bigint package
+**
+** This library lets you do math on arbitrarily large integers.  It's
+** pretty fast - compared with the multi-precision routines in the "bc"
+** calculator program, these routines are between two and twelve times faster,
+** except for division which is maybe half as fast.
+**
+** The calling convention is a little unusual.  There's a basic problem
+** with writing a math library in a language that doesn't do automatic
+** garbage collection - what do you do about intermediate results?
+** You'd like to be able to write code like this:
+**
+**     d = bi_sqrt( bi_add( bi_multiply( x, x ), bi_multiply( y, y ) ) );
+**
+** That works fine when the numbers being passed back and forth are
+** actual values - ints, floats, or even fixed-size structs.  However,
+** when the numbers can be any size, as in this package, then you have
+** to pass them around as pointers to dynamically-allocated objects.
+** Those objects have to get de-allocated after you are done with them.
+** But how do you de-allocate the intermediate results in a complicated
+** multiple-call expression like the above?
+**
+** There are two common solutions to this problem.  One, switch all your
+** code to a language that provides automatic garbage collection, for
+** example Java.  This is a fine idea and I recommend you do it wherever
+** it's feasible.  Two, change your routines to use a calling convention
+** that prevents people from writing multiple-call expressions like that.
+** The resulting code will be somewhat clumsy-looking, but it will work
+** just fine.
+**
+** This package uses a third method, which I haven't seen used anywhere
+** before.  It's simple: each number can be used precisely once, after
+** which it is automatically de-allocated.  This handles the anonymous
+** intermediate values perfectly.  Named values still need to be copied
+** and freed explicitly.  Here's the above example using this convention:
+**
+**     d = bi_sqrt( bi_add(
+**             bi_multiply( bi_copy( x ), bi_copy( x ) ),
+**             bi_multiply( bi_copy( y ), bi_copy( y ) ) ) );
+**     bi_free( x );
+**     bi_free( y );
+**
+** Or, since the package contains a square routine, you could just write:
+**
+**     d = bi_sqrt( bi_add( bi_square( x ), bi_square( y ) ) );
+**
+** This time the named values are only being used once, so you don't
+** have to copy and free them.
+**
+** This really works, however you do have to be very careful when writing
+** your code.  If you leave out a bi_copy() and use a value more than once,
+** you'll get a runtime error about "zero refs" and a SIGFPE.  Run your
+** code in a debugger, get a backtrace to see where the call was, and then
+** eyeball the code there to see where you need to add the bi_copy().
+**
+**
+** Copyright © 2000 by Jef Poskanzer <jef@mail.acme.com>.
+** All rights reserved.
+**
+** 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 AUTHOR 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 AUTHOR 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.
+*/
+
+
+/* Type definition for bigints - it's an opaque type, the real definition
+** is in bigint.c.
+*/
+typedef void* bigint;
+
+
+/* Some convenient pre-initialized numbers.  These are all permanent,
+** so you can use them as many times as you want without calling bi_copy().
+*/
+extern bigint bi_0, bi_1, bi_2, bi_10, bi_m1, bi_maxint, bi_minint;
+
+
+/* Initialize the bigint package.  You must call this when your program
+** starts up.
+*/
+void bi_initialize( void );
+
+/* Shut down the bigint package.  You should call this when your program
+** exits.  It's not actually required, but it does do some consistency
+** checks which help keep your program bug-free, so you really ought
+** to call it.
+*/
+void bi_terminate( void );
+
+/* Run in unsafe mode, skipping most runtime checks.  Slightly faster.
+** Once your code is debugged you can add this call after bi_initialize().
+*/
+void bi_no_check( void );
+
+/* Make a copy of a bigint.  You must call this if you want to use a
+** bigint more than once.  (Or you can make the bigint permanent.)
+** Note that this routine is very cheap - all it actually does is
+** increment a reference counter.
+*/
+bigint bi_copy( bigint bi );
+
+/* Make a bigint permanent, so it doesn't get automatically freed when
+** used as an operand.
+*/
+void bi_permanent( bigint bi );
+
+/* Undo bi_permanent().  The next use will free the bigint. */
+void bi_depermanent( bigint bi );
+
+/* Explicitly free a bigint.  Normally bigints get freed automatically
+** when they are used as an operand.  This routine lets you free one
+** without using it.  If the bigint is permanent, this doesn't do
+** anything, you have to depermanent it first.
+*/
+void bi_free( bigint bi );
+
+/* Compare two bigints.  Returns -1, 0, or 1. */
+int bi_compare( bigint bia, bigint bib );
+
+/* Convert an int to a bigint. */
+bigint int_to_bi( int i );
+
+/* Convert a string to a bigint. */
+bigint str_to_bi( char* str );
+
+/* Convert a bigint to an int.  SIGFPE on overflow. */
+int bi_to_int( bigint bi );
+
+/* Write a bigint to a file. */
+void bi_print( FILE* f, bigint bi );
+
+/* Read a bigint from a file. */
+bigint bi_scan( FILE* f );
+
+
+/* Operations on a bigint and a regular int. */
+
+/* Add an int to a bigint. */
+bigint bi_int_add( bigint bi, int i );
+
+/* Subtract an int from a bigint. */
+bigint bi_int_subtract( bigint bi, int i );
+
+/* Multiply a bigint by an int. */
+bigint bi_int_multiply( bigint bi, int i );
+
+/* Divide a bigint by an int.  SIGFPE on divide-by-zero. */
+bigint bi_int_divide( bigint binumer, int denom );
+
+/* Take the remainder of a bigint by an int, with an int result.
+** SIGFPE if m is zero.
+*/
+int bi_int_rem( bigint bi, int m );
+
+/* Take the modulus of a bigint by an int, with an int result.
+** Note that mod is not rem: mod is always within [0..m), while
+** rem can be negative.  SIGFPE if m is zero or negative.
+*/
+int bi_int_mod( bigint bi, int m );
+
+
+/* Basic operations on two bigints. */
+
+/* Add two bigints. */
+bigint bi_add( bigint bia, bigint bib );
+
+/* Subtract bib from bia. */
+bigint bi_subtract( bigint bia, bigint bib );
+
+/* Multiply two bigints. */
+bigint bi_multiply( bigint bia, bigint bib );
+
+/* Divide one bigint by another.  SIGFPE on divide-by-zero. */
+bigint bi_divide( bigint binumer, bigint bidenom );
+
+/* Binary division of one bigint by another.  SIGFPE on divide-by-zero.
+** This is here just for testing.  It's about five times slower than
+** regular division.
+*/
+bigint bi_binary_divide( bigint binumer, bigint bidenom );
+
+/* Take the remainder of one bigint by another.  SIGFPE if bim is zero. */
+bigint bi_rem( bigint bia, bigint bim );
+
+/* Take the modulus of one bigint by another.  Note that mod is not rem:
+** mod is always within [0..bim), while rem can be negative.  SIGFPE if
+** bim is zero or negative.
+*/
+bigint bi_mod( bigint bia, bigint bim );
+
+
+/* Some less common operations. */
+
+/* Negate a bigint. */
+bigint bi_negate( bigint bi );
+
+/* Absolute value of a bigint. */
+bigint bi_abs( bigint bi );
+
+/* Divide a bigint in half. */
+bigint bi_half( bigint bi );
+
+/* Multiply a bigint by two. */
+bigint bi_double( bigint bi );
+
+/* Square a bigint. */
+bigint bi_square( bigint bi );
+
+/* Raise bi to the power of biexp.  SIGFPE if biexp is negative. */
+bigint bi_power( bigint bi, bigint biexp );
+
+/* Integer square root. */
+bigint bi_sqrt( bigint bi );
+
+/* Factorial. */
+bigint bi_factorial( bigint bi );
+
+
+/* Some predicates. */
+
+/* 1 if the bigint is odd, 0 if it's even. */
+int bi_is_odd( bigint bi );
+
+/* 1 if the bigint is even, 0 if it's odd. */
+int bi_is_even( bigint bi );
+
+/* 1 if the bigint equals zero, 0 if it's nonzero. */
+int bi_is_zero( bigint bi );
+
+/* 1 if the bigint equals one, 0 otherwise. */
+int bi_is_one( bigint bi );
+
+/* 1 if the bigint is less than zero, 0 if it's zero or greater. */
+int bi_is_negative( bigint bi );
+
+
+/* Now we get into the esoteric number-theory stuff used for cryptography. */
+
+/* Modular exponentiation.  Much faster than bi_mod(bi_power(bi,biexp),bim).
+** Also, biexp can be negative.
+*/
+bigint bi_mod_power( bigint bi, bigint biexp, bigint bim );
+
+/* Modular inverse.  mod( bi * modinv(bi), bim ) == 1.  SIGFPE if bi is not
+** relatively prime to bim.
+*/
+bigint bi_mod_inverse( bigint bi, bigint bim );
+
+/* Produce a random number in the half-open interval [0..bi).  You need
+** to have called srandom() before using this.
+*/
+bigint bi_random( bigint bi );
+
+/* Greatest common divisor of two bigints.  Euclid's algorithm. */
+bigint bi_gcd( bigint bim, bigint bin );
+
+/* Greatest common divisor of two bigints, plus the corresponding multipliers.
+** Extended Euclid's algorithm.
+*/
+bigint bi_egcd( bigint bim, bigint bin, bigint* bim_mul, bigint* bin_mul );
+
+/* Least common multiple of two bigints. */
+bigint bi_lcm( bigint bia, bigint bib );
+
+/* The Jacobi symbol.  SIGFPE if bib is even. */
+bigint bi_jacobi( bigint bia, bigint bib );
+
+/* Probabalistic prime checking.  A non-zero return means the probability
+** that bi is prime is at least 1 - 1/2 ^ certainty.
+*/
+int bi_is_probable_prime( bigint bi, int certainty );
+
+/* Random probabilistic prime with the specified number of bits. */
+bigint bi_generate_prime( int bits, int certainty );
+
+/* Number of bits in the number.  The log base 2, approximately. */
+int bi_bits( bigint bi );

src/rt/bigint/bigint_ext.cpp

@@ -0,0 +1,553 @@
+/* bigint_ext - external portion of large integer package
+**
+** Copyright © 2000 by Jef Poskanzer <jef@mail.acme.com>.
+** All rights reserved.
+**
+** 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 AUTHOR 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 AUTHOR 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 <sys/types.h>
+#include <signal.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <unistd.h>
+#include <time.h>
+
+#include "bigint.h"
+#include "low_primes.h"
+
+
+bigint bi_0, bi_1, bi_2, bi_10, bi_m1, bi_maxint, bi_minint;
+
+
+/* Forwards. */
+static void print_pos( FILE* f, bigint bi );
+
+
+bigint
+str_to_bi( char* str )
+    {
+    int sign;
+    bigint biR;
+
+    sign = 1;
+    if ( *str == '-' )
+	{
+	sign = -1;
+	++str;
+	}
+    for ( biR = bi_0; *str >= '0' && *str <= '9'; ++str )
+	biR = bi_int_add( bi_int_multiply( biR, 10 ), *str - '0' );
+    if ( sign == -1 )
+	biR = bi_negate( biR );
+    return biR;
+    }
+
+
+void
+bi_print( FILE* f, bigint bi )
+    {
+    if ( bi_is_negative( bi_copy( bi ) ) )
+	{
+	putc( '-', f );
+	bi = bi_negate( bi );
+	}
+    print_pos( f, bi );
+    }
+
+
+bigint
+bi_scan( FILE* f )
+    {
+    int sign;
+    int c;
+    bigint biR;
+
+    sign = 1;
+    c = getc( f );
+    if ( c == '-' )
+	sign = -1;
+    else
+	ungetc( c, f );
+
+    biR = bi_0;
+    for (;;)
+	{
+	c = getc( f );
+	if ( c < '0' || c > '9' )
+	    break;
+	biR = bi_int_add( bi_int_multiply( biR, 10 ), c - '0' );
+	}
+
+    if ( sign == -1 )
+	biR = bi_negate( biR );
+    return biR;
+    }
+
+
+static void
+print_pos( FILE* f, bigint bi )
+    {
+    if ( bi_compare( bi_copy( bi ), bi_10 ) >= 0 )
+	print_pos( f, bi_int_divide( bi_copy( bi ), 10 ) );
+    putc( bi_int_mod( bi, 10 ) + '0', f );
+    }
+
+
+int
+bi_int_mod( bigint bi, int m )
+    {
+    int r;
+
+    if ( m <= 0 )
+	{
+	(void) fprintf( stderr, "bi_int_mod: zero or negative modulus\n" );
+	(void) kill( getpid(), SIGFPE );
+	}
+    r = bi_int_rem( bi, m );
+    if ( r < 0 )
+	r += m;
+    return r;
+    }
+
+
+bigint
+bi_rem( bigint bia, bigint bim )
+    {
+    return bi_subtract(
+	bia, bi_multiply( bi_divide( bi_copy( bia ), bi_copy( bim ) ), bim ) );
+    }
+
+
+bigint
+bi_mod( bigint bia, bigint bim )
+    {
+    bigint biR;
+
+    if ( bi_compare( bi_copy( bim ), bi_0 ) <= 0 )
+	{
+	(void) fprintf( stderr, "bi_mod: zero or negative modulus\n" );
+	(void) kill( getpid(), SIGFPE );
+	}
+    biR = bi_rem( bia, bi_copy( bim ) );
+    if ( bi_is_negative( bi_copy( biR ) ) )
+	biR = bi_add( biR, bim );
+    else
+	bi_free( bim );
+    return biR;
+    }
+
+
+bigint
+bi_square( bigint bi )
+    {
+    bigint biR;
+
+    biR = bi_multiply( bi_copy( bi ), bi_copy( bi ) );
+    bi_free( bi );
+    return biR;
+    }
+
+
+bigint
+bi_power( bigint bi, bigint biexp )
+    {
+    bigint biR;
+
+    if ( bi_is_negative( bi_copy( biexp ) ) )
+	{
+	(void) fprintf( stderr, "bi_power: negative exponent\n" );
+	(void) kill( getpid(), SIGFPE );
+	}
+    biR = bi_1;
+    for (;;)
+	{
+	if ( bi_is_odd( bi_copy( biexp ) ) )
+	    biR = bi_multiply( biR, bi_copy( bi ) );
+	biexp = bi_half( biexp );
+	if ( bi_compare( bi_copy( biexp ), bi_0 ) <= 0 )
+	    break;
+	bi = bi_multiply( bi_copy( bi ), bi );
+	}
+    bi_free( bi );
+    bi_free( biexp );
+    return biR;
+    }
+
+
+bigint
+bi_factorial( bigint bi )
+    {
+    bigint biR;
+
+    biR = bi_1;
+    while ( bi_compare( bi_copy( bi ), bi_1 ) > 0 )
+	{
+	biR = bi_multiply( biR, bi_copy( bi ) );
+	bi = bi_int_subtract( bi, 1 );
+	}
+    bi_free( bi );
+    return biR;
+    }
+
+
+int
+bi_is_even( bigint bi )
+    {
+    return ! bi_is_odd( bi );
+    }
+
+
+bigint
+bi_mod_power( bigint bi, bigint biexp, bigint bim )
+    {
+    int invert;
+    bigint biR;
+
+    invert = 0;
+    if ( bi_is_negative( bi_copy( biexp ) ) )
+	{
+	biexp = bi_negate( biexp );
+	invert = 1;
+	}
+
+    biR = bi_1;
+    for (;;)
+	{
+	if ( bi_is_odd( bi_copy( biexp ) ) )
+	    biR = bi_mod( bi_multiply( biR, bi_copy( bi ) ), bi_copy( bim ) );
+	biexp = bi_half( biexp );
+	if ( bi_compare( bi_copy( biexp ), bi_0 ) <= 0 )
+	    break;
+	bi = bi_mod( bi_multiply( bi_copy( bi ), bi ), bi_copy( bim ) );
+	}
+    bi_free( bi );
+    bi_free( biexp );
+
+    if ( invert )
+	biR = bi_mod_inverse( biR, bim );
+    else
+	bi_free( bim );
+    return biR;
+    }
+
+
+bigint
+bi_mod_inverse( bigint bi, bigint bim )
+    {
+    bigint gcd, mul0, mul1;
+
+    gcd = bi_egcd( bi_copy( bim ), bi, &mul0, &mul1 );
+
+    /* Did we get gcd == 1? */
+    if ( ! bi_is_one( gcd ) )
+	{
+	(void) fprintf( stderr, "bi_mod_inverse: not relatively prime\n" );
+	(void) kill( getpid(), SIGFPE );
+	}
+
+    bi_free( mul0 );
+    return bi_mod( mul1, bim );
+    }
+
+
+/* Euclid's algorithm. */
+bigint
+bi_gcd( bigint bim, bigint bin )
+    {
+    bigint bit;
+
+    bim = bi_abs( bim );
+    bin = bi_abs( bin );
+    while ( ! bi_is_zero( bi_copy( bin ) ) )
+	{
+	bit = bi_mod( bim, bi_copy( bin ) );
+	bim = bin;
+	bin = bit;
+	}
+    bi_free( bin );
+    return bim;
+    }
+
+
+/* Extended Euclidean algorithm. */
+bigint
+bi_egcd( bigint bim, bigint bin, bigint* bim_mul, bigint* bin_mul )
+    {
+    bigint a0, b0, c0, a1, b1, c1, q, t;
+
+    if ( bi_is_negative( bi_copy( bim ) ) )
+	{
+	bigint biR;
+
+	biR = bi_egcd( bi_negate( bim ), bin, &t, bin_mul );
+	*bim_mul = bi_negate( t );
+	return biR;
+	}
+    if ( bi_is_negative( bi_copy( bin ) ) )
+	{
+	bigint biR;
+
+	biR = bi_egcd( bim, bi_negate( bin ), bim_mul, &t );
+	*bin_mul = bi_negate( t );
+	return biR;
+	}
+
+    a0 = bi_1;  b0 = bi_0;  c0 = bim;
+    a1 = bi_0;  b1 = bi_1;  c1 = bin;
+
+    while ( ! bi_is_zero( bi_copy( c1 ) ) )
+	{
+	q = bi_divide( bi_copy( c0 ), bi_copy( c1 ) );
+	t = a0;
+	a0 = bi_copy( a1 );
+	a1 = bi_subtract( t, bi_multiply( bi_copy( q ), a1 ) );
+	t = b0;
+	b0 = bi_copy( b1 );
+	b1 = bi_subtract( t, bi_multiply( bi_copy( q ), b1 ) );
+	t = c0;
+	c0 = bi_copy( c1 );
+	c1 = bi_subtract( t, bi_multiply( bi_copy( q ), c1 ) );
+	bi_free( q );
+	}
+
+    bi_free( a1 );
+    bi_free( b1 );
+    bi_free( c1 );
+    *bim_mul = a0;
+    *bin_mul = b0;
+    return c0;
+    }
+
+
+bigint
+bi_lcm( bigint bia, bigint bib )
+    {
+    bigint biR;
+
+    biR = bi_divide(
+	bi_multiply( bi_copy( bia ), bi_copy( bib ) ),
+	bi_gcd( bi_copy( bia ), bi_copy( bib ) ) );
+    bi_free( bia );
+    bi_free( bib );
+    return biR;
+    }
+
+
+/* The Jacobi symbol. */
+bigint
+bi_jacobi( bigint bia, bigint bib )
+    {
+    bigint biR;
+
+    if ( bi_is_even( bi_copy( bib ) ) )
+	{
+	(void) fprintf( stderr, "bi_jacobi: don't know how to compute Jacobi(n, even)\n" );
+	(void) kill( getpid(), SIGFPE );
+	}
+
+    if ( bi_compare( bi_copy( bia ), bi_copy( bib ) ) >= 0 )
+	return bi_jacobi( bi_mod( bia, bi_copy( bib ) ), bib );
+
+    if ( bi_is_zero( bi_copy( bia ) ) || bi_is_one( bi_copy( bia ) ) )
+	{
+	bi_free( bib );
+	return bia;
+	}
+
+    if ( bi_compare( bi_copy( bia ), bi_2 ) == 0 )
+	{
+	bi_free( bia );
+	switch ( bi_int_mod( bib, 8 ) )
+	    {
+	    case 1: case 7:
+	    return bi_1;
+	    case 3: case 5:
+	    return bi_m1;
+	    }
+	}
+
+    if ( bi_is_even( bi_copy( bia ) ) )
+	{
+	biR = bi_multiply(
+	    bi_jacobi( bi_2, bi_copy( bib ) ),
+	    bi_jacobi( bi_half( bia ), bi_copy( bib ) ) );
+	bi_free( bib );
+	return biR;
+	}
+
+    if ( bi_int_mod( bi_copy( bia ), 4 ) == 3 &&
+         bi_int_mod( bi_copy( bib ), 4 ) == 3 )
+	return bi_negate( bi_jacobi( bib, bia ) );
+    else
+	return bi_jacobi( bib, bia );
+    }
+
+
+/* Probabalistic prime checking. */
+int
+bi_is_probable_prime( bigint bi, int certainty )
+    {
+    int i, p;
+    bigint bim1;
+
+    /* First do trial division by a list of small primes.  This eliminates
+    ** many candidates.
+    */
+    for ( i = 0; i < sizeof(low_primes)/sizeof(*low_primes); ++i )
+	{
+	p = low_primes[i];
+	switch ( bi_compare( int_to_bi( p ), bi_copy( bi ) ) )
+	    {
+	    case 0:
+	    bi_free( bi );
+	    return 1;
+	    case 1:
+	    bi_free( bi );
+	    return 0;
+	    }
+	if ( bi_int_mod( bi_copy( bi ), p ) == 0 )
+	    {
+	    bi_free( bi );
+	    return 0;
+	    }
+	}
+
+    /* Now do the probabilistic tests. */
+    bim1 = bi_int_subtract( bi_copy( bi ), 1 );
+    for ( i = 0; i < certainty; ++i )
+	{
+	bigint a, j, jac;
+
+	/* Pick random test number. */
+	a = bi_random( bi_copy( bi ) );
+
+	/* Decide whether to run the Fermat test or the Solovay-Strassen
+	** test.  The Fermat test is fast but lets some composite numbers
+	** through.  Solovay-Strassen runs slower but is more certain.
+	** So the compromise here is we run the Fermat test a couple of
+	** times to quickly reject most composite numbers, and then do
+	** the rest of the iterations with Solovay-Strassen so nothing
+	** slips through.
+	*/
+	if ( i < 2 && certainty >= 5 )
+	    {
+	    /* Fermat test.  Note that this is not state of the art.  There's a
+	    ** class of numbers called Carmichael numbers which are composite
+	    ** but look prime to this test - it lets them slip through no
+	    ** matter how many reps you run.  However, it's nice and fast so
+	    ** we run it anyway to help quickly reject most of the composites.
+	    */
+	    if ( ! bi_is_one( bi_mod_power( bi_copy( a ), bi_copy( bim1 ), bi_copy( bi ) ) ) )
+		{
+		bi_free( bi );
+		bi_free( bim1 );
+		bi_free( a );
+		return 0;
+		}
+	    }
+	else
+	    {
+	    /* GCD test.  This rarely hits, but we need it for Solovay-Strassen. */
+	    if ( ! bi_is_one( bi_gcd( bi_copy( bi ), bi_copy( a ) ) ) )
+		{
+		bi_free( bi );
+		bi_free( bim1 );
+		bi_free( a );
+		return 0;
+		}
+
+	    /* Solovay-Strassen test.  First compute pseudo Jacobi. */
+	    j = bi_mod_power(
+		    bi_copy( a ), bi_half( bi_copy( bim1 ) ), bi_copy( bi ) );
+	    if ( bi_compare( bi_copy( j ), bi_copy( bim1 ) ) == 0 )
+		{
+		bi_free( j );
+		j = bi_m1;
+		}
+
+	    /* Now compute real Jacobi. */
+	    jac = bi_jacobi( bi_copy( a ), bi_copy( bi ) );
+
+	    /* If they're not equal, the number is definitely composite. */
+	    if ( bi_compare( j, jac ) != 0 )
+		{
+		bi_free( bi );
+		bi_free( bim1 );
+		bi_free( a );
+		return 0;
+		}
+	    }
+
+	bi_free( a );
+	}
+
+    bi_free( bim1 );
+
+    bi_free( bi );
+    return 1;
+    }
+
+
+bigint
+bi_generate_prime( int bits, int certainty )
+    {
+    bigint bimo2, bip;
+    int i, inc = 0;
+
+    bimo2 = bi_power( bi_2, int_to_bi( bits - 1 ) );
+    for (;;)
+	{
+	bip = bi_add( bi_random( bi_copy( bimo2 ) ), bi_copy( bimo2 ) );
+	/* By shoving the candidate numbers up to the next highest multiple
+	** of six plus or minus one, we pre-eliminate all multiples of
+	** two and/or three.
+	*/
+	switch ( bi_int_mod( bi_copy( bip ), 6 ) )
+	    {
+	    case 0: inc = 4; bip = bi_int_add( bip, 1 ); break;
+	    case 1: inc = 4;                             break;
+	    case 2: inc = 2; bip = bi_int_add( bip, 3 ); break;
+	    case 3: inc = 2; bip = bi_int_add( bip, 2 ); break;
+	    case 4: inc = 2; bip = bi_int_add( bip, 1 ); break;
+	    case 5: inc = 2;                             break;
+	    }
+	/* Starting from the generated random number, check a bunch of
+	** numbers in sequence.  This is just to avoid calls to bi_random(),
+	** which is more expensive than a simple add.
+	*/
+	for ( i = 0; i < 1000; ++i )	/* arbitrary */
+	    {
+	    if ( bi_is_probable_prime( bi_copy( bip ), certainty ) )
+		{
+		bi_free( bimo2 );
+		return bip;
+		}
+	    bip = bi_int_add( bip, inc );
+	    inc = 6 - inc;
+	    }
+	/* We ran through the whole sequence and didn't find a prime.
+	** Shrug, just try a different random starting point.
+	*/
+	bi_free( bip );
+	}
+    }

src/rt/isaac/rand.h

@@ -0,0 +1,56 @@
+/*
+------------------------------------------------------------------------------
+rand.h: definitions for a random number generator
+By Bob Jenkins, 1996, Public Domain
+MODIFIED:
+  960327: Creation (addition of randinit, really)
+  970719: use context, not global variables, for internal state
+  980324: renamed seed to flag
+  980605: recommend RANDSIZL=4 for noncryptography.
+  010626: note this is public domain
+------------------------------------------------------------------------------
+*/
+#ifndef STANDARD
+#include "standard.h"
+#endif
+
+#ifndef RAND
+#define RAND
+#define RANDSIZL   (8)  /* I recommend 8 for crypto, 4 for simulations */
+#define RANDSIZ    (1<<RANDSIZL)
+
+/* context of random number generator */
+struct randctx
+{
+  ub4 randcnt;
+  ub4 randrsl[RANDSIZ];
+  ub4 randmem[RANDSIZ];
+  ub4 randa;
+  ub4 randb;
+  ub4 randc;
+};
+typedef  struct randctx  randctx;
+
+/*
+------------------------------------------------------------------------------
+ If (flag==TRUE), then use the contents of randrsl[0..RANDSIZ-1] as the seed.
+------------------------------------------------------------------------------
+*/
+void randinit(randctx *r, word flag);
+
+void isaac(randctx *r);
+
+
+/*
+------------------------------------------------------------------------------
+ Call rand(/o_ randctx *r _o/) to retrieve a single 32-bit random value
+------------------------------------------------------------------------------
+*/
+#define rand(r) \
+   (!(r)->randcnt-- ? \
+     (isaac(r), (r)->randcnt=RANDSIZ-1, (r)->randrsl[(r)->randcnt]) : \
+     (r)->randrsl[(r)->randcnt])
+
+#endif  /* RAND */
+
+

src/rt/isaac/randport.cpp

@@ -0,0 +1,134 @@
+/*
+------------------------------------------------------------------------------
+rand.c: By Bob Jenkins.  My random number generator, ISAAC.  Public Domain
+MODIFIED:
+  960327: Creation (addition of randinit, really)
+  970719: use context, not global variables, for internal state
+  980324: make a portable version
+  010626: Note this is public domain
+------------------------------------------------------------------------------
+*/
+#ifndef STANDARD
+#include "standard.h"
+#endif
+#ifndef RAND
+#include "rand.h"
+#endif
+
+
+#define ind(mm,x)  ((mm)[(x>>2)&(RANDSIZ-1)])
+#define rngstep(mix,a,b,mm,m,m2,r,x) \
+{ \
+  x = *m;  \
+  a = ((a^(mix)) + *(m2++)) & 0xffffffff; \
+  *(m++) = y = (ind(mm,x) + a + b) & 0xffffffff; \
+  *(r++) = b = (ind(mm,y>>RANDSIZL) + x) & 0xffffffff; \
+}
+
+void     isaac(randctx *ctx)
+{
+   register ub4 a,b,x,y,*m,*mm,*m2,*r,*mend;
+   mm=ctx->randmem; r=ctx->randrsl;
+   a = ctx->randa; b = (ctx->randb + (++ctx->randc)) & 0xffffffff;
+   for (m = mm, mend = m2 = m+(RANDSIZ/2); m<mend; )
+   {
+      rngstep( a<<13, a, b, mm, m, m2, r, x);
+      rngstep( a>>6 , a, b, mm, m, m2, r, x);
+      rngstep( a<<2 , a, b, mm, m, m2, r, x);
+      rngstep( a>>16, a, b, mm, m, m2, r, x);
+   }
+   for (m2 = mm; m2<mend; )
+   {
+      rngstep( a<<13, a, b, mm, m, m2, r, x);
+      rngstep( a>>6 , a, b, mm, m, m2, r, x);
+      rngstep( a<<2 , a, b, mm, m, m2, r, x);
+      rngstep( a>>16, a, b, mm, m, m2, r, x);
+   }
+   ctx->randb = b; ctx->randa = a;
+}
+
+
+#define mix(a,b,c,d,e,f,g,h) \
+{ \
+   a^=b<<11; d+=a; b+=c; \
+   b^=c>>2;  e+=b; c+=d; \
+   c^=d<<8;  f+=c; d+=e; \
+   d^=e>>16; g+=d; e+=f; \
+   e^=f<<10; h+=e; f+=g; \
+   f^=g>>4;  a+=f; g+=h; \
+   g^=h<<8;  b+=g; h+=a; \
+   h^=a>>9;  c+=h; a+=b; \
+}
+
+/* if (flag==TRUE), then use the contents of randrsl[] to initialize mm[]. */
+void randinit(randctx *ctx, word flag)
+{
+   word i;
+   ub4 a,b,c,d,e,f,g,h;
+   ub4 *m,*r;
+   ctx->randa = ctx->randb = ctx->randc = 0;
+   m=ctx->randmem;
+   r=ctx->randrsl;
+   a=b=c=d=e=f=g=h=0x9e3779b9;  /* the golden ratio */
+
+   for (i=0; i<4; ++i)          /* scramble it */
+   {
+     mix(a,b,c,d,e,f,g,h);
+   }
+
+   if (flag) 
+   {
+     /* initialize using the contents of r[] as the seed */
+     for (i=0; i<RANDSIZ; i+=8)
+     {
+       a+=r[i  ]; b+=r[i+1]; c+=r[i+2]; d+=r[i+3];
+       e+=r[i+4]; f+=r[i+5]; g+=r[i+6]; h+=r[i+7];
+       mix(a,b,c,d,e,f,g,h);
+       m[i  ]=a; m[i+1]=b; m[i+2]=c; m[i+3]=d;
+       m[i+4]=e; m[i+5]=f; m[i+6]=g; m[i+7]=h;
+     }
+     /* do a second pass to make all of the seed affect all of m */
+     for (i=0; i<RANDSIZ; i+=8)
+     {
+       a+=m[i  ]; b+=m[i+1]; c+=m[i+2]; d+=m[i+3];
+       e+=m[i+4]; f+=m[i+5]; g+=m[i+6]; h+=m[i+7];
+       mix(a,b,c,d,e,f,g,h);
+       m[i  ]=a; m[i+1]=b; m[i+2]=c; m[i+3]=d;
+       m[i+4]=e; m[i+5]=f; m[i+6]=g; m[i+7]=h;
+     }
+   }
+   else
+   {
+     for (i=0; i<RANDSIZ; i+=8)
+     {
+       /* fill in mm[] with messy stuff */
+       mix(a,b,c,d,e,f,g,h);
+       m[i  ]=a; m[i+1]=b; m[i+2]=c; m[i+3]=d;
+       m[i+4]=e; m[i+5]=f; m[i+6]=g; m[i+7]=h;
+     }
+   }
+
+   isaac(ctx);            /* fill in the first set of results */
+   ctx->randcnt=RANDSIZ;  /* prepare to use the first set of results */
+}
+
+
+#ifdef NEVER
+int main()
+{
+  ub4 i,j;
+  randctx ctx;
+  ctx.randa=ctx.randb=ctx.randc=(ub4)0;
+  for (i=0; i<256; ++i) ctx.randrsl[i]=(ub4)0;
+  randinit(&ctx, TRUE);
+  for (i=0; i<2; ++i)
+  {
+    isaac(&ctx);
+    for (j=0; j<256; ++j)
+    {
+      printf("%.8lx",ctx.randrsl[j]);
+      if ((j&7)==7) printf("\n");
+    }
+  }
+}
+#endif

src/rt/isaac/standard.h

@@ -0,0 +1,57 @@
+/*
+------------------------------------------------------------------------------
+Standard definitions and types, Bob Jenkins
+------------------------------------------------------------------------------
+*/
+#ifndef STANDARD
+# define STANDARD
+# ifndef STDIO
+#  include <stdio.h>
+#  define STDIO
+# endif
+# ifndef STDDEF
+#  include <stddef.h>
+#  define STDDEF
+# endif
+typedef  unsigned long long  ub8;
+#define UB8MAXVAL 0xffffffffffffffffLL
+#define UB8BITS 64
+typedef    signed long long  sb8;
+#define SB8MAXVAL 0x7fffffffffffffffLL
+typedef  unsigned long  int  ub4;   /* unsigned 4-byte quantities */
+#define UB4MAXVAL 0xffffffff
+typedef    signed long  int  sb4;
+#define UB4BITS 32
+#define SB4MAXVAL 0x7fffffff
+typedef  unsigned short int  ub2;
+#define UB2MAXVAL 0xffff
+#define UB2BITS 16
+typedef    signed short int  sb2;
+#define SB2MAXVAL 0x7fff
+typedef  unsigned       char ub1;
+#define UB1MAXVAL 0xff
+#define UB1BITS 8
+typedef    signed       char sb1;   /* signed 1-byte quantities */
+#define SB1MAXVAL 0x7f
+typedef                 int  word;  /* fastest type available */
+
+#define bis(target,mask)  ((target) |=  (mask))
+#define bic(target,mask)  ((target) &= ~(mask))
+#define bit(target,mask)  ((target) &   (mask))
+#ifndef min
+# define min(a,b) (((a)<(b)) ? (a) : (b))
+#endif /* min */
+#ifndef max
+# define max(a,b) (((a)<(b)) ? (b) : (a))
+#endif /* max */
+#ifndef align
+# define align(a) (((ub4)a+(sizeof(void *)-1))&(~(sizeof(void *)-1)))
+#endif /* align */
+#ifndef abs
+# define abs(a)   (((a)>0) ? (a) : -(a))
+#endif
+#define TRUE  1
+#define FALSE 0
+#define SUCCESS 0  /* 1 on VAX */
+
+#endif /* STANDARD */

src/rt/memcheck.h

@@ -0,0 +1,309 @@
+
+/*
+   ----------------------------------------------------------------
+
+   Notice that the following BSD-style license applies to this one
+   file (memcheck.h) only.  The rest of Valgrind is licensed under the
+   terms of the GNU General Public License, version 2, unless
+   otherwise indicated.  See the COPYING file in the source
+   distribution for details.
+
+   ----------------------------------------------------------------
+
+   This file is part of MemCheck, a heavyweight Valgrind tool for
+   detecting memory errors.
+
+   Copyright (C) 2000-2009 Julian Seward.  All rights reserved.
+
+   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. The origin of this software must not be misrepresented; you must 
+      not claim that you wrote the original software.  If you use this 
+      software in a product, an acknowledgment in the product 
+      documentation would be appreciated but is not required.
+
+   3. Altered source versions must be plainly marked as such, and must
+      not be misrepresented as being the original software.
+
+   4. The name of the author may not be used to endorse or promote 
+      products derived from this software without specific prior written 
+      permission.
+
+   THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 AUTHOR 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.
+
+   ----------------------------------------------------------------
+
+   Notice that the above BSD-style license applies to this one file
+   (memcheck.h) only.  The entire rest of Valgrind is licensed under
+   the terms of the GNU General Public License, version 2.  See the
+   COPYING file in the source distribution for details.
+
+   ---------------------------------------------------------------- 
+*/
+
+
+#ifndef __MEMCHECK_H
+#define __MEMCHECK_H
+
+
+/* This file is for inclusion into client (your!) code.
+
+   You can use these macros to manipulate and query memory permissions
+   inside your own programs.
+
+   See comment near the top of valgrind.h on how to use them.
+*/
+
+#include "valgrind.h"
+
+/* !! ABIWARNING !! ABIWARNING !! ABIWARNING !! ABIWARNING !! 
+   This enum comprises an ABI exported by Valgrind to programs
+   which use client requests.  DO NOT CHANGE THE ORDER OF THESE
+   ENTRIES, NOR DELETE ANY -- add new ones at the end. */
+typedef
+   enum { 
+      VG_USERREQ__MAKE_MEM_NOACCESS = VG_USERREQ_TOOL_BASE('M','C'),
+      VG_USERREQ__MAKE_MEM_UNDEFINED,
+      VG_USERREQ__MAKE_MEM_DEFINED,
+      VG_USERREQ__DISCARD,
+      VG_USERREQ__CHECK_MEM_IS_ADDRESSABLE,
+      VG_USERREQ__CHECK_MEM_IS_DEFINED,
+      VG_USERREQ__DO_LEAK_CHECK,
+      VG_USERREQ__COUNT_LEAKS,
+
+      VG_USERREQ__GET_VBITS,
+      VG_USERREQ__SET_VBITS,
+
+      VG_USERREQ__CREATE_BLOCK,
+
+      VG_USERREQ__MAKE_MEM_DEFINED_IF_ADDRESSABLE,
+
+      /* Not next to VG_USERREQ__COUNT_LEAKS because it was added later. */
+      VG_USERREQ__COUNT_LEAK_BLOCKS,
+
+      /* This is just for memcheck's internal use - don't use it */
+      _VG_USERREQ__MEMCHECK_RECORD_OVERLAP_ERROR 
+         = VG_USERREQ_TOOL_BASE('M','C') + 256
+   } Vg_MemCheckClientRequest;
+
+
+
+/* Client-code macros to manipulate the state of memory. */
+
+/* Mark memory at _qzz_addr as unaddressable for _qzz_len bytes. */
+#define VALGRIND_MAKE_MEM_NOACCESS(_qzz_addr,_qzz_len)           \
+   (__extension__({unsigned long _qzz_res;                       \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0 /* default return */, \
+                            VG_USERREQ__MAKE_MEM_NOACCESS,       \
+                            _qzz_addr, _qzz_len, 0, 0, 0);       \
+    _qzz_res;                                                    \
+   }))
+      
+/* Similarly, mark memory at _qzz_addr as addressable but undefined
+   for _qzz_len bytes. */
+#define VALGRIND_MAKE_MEM_UNDEFINED(_qzz_addr,_qzz_len)          \
+   (__extension__({unsigned long _qzz_res;                       \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0 /* default return */, \
+                            VG_USERREQ__MAKE_MEM_UNDEFINED,      \
+                            _qzz_addr, _qzz_len, 0, 0, 0);       \
+    _qzz_res;                                                    \
+   }))
+
+/* Similarly, mark memory at _qzz_addr as addressable and defined
+   for _qzz_len bytes. */
+#define VALGRIND_MAKE_MEM_DEFINED(_qzz_addr,_qzz_len)            \
+   (__extension__({unsigned long _qzz_res;                       \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0 /* default return */, \
+                            VG_USERREQ__MAKE_MEM_DEFINED,        \
+                            _qzz_addr, _qzz_len, 0, 0, 0);       \
+    _qzz_res;                                                    \
+   }))
+
+/* Similar to VALGRIND_MAKE_MEM_DEFINED except that addressability is
+   not altered: bytes which are addressable are marked as defined,
+   but those which are not addressable are left unchanged. */
+#define VALGRIND_MAKE_MEM_DEFINED_IF_ADDRESSABLE(_qzz_addr,_qzz_len) \
+   (__extension__({unsigned long _qzz_res;                       \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0 /* default return */, \
+                            VG_USERREQ__MAKE_MEM_DEFINED_IF_ADDRESSABLE, \
+                            _qzz_addr, _qzz_len, 0, 0, 0);       \
+    _qzz_res;                                                    \
+   }))
+
+/* Create a block-description handle.  The description is an ascii
+   string which is included in any messages pertaining to addresses
+   within the specified memory range.  Has no other effect on the
+   properties of the memory range. */
+#define VALGRIND_CREATE_BLOCK(_qzz_addr,_qzz_len, _qzz_desc)	 \
+	(__extension__({unsigned long _qzz_res;			 \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0 /* default return */, \
+                            VG_USERREQ__CREATE_BLOCK,            \
+                            _qzz_addr, _qzz_len, _qzz_desc,      \
+                            0, 0);                               \
+    _qzz_res;							 \
+   }))
+
+/* Discard a block-description-handle. Returns 1 for an
+   invalid handle, 0 for a valid handle. */
+#define VALGRIND_DISCARD(_qzz_blkindex)                          \
+   (__extension__ ({unsigned long _qzz_res;                      \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0 /* default return */, \
+                            VG_USERREQ__DISCARD,                 \
+                            0, _qzz_blkindex, 0, 0, 0);          \
+    _qzz_res;                                                    \
+   }))
+
+
+/* Client-code macros to check the state of memory. */
+
+/* Check that memory at _qzz_addr is addressable for _qzz_len bytes.
+   If suitable addressibility is not established, Valgrind prints an
+   error message and returns the address of the first offending byte.
+   Otherwise it returns zero. */
+#define VALGRIND_CHECK_MEM_IS_ADDRESSABLE(_qzz_addr,_qzz_len)    \
+   (__extension__({unsigned long _qzz_res;                       \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0,                      \
+                            VG_USERREQ__CHECK_MEM_IS_ADDRESSABLE,\
+                            _qzz_addr, _qzz_len, 0, 0, 0);       \
+    _qzz_res;                                                    \
+   }))
+
+/* Check that memory at _qzz_addr is addressable and defined for
+   _qzz_len bytes.  If suitable addressibility and definedness are not
+   established, Valgrind prints an error message and returns the
+   address of the first offending byte.  Otherwise it returns zero. */
+#define VALGRIND_CHECK_MEM_IS_DEFINED(_qzz_addr,_qzz_len)        \
+   (__extension__({unsigned long _qzz_res;                       \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0,                      \
+                            VG_USERREQ__CHECK_MEM_IS_DEFINED,    \
+                            _qzz_addr, _qzz_len, 0, 0, 0);       \
+    _qzz_res;                                                    \
+   }))
+
+/* Use this macro to force the definedness and addressibility of an
+   lvalue to be checked.  If suitable addressibility and definedness
+   are not established, Valgrind prints an error message and returns
+   the address of the first offending byte.  Otherwise it returns
+   zero. */
+#define VALGRIND_CHECK_VALUE_IS_DEFINED(__lvalue)                \
+   VALGRIND_CHECK_MEM_IS_DEFINED(                                \
+      (volatile unsigned char *)&(__lvalue),                     \
+                      (unsigned long)(sizeof (__lvalue)))
+
+
+/* Do a full memory leak check (like --leak-check=full) mid-execution. */
+#define VALGRIND_DO_LEAK_CHECK                                   \
+   {unsigned long _qzz_res;                                      \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0,                      \
+                            VG_USERREQ__DO_LEAK_CHECK,           \
+                            0, 0, 0, 0, 0);                      \
+   }
+
+/* Do a summary memory leak check (like --leak-check=summary) mid-execution. */
+#define VALGRIND_DO_QUICK_LEAK_CHECK				 \
+   {unsigned long _qzz_res;                                      \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0,                      \
+                            VG_USERREQ__DO_LEAK_CHECK,           \
+                            1, 0, 0, 0, 0);                      \
+   }
+
+/* Return number of leaked, dubious, reachable and suppressed bytes found by
+   all previous leak checks.  They must be lvalues.  */
+#define VALGRIND_COUNT_LEAKS(leaked, dubious, reachable, suppressed)     \
+   /* For safety on 64-bit platforms we assign the results to private
+      unsigned long variables, then assign these to the lvalues the user
+      specified, which works no matter what type 'leaked', 'dubious', etc
+      are.  We also initialise '_qzz_leaked', etc because
+      VG_USERREQ__COUNT_LEAKS doesn't mark the values returned as
+      defined. */                                                        \
+   {unsigned long _qzz_res;                                              \
+    unsigned long _qzz_leaked    = 0, _qzz_dubious    = 0;               \
+    unsigned long _qzz_reachable = 0, _qzz_suppressed = 0;               \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0,                              \
+                               VG_USERREQ__COUNT_LEAKS,                  \
+                               &_qzz_leaked, &_qzz_dubious,              \
+                               &_qzz_reachable, &_qzz_suppressed, 0);    \
+    leaked     = _qzz_leaked;                                            \
+    dubious    = _qzz_dubious;                                           \
+    reachable  = _qzz_reachable;                                         \
+    suppressed = _qzz_suppressed;                                        \
+   }
+
+/* Return number of leaked, dubious, reachable and suppressed bytes found by
+   all previous leak checks.  They must be lvalues.  */
+#define VALGRIND_COUNT_LEAK_BLOCKS(leaked, dubious, reachable, suppressed) \
+   /* For safety on 64-bit platforms we assign the results to private
+      unsigned long variables, then assign these to the lvalues the user
+      specified, which works no matter what type 'leaked', 'dubious', etc
+      are.  We also initialise '_qzz_leaked', etc because
+      VG_USERREQ__COUNT_LEAKS doesn't mark the values returned as
+      defined. */                                                        \
+   {unsigned long _qzz_res;                                              \
+    unsigned long _qzz_leaked    = 0, _qzz_dubious    = 0;               \
+    unsigned long _qzz_reachable = 0, _qzz_suppressed = 0;               \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0,                              \
+                               VG_USERREQ__COUNT_LEAK_BLOCKS,            \
+                               &_qzz_leaked, &_qzz_dubious,              \
+                               &_qzz_reachable, &_qzz_suppressed, 0);    \
+    leaked     = _qzz_leaked;                                            \
+    dubious    = _qzz_dubious;                                           \
+    reachable  = _qzz_reachable;                                         \
+    suppressed = _qzz_suppressed;                                        \
+   }
+
+
+/* Get the validity data for addresses [zza..zza+zznbytes-1] and copy it
+   into the provided zzvbits array.  Return values:
+      0   if not running on valgrind
+      1   success
+      2   [previously indicated unaligned arrays;  these are now allowed]
+      3   if any parts of zzsrc/zzvbits are not addressable.
+   The metadata is not copied in cases 0, 2 or 3 so it should be
+   impossible to segfault your system by using this call.
+*/
+#define VALGRIND_GET_VBITS(zza,zzvbits,zznbytes)                 \
+   (__extension__({unsigned long _qzz_res;                       \
+    char* czza     = (char*)zza;                                 \
+    char* czzvbits = (char*)zzvbits;                             \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0,                      \
+                            VG_USERREQ__GET_VBITS,               \
+                            czza, czzvbits, zznbytes, 0, 0 );    \
+    _qzz_res;                                                    \
+   }))
+
+/* Set the validity data for addresses [zza..zza+zznbytes-1], copying it
+   from the provided zzvbits array.  Return values:
+      0   if not running on valgrind
+      1   success
+      2   [previously indicated unaligned arrays;  these are now allowed]
+      3   if any parts of zza/zzvbits are not addressable.
+   The metadata is not copied in cases 0, 2 or 3 so it should be
+   impossible to segfault your system by using this call.
+*/
+#define VALGRIND_SET_VBITS(zza,zzvbits,zznbytes)                 \
+   (__extension__({unsigned int _qzz_res;                        \
+    char* czza     = (char*)zza;                                 \
+    char* czzvbits = (char*)zzvbits;                             \
+    VALGRIND_DO_CLIENT_REQUEST(_qzz_res, 0,                      \
+                            VG_USERREQ__SET_VBITS,               \
+                            czza, czzvbits, zznbytes, 0, 0 );    \
+    _qzz_res;                                                    \
+   }))
+
+#endif
+

src/rt/rust.cpp

@@ -0,0 +1,267 @@
+#include "rust_internal.h"
+#include "util/array_list.h"
+
+
+// #define TRACK_ALLOCATIONS
+// For debugging, keeps track of live allocations, so you can find out
+// exactly what leaked.
+
+#ifdef TRACK_ALLOCATIONS
+array_list<void *> allocation_list;
+#endif
+
+rust_srv::rust_srv() :
+    live_allocs(0)
+{
+}
+
+rust_srv::~rust_srv()
+{
+    if (live_allocs != 0) {
+        char msg[128];
+        snprintf(msg, sizeof(msg),
+                 "leaked memory in rust main loop (%" PRIuPTR " objects)",
+                 live_allocs);
+#ifdef TRACK_ALLOCATIONS
+        for (size_t i = 0; i < allocation_list.size(); i++) {
+            if (allocation_list[i] != NULL) {
+                printf("allocation 0x%" PRIxPTR " was not freed\n",
+                        (uintptr_t) allocation_list[i]);
+            }
+        }
+#endif
+        fatal(msg, __FILE__, __LINE__);
+    }
+}
+
+void
+rust_srv::log(char const *str)
+{
+    printf("rt: %s\n", str);
+}
+
+
+
+void *
+rust_srv::malloc(size_t bytes)
+{
+    ++live_allocs;
+    void * val = ::malloc(bytes);
+#ifdef TRACK_ALLOCATIONS
+    allocation_list.append(val);
+#endif
+    return val;
+}
+
+void *
+rust_srv::realloc(void *p, size_t bytes)
+{
+    if (!p) {
+        live_allocs++;
+    }
+    void * val = ::realloc(p, bytes);
+#ifdef TRACK_ALLOCATIONS
+    if (allocation_list.replace(p, val) == NULL) {
+        fatal("not in allocation_list", __FILE__, __LINE__);
+    }
+#endif
+    return val;
+}
+
+void
+rust_srv::free(void *p)
+{
+    if (live_allocs < 1) {
+        fatal("live_allocs < 1", __FILE__, __LINE__);
+    }
+    live_allocs--;
+    ::free(p);
+#ifdef TRACK_ALLOCATIONS
+    if (allocation_list.replace(p, NULL) == NULL) {
+        fatal("not in allocation_list", __FILE__, __LINE__);
+    }
+#endif
+}
+
+void
+rust_srv::fatal(char const *expr, char const *file, size_t line)
+{
+    char buf[1024];
+    snprintf(buf, sizeof(buf),
+             "fatal, '%s' failed, %s:%d",
+             expr, file, (int)line);
+    log(buf);
+    exit(1);
+}
+
+rust_srv *
+rust_srv::clone()
+{
+    return new rust_srv();
+}
+
+
+int
+rust_main_loop(rust_dom *dom)
+{
+    // Make sure someone is watching, to pull us out of infinite loops.
+    rust_timer timer(*dom);
+
+    int rval;
+    rust_task *task;
+
+    dom->log(rust_log::DOM,
+            "running main-loop on domain 0x%" PRIxPTR, dom);
+    dom->logptr("exit-task glue",
+            dom->root_crate->get_exit_task_glue());
+
+    while ((task = dom->sched()) != NULL) {
+        I(dom, task->running());
+
+        dom->log(rust_log::TASK,
+                "activating task 0x%" PRIxPTR ", sp=0x%" PRIxPTR,
+                (uintptr_t)task, task->rust_sp);
+
+        dom->interrupt_flag = 0;
+
+        dom->activate(task);
+
+        dom->log(rust_log::TASK,
+                 "returned from task 0x%" PRIxPTR
+                 " in state '%s', sp=0x%" PRIxPTR,
+                 (uintptr_t)task,
+                 dom->state_vec_name(task->state),
+                 task->rust_sp);
+
+        I(dom, task->rust_sp >= (uintptr_t) &task->stk->data[0]);
+        I(dom, task->rust_sp < task->stk->limit);
+
+        dom->reap_dead_tasks();
+    }
+
+    dom->log(rust_log::DOM, "finished main-loop (dom.rval = %d)", dom->rval);
+    rval = dom->rval;
+
+    return rval;
+}
+
+
+struct
+command_line_args
+{
+    rust_dom &dom;
+    int argc;
+    char **argv;
+
+    // vec[str] passed to rust_task::start.
+    rust_vec *args;
+
+    command_line_args(rust_dom &dom,
+                      int sys_argc,
+                      char **sys_argv)
+        : dom(dom),
+          argc(sys_argc),
+          argv(sys_argv),
+          args(NULL)
+    {
+#if defined(__WIN32__)
+        LPCWSTR cmdline = GetCommandLineW();
+        LPWSTR *wargv = CommandLineToArgvW(cmdline, &argc);
+        dom.win32_require("CommandLineToArgvW", argv != NULL);
+        argv = (char **) dom.malloc(sizeof(char*) * argc);
+        for (int i = 0; i < argc; ++i) {
+            int n_chars = WideCharToMultiByte(CP_UTF8, 0, wargv[i], -1,
+                                              NULL, 0, NULL, NULL);
+            dom.win32_require("WideCharToMultiByte(0)", n_chars != 0);
+            argv[i] = (char *) dom.malloc(n_chars);
+            n_chars = WideCharToMultiByte(CP_UTF8, 0, wargv[i], -1,
+                                          argv[i], n_chars, NULL, NULL);
+            dom.win32_require("WideCharToMultiByte(1)", n_chars != 0);
+        }
+        LocalFree(wargv);
+#endif
+        size_t vec_fill = sizeof(rust_str *) * argc;
+        size_t vec_alloc = next_power_of_two(sizeof(rust_vec) + vec_fill);
+        void *mem = dom.malloc(vec_alloc);
+        args = new (mem) rust_vec(&dom, vec_alloc, 0, NULL);
+        rust_str **strs = (rust_str**) &args->data[0];
+        for (int i = 0; i < argc; ++i) {
+            size_t str_fill = strlen(argv[i]) + 1;
+            size_t str_alloc = next_power_of_two(sizeof(rust_str) + str_fill);
+            mem = dom.malloc(str_alloc);
+            strs[i] = new (mem) rust_str(&dom, str_alloc, str_fill,
+                                         (uint8_t const *)argv[i]);
+        }
+        args->fill = vec_fill;
+        // If the caller has a declared args array, they may drop; but
+        // we don't know if they have such an array. So we pin the args
+        // array here to ensure it survives to program-shutdown.
+        args->ref();
+    }
+
+    ~command_line_args() {
+        if (args) {
+            // Drop the args we've had pinned here.
+            rust_str **strs = (rust_str**) &args->data[0];
+            for (int i = 0; i < argc; ++i)
+                dom.free(strs[i]);
+            dom.free(args);
+        }
+
+#ifdef __WIN32__
+        for (int i = 0; i < argc; ++i) {
+            dom.free(argv[i]);
+        }
+        dom.free(argv);
+#endif
+    }
+};
+
+
+extern "C" CDECL int
+rust_start(uintptr_t main_fn, rust_crate const *crate, int argc, char **argv)
+{
+    int ret;
+    {
+        rust_srv srv;
+        rust_dom dom(&srv, crate);
+        command_line_args args(dom, argc, argv);
+
+        dom.log(rust_log::DOM, "startup: %d args", args.argc);
+        for (int i = 0; i < args.argc; ++i)
+            dom.log(rust_log::DOM,
+                    "startup: arg[%d] = '%s'", i, args.argv[i]);
+
+        if (dom._log.is_tracing(rust_log::DWARF)) {
+            rust_crate_reader rdr(&dom, crate);
+        }
+
+        uintptr_t main_args[3] = { 0, 0, (uintptr_t)args.args };
+
+        dom.root_task->start(crate->get_exit_task_glue(),
+                             main_fn,
+                             (uintptr_t)&main_args,
+                             sizeof(main_args));
+
+        ret = rust_main_loop(&dom);
+    }
+
+#if !defined(__WIN32__)
+    // Don't take down the process if the main thread exits without an
+    // error.
+    if (!ret)
+        pthread_exit(NULL);
+#endif
+    return ret;
+}
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//

src/rt/rust.h

@@ -0,0 +1,49 @@
+#ifndef RUST_H
+#define RUST_H
+
+/*
+ * Include this file after you've defined the ISO C9x stdint
+ * types (size_t, uint8_t, uintptr_t, etc.)
+ */
+
+#ifdef __i386__
+// 'cdecl' ABI only means anything on i386
+#ifdef __WIN32__
+#define CDECL __cdecl
+#else
+#define CDECL __attribute__((cdecl))
+#endif
+#else
+#define CDECL
+#endif
+
+struct rust_srv {
+    size_t live_allocs;
+
+    virtual void log(char const *);
+    virtual void fatal(char const *, char const *, size_t);
+    virtual void *malloc(size_t);
+    virtual void *realloc(void *, size_t);
+    virtual void free(void *);
+    virtual rust_srv *clone();
+
+    rust_srv();
+    virtual ~rust_srv();
+};
+
+inline void *operator new(size_t size, rust_srv *srv)
+{
+    return srv->malloc(size);
+}
+
+/*
+ * Local Variables:
+ * fill-column: 78;
+ * indent-tabs-mode: nil
+ * c-basic-offset: 4
+ * buffer-file-coding-system: utf-8-unix
+ * compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+ * End:
+ */
+
+#endif /* RUST_H */

src/rt/rust_builtin.cpp

@@ -0,0 +1,129 @@
+
+#include "rust_internal.h"
+
+/* Native builtins. */
+extern "C" CDECL rust_str*
+str_alloc(rust_task *task, size_t n_bytes)
+{
+    rust_dom *dom = task->dom;
+    size_t alloc = next_power_of_two(sizeof(rust_str) + n_bytes);
+    void *mem = dom->malloc(alloc);
+    if (!mem) {
+        task->fail(2);
+        return NULL;
+    }
+    rust_str *st = new (mem) rust_str(dom, alloc, 1, (uint8_t const *)"");
+    return st;
+}
+
+extern "C" CDECL rust_str*
+last_os_error(rust_task *task) {
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::TASK, "last_os_error()");
+
+#if defined(__WIN32__)
+    LPTSTR buf;
+    DWORD err = GetLastError();
+    DWORD res = FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER |
+                              FORMAT_MESSAGE_FROM_SYSTEM |
+                              FORMAT_MESSAGE_IGNORE_INSERTS,
+                              NULL, err,
+                              MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+                              (LPTSTR) &buf, 0, NULL);
+    if (!res) {
+        task->fail(1);
+        return NULL;
+    }
+#elif defined(_GNU_SOURCE)
+    char cbuf[1024];
+    char *buf = strerror_r(errno, cbuf, sizeof(cbuf));
+    if (!buf) {
+        task->fail(1);
+        return NULL;
+    }
+#else
+    char buf[1024];
+    int err = strerror_r(errno, buf, sizeof(buf));
+    if (err) {
+        task->fail(1);
+        return NULL;
+    }
+#endif
+    size_t fill = strlen(buf) + 1;
+    size_t alloc = next_power_of_two(sizeof(rust_str) + fill);
+    void *mem = dom->malloc(alloc);
+    if (!mem) {
+        task->fail(1);
+        return NULL;
+    }
+    rust_str *st = new (mem) rust_str(dom, alloc, fill, (const uint8_t *)buf);
+
+#ifdef __WIN32__
+    LocalFree((HLOCAL)buf);
+#endif
+    return st;
+}
+
+extern "C" CDECL size_t
+size_of(rust_task *task, type_desc *t) {
+  return t->size;
+}
+
+extern "C" CDECL size_t
+align_of(rust_task *task, type_desc *t) {
+  return t->align;
+}
+
+extern "C" CDECL size_t
+refcount(rust_task *task, type_desc *t, size_t *v) {
+    // Passed-in value has refcount 1 too high
+    // because it was ref'ed while making the call.
+    return (*v) - 1;
+}
+
+extern "C" CDECL rust_vec*
+vec_alloc(rust_task *task, type_desc *t, size_t n_elts)
+{
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::MEM,
+            "vec_alloc %" PRIdPTR " elements of size %" PRIdPTR,
+             n_elts, t->size);
+    size_t fill = n_elts * t->size;
+    size_t alloc = next_power_of_two(sizeof(rust_vec) + fill);
+    void *mem = dom->malloc(alloc);
+    if (!mem) {
+        task->fail(3);
+        return NULL;
+    }
+    rust_vec *vec = new (mem) rust_vec(dom, alloc, 0, NULL);
+    return vec;
+}
+
+extern "C" CDECL char const *
+str_buf(rust_task *task, rust_str *s)
+{
+    return (char const *)&s->data[0];
+}
+
+extern "C" CDECL void *
+vec_buf(rust_task *task, type_desc *ty, rust_vec *v)
+{
+    return (void *)&v->data[0];
+}
+
+extern "C" CDECL size_t
+vec_len(rust_task *task, type_desc *ty, rust_vec *v)
+{
+    return v->fill;
+}
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//

src/rt/rust_chan.cpp

@@ -0,0 +1,34 @@
+
+#include "rust_internal.h"
+#include "rust_chan.h"
+
+rust_chan::rust_chan(rust_task *task, rust_port *port) :
+    task(task),
+    port(port),
+    buffer(task->dom, port->unit_sz),
+    token(this)
+{
+    if (port)
+        port->chans.push(this);
+}
+
+rust_chan::~rust_chan()
+{
+    if (port) {
+        if (token.pending())
+            token.withdraw();
+        port->chans.swapdel(this);
+    }
+}
+
+void
+rust_chan::disassociate()
+{
+    I(task->dom, port);
+
+    if (token.pending())
+        token.withdraw();
+
+    // Delete reference to the port/
+    port = NULL;
+}

src/rt/rust_chan.h

@@ -0,0 +1,22 @@
+
+#ifndef RUST_CHAN_H
+#define RUST_CHAN_H
+
+class rust_chan : public rc_base<rust_chan>, public task_owned<rust_chan> {
+public:
+    rust_chan(rust_task *task, rust_port *port);
+    ~rust_chan();
+
+    rust_task *task;
+    rust_port *port;
+    circ_buf buffer;
+    size_t idx;           // Index into port->chans.
+
+    // Token belonging to this chan, it will be placed into a port's
+    // writers vector if we have something to send to the port.
+    rust_token token;
+
+    void disassociate();
+};
+
+#endif /* RUST_CHAN_H */

src/rt/rust_comm.cpp

@@ -0,0 +1,199 @@
+
+#include "rust_internal.h"
+
+template class ptr_vec<rust_token>;
+template class ptr_vec<rust_alarm>;
+template class ptr_vec<rust_chan>;
+
+rust_alarm::rust_alarm(rust_task *receiver) :
+    receiver(receiver)
+{
+}
+
+
+// Circular buffers.
+
+circ_buf::circ_buf(rust_dom *dom, size_t unit_sz) :
+    dom(dom),
+    alloc(INIT_CIRC_BUF_UNITS * unit_sz),
+    unit_sz(unit_sz),
+    next(0),
+    unread(0),
+    data((uint8_t *)dom->calloc(alloc))
+{
+    I(dom, unit_sz);
+    dom->log(rust_log::MEM|rust_log::COMM,
+             "new circ_buf(alloc=%d, unread=%d) -> circ_buf=0x%" PRIxPTR,
+             alloc, unread, this);
+    I(dom, data);
+}
+
+circ_buf::~circ_buf()
+{
+    dom->log(rust_log::MEM|rust_log::COMM,
+             "~circ_buf 0x%" PRIxPTR,
+             this);
+    I(dom, data);
+    // I(dom, unread == 0);
+    dom->free(data);
+}
+
+void
+circ_buf::transfer(void *dst)
+{
+    size_t i;
+    uint8_t *d = (uint8_t *)dst;
+    I(dom, dst);
+    for (i = 0; i < unread; i += unit_sz)
+        memcpy(&d[i], &data[next + i % alloc], unit_sz);
+}
+
+void
+circ_buf::push(void *src)
+{
+    size_t i;
+    void *tmp;
+
+    I(dom, src);
+    I(dom, unread <= alloc);
+
+    /* Grow if necessary. */
+    if (unread == alloc) {
+        I(dom, alloc <= MAX_CIRC_BUF_SIZE);
+        tmp = dom->malloc(alloc << 1);
+        transfer(tmp);
+        alloc <<= 1;
+        dom->free(data);
+        data = (uint8_t *)tmp;
+    }
+
+    dom->log(rust_log::MEM|rust_log::COMM,
+             "circ buf push, unread=%d, alloc=%d, unit_sz=%d",
+             unread, alloc, unit_sz);
+
+    I(dom, unread < alloc);
+    I(dom, unread + unit_sz <= alloc);
+
+    i = (next + unread) % alloc;
+    memcpy(&data[i], src, unit_sz);
+
+    dom->log(rust_log::MEM|rust_log::COMM, "pushed data at index %d", i);
+    unread += unit_sz;
+}
+
+void
+circ_buf::shift(void *dst)
+{
+    size_t i;
+    void *tmp;
+
+    I(dom, dst);
+    I(dom, unit_sz > 0);
+    I(dom, unread >= unit_sz);
+    I(dom, unread <= alloc);
+    I(dom, data);
+    i = next;
+    memcpy(dst, &data[i], unit_sz);
+    dom->log(rust_log::MEM|rust_log::COMM, "shifted data from index %d", i);
+    unread -= unit_sz;
+    next += unit_sz;
+    I(dom, next <= alloc);
+    if (next == alloc)
+        next = 0;
+
+    /* Shrink if necessary. */
+    if (alloc >= INIT_CIRC_BUF_UNITS * unit_sz &&
+        unread <= alloc / 4) {
+        tmp = dom->malloc(alloc / 2);
+        transfer(tmp);
+        alloc >>= 1;
+        dom->free(data);
+        data = (uint8_t *)tmp;
+    }
+}
+
+
+// Ports.
+
+rust_port::rust_port(rust_task *task, size_t unit_sz) :
+    task(task),
+    unit_sz(unit_sz),
+    writers(task->dom),
+    chans(task->dom)
+{
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::MEM|rust_log::COMM,
+             "new rust_port(task=0x%" PRIxPTR ", unit_sz=%d) -> port=0x%"
+             PRIxPTR, (uintptr_t)task, unit_sz, (uintptr_t)this);
+}
+
+rust_port::~rust_port()
+{
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::COMM|rust_log::MEM,
+             "~rust_port 0x%" PRIxPTR,
+             (uintptr_t)this);
+    while (chans.length() > 0)
+        chans.pop()->disassociate();
+}
+
+
+// Tokens.
+
+rust_token::rust_token(rust_chan *chan) :
+    chan(chan),
+    idx(0),
+    submitted(false)
+{
+}
+
+rust_token::~rust_token()
+{
+}
+
+bool
+rust_token::pending() const
+{
+    return submitted;
+}
+
+void
+rust_token::submit()
+{
+    rust_port *port = chan->port;
+    rust_dom *dom = chan->task->dom;
+
+    I(dom, port);
+    I(dom, !submitted);
+
+    port->writers.push(this);
+    submitted = true;
+}
+
+void
+rust_token::withdraw()
+{
+    rust_task *task = chan->task;
+    rust_port *port = chan->port;
+    rust_dom *dom = task->dom;
+
+    I(dom, port);
+    I(dom, submitted);
+
+    if (task->blocked())
+        task->wakeup(this); // must be blocked on us (or dead)
+    port->writers.swapdel(this);
+    submitted = false;
+}
+
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//

src/rt/rust_crate.cpp

@@ -0,0 +1,63 @@
+
+#include "rust_internal.h"
+
+uintptr_t
+rust_crate::get_image_base() const {
+  return ((uintptr_t)this + image_base_off);
+}
+
+ptrdiff_t
+rust_crate::get_relocation_diff() const {
+  return ((uintptr_t)this - self_addr);
+}
+
+activate_glue_ty
+rust_crate::get_activate_glue() const {
+  return (activate_glue_ty) ((uintptr_t)this + activate_glue_off);
+}
+
+uintptr_t
+rust_crate::get_exit_task_glue() const {
+  return ((uintptr_t)this + exit_task_glue_off);
+}
+
+uintptr_t
+rust_crate::get_unwind_glue() const {
+  return ((uintptr_t)this + unwind_glue_off);
+}
+
+uintptr_t
+rust_crate::get_yield_glue() const {
+  return ((uintptr_t)this + yield_glue_off);
+}
+
+rust_crate::mem_area::mem_area(rust_dom *dom, uintptr_t pos, size_t sz)
+  : dom(dom),
+    base(pos),
+    lim(pos + sz)
+{
+  dom->log(rust_log::MEM, "new mem_area [0x%" PRIxPTR ",0x%" PRIxPTR "]",
+           base, lim);
+}
+
+rust_crate::mem_area
+rust_crate::get_debug_info(rust_dom *dom) const {
+  return mem_area(dom, ((uintptr_t)this + debug_info_off),
+                  debug_info_sz);
+}
+
+rust_crate::mem_area
+rust_crate::get_debug_abbrev(rust_dom *dom) const {
+  return mem_area(dom, ((uintptr_t)this + debug_abbrev_off),
+                  debug_abbrev_sz);
+}
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:

src/rt/rust_crate_cache.cpp

@@ -0,0 +1,306 @@
+
+#include "rust_internal.h"
+
+rust_crate_cache::lib::lib(rust_dom *dom, char const *name)
+    : handle(0),
+      dom(dom)
+{
+#if defined(__WIN32__)
+    handle = (uintptr_t)LoadLibrary(_T(name));
+#else
+    handle = (uintptr_t)dlopen(name, RTLD_LOCAL|RTLD_LAZY);
+#endif
+    dom->log(rust_log::CACHE, "loaded library '%s' as 0x%"  PRIxPTR,
+             name, handle);
+}
+
+rust_crate_cache::lib::~lib() {
+    dom->log(rust_log::CACHE, "~rust_crate_cache::lib(0x%" PRIxPTR ")",
+             handle);
+    if (handle) {
+#if defined(__WIN32__)
+        FreeLibrary((HMODULE)handle);
+#else
+        dlclose((void*)handle);
+#endif
+    }
+}
+
+uintptr_t
+rust_crate_cache::lib::get_handle() {
+    return handle;
+}
+
+
+
+rust_crate_cache::c_sym::c_sym(rust_dom *dom, lib *library, char const *name)
+    : val(0),
+      library(library),
+      dom(dom)
+{
+    library->ref();
+    uintptr_t handle = library->get_handle();
+    if (handle) {
+#if defined(__WIN32__)
+        val = (uintptr_t)GetProcAddress((HMODULE)handle, _T(name));
+#else
+        val = (uintptr_t)dlsym((void*)handle, name);
+#endif
+        dom->log(rust_log::CACHE, "resolved symbol '%s' to 0x%"  PRIxPTR,
+                 name, val);
+    } else {
+        dom->log(rust_log::CACHE, "unresolved symbol '%s', null lib handle",
+                 name);
+    }
+}
+
+rust_crate_cache::c_sym::~c_sym() {
+    dom->log(rust_log::CACHE,
+            "~rust_crate_cache::c_sym(0x%" PRIxPTR ")", val);
+    library->deref();
+}
+
+uintptr_t
+rust_crate_cache::c_sym::get_val() {
+    return val;
+}
+
+
+
+rust_crate_cache::rust_sym::rust_sym(rust_dom *dom,
+                                     rust_crate const *curr_crate,
+                                     c_sym *crate_sym,
+                                     char const **path)
+    : val(0),
+      crate_sym(crate_sym),
+      dom(dom)
+{
+    crate_sym->ref();
+    typedef rust_crate_reader::die die;
+    rust_crate const *crate = (rust_crate*)crate_sym->get_val();
+    if (!crate) {
+        dom->log(rust_log::CACHE,
+                 "failed to resolve symbol, null crate symbol");
+        return;
+    }
+    rust_crate_reader rdr(dom, crate);
+    bool found_root = false;
+    bool found_leaf = false;
+    for (die d = rdr.dies.first_die();
+         !(found_root || d.is_null());
+         d = d.next_sibling()) {
+
+        die t1 = d;
+        die t2 = d;
+        for (char const **c = crate_rel(curr_crate, path);
+             (*c
+              && !t1.is_null()
+              && t1.find_child_by_name(crate_rel(curr_crate, *c), t2));
+             ++c, t1=t2) {
+            dom->log(rust_log::DWARF|rust_log::CACHE,
+                    "matched die <0x%"  PRIxPTR
+                    ">, child '%s' = die<0x%" PRIxPTR ">",
+                    t1.off, crate_rel(curr_crate, *c), t2.off);
+            found_root = found_root || true;
+            if (!*(c+1) && t2.find_num_attr(DW_AT_low_pc, val)) {
+                dom->log(rust_log::DWARF|rust_log::CACHE,
+                         "found relative address: 0x%"  PRIxPTR, val);
+                dom->log(rust_log::DWARF|rust_log::CACHE,
+                         "plus image-base 0x%"  PRIxPTR,
+                         crate->get_image_base());
+                val += crate->get_image_base();
+                found_leaf = true;
+                break;
+            }
+        }
+        if (found_root || found_leaf)
+            break;
+    }
+    if (found_leaf) {
+        dom->log(rust_log::CACHE, "resolved symbol to 0x%"  PRIxPTR, val);
+    } else {
+        dom->log(rust_log::CACHE, "failed to resolve symbol");
+    }
+}
+
+rust_crate_cache::rust_sym::~rust_sym() {
+    dom->log(rust_log::CACHE,
+             "~rust_crate_cache::rust_sym(0x%" PRIxPTR ")", val);
+    crate_sym->deref();
+}
+
+uintptr_t
+rust_crate_cache::rust_sym::get_val() {
+    return val;
+}
+
+
+
+rust_crate_cache::lib *
+rust_crate_cache::get_lib(size_t n, char const *name)
+{
+    I(dom, n < crate->n_libs);
+    lib *library = libs[n];
+    if (!library) {
+        library = new (dom) lib(dom, name);
+        libs[n] = library;
+    }
+    return library;
+}
+
+rust_crate_cache::c_sym *
+rust_crate_cache::get_c_sym(size_t n, lib *library, char const *name)
+{
+    I(dom, n < crate->n_c_syms);
+    c_sym *sym = c_syms[n];
+    dom->log(rust_log::CACHE, "cached C symbol %s = 0x%" PRIxPTR, name, sym);
+    if (!sym) {
+        sym = new (dom) c_sym(dom, library, name);
+        c_syms[n] = sym;
+    }
+    return sym;
+}
+
+rust_crate_cache::rust_sym *
+rust_crate_cache::get_rust_sym(size_t n,
+                               rust_dom *dom,
+                               rust_crate const *curr_crate,
+                               c_sym *crate_sym,
+                               char const **path)
+{
+    I(dom, n < crate->n_rust_syms);
+    rust_sym *sym = rust_syms[n];
+    if (!sym) {
+        sym = new (dom) rust_sym(dom, curr_crate, crate_sym, path);
+        rust_syms[n] = sym;
+    }
+    return sym;
+}
+
+static inline void
+adjust_disp(uintptr_t &disp, const void *oldp, const void *newp)
+{
+    if (disp) {
+        disp += (uintptr_t)oldp;
+        disp -= (uintptr_t)newp;
+    }
+}
+
+type_desc *
+rust_crate_cache::get_type_desc(size_t size,
+                                size_t align,
+                                size_t n_descs,
+                                type_desc const **descs)
+{
+    I(dom, n_descs > 1);
+    type_desc *td = NULL;
+    size_t keysz = n_descs * sizeof(type_desc*);
+    HASH_FIND(hh, this->type_descs, descs, keysz, td);
+    if (td) {
+        dom->log(rust_log::CACHE, "rust_crate_cache::get_type_desc hit");
+        return td;
+    }
+    dom->log(rust_log::CACHE, "rust_crate_cache::get_type_desc miss");
+    td = (type_desc*) dom->malloc(sizeof(type_desc) + keysz);
+    if (!td)
+        return NULL;
+    // By convention, desc 0 is the root descriptor.
+    // but we ignore the size and alignment of it and use the
+    // passed-in, computed values.
+    memcpy(td, descs[0], sizeof(type_desc));
+    td->first_param = &td->descs[1];
+    td->size = size;
+    td->align = align;
+    for (size_t i = 0; i < n_descs; ++i) {
+        dom->log(rust_log::CACHE,
+                 "rust_crate_cache::descs[%" PRIdPTR "] = 0x%" PRIxPTR,
+                 i, descs[i]);
+        td->descs[i] = descs[i];
+    }
+    adjust_disp(td->copy_glue_off, descs[0], td);
+    adjust_disp(td->drop_glue_off, descs[0], td);
+    adjust_disp(td->free_glue_off, descs[0], td);
+    adjust_disp(td->mark_glue_off, descs[0], td);
+    adjust_disp(td->obj_drop_glue_off, descs[0], td);
+    HASH_ADD(hh, this->type_descs, descs, keysz, td);
+    return td;
+}
+
+rust_crate_cache::rust_crate_cache(rust_dom *dom,
+                                   rust_crate const *crate)
+    : rust_syms((rust_sym**)
+                dom->calloc(sizeof(rust_sym*) * crate->n_rust_syms)),
+      c_syms((c_sym**) dom->calloc(sizeof(c_sym*) * crate->n_c_syms)),
+      libs((lib**) dom->calloc(sizeof(lib*) * crate->n_libs)),
+      type_descs(NULL),
+      crate(crate),
+      dom(dom),
+      idx(0)
+{
+    I(dom, rust_syms);
+    I(dom, c_syms);
+    I(dom, libs);
+}
+
+void
+rust_crate_cache::flush() {
+    dom->log(rust_log::CACHE, "rust_crate_cache::flush()");
+    for (size_t i = 0; i < crate->n_rust_syms; ++i) {
+        rust_sym *s = rust_syms[i];
+        if (s) {
+            dom->log(rust_log::CACHE,
+                     "rust_crate_cache::flush() deref rust_sym %"
+                     PRIdPTR " (rc=%" PRIdPTR ")", i, s->refcnt);
+            s->deref();
+        }
+        rust_syms[i] = NULL;
+    }
+
+    for (size_t i = 0; i < crate->n_c_syms; ++i) {
+        c_sym *s = c_syms[i];
+        if (s) {
+            dom->log(rust_log::CACHE,
+                     "rust_crate_cache::flush() deref c_sym %"
+                     PRIdPTR " (rc=%" PRIdPTR ")", i, s->refcnt);
+            s->deref();
+        }
+        c_syms[i] = NULL;
+    }
+
+    for (size_t i = 0; i < crate->n_libs; ++i) {
+        lib *l = libs[i];
+        if (l) {
+            dom->log(rust_log::CACHE, "rust_crate_cache::flush() deref lib %"
+                     PRIdPTR " (rc=%" PRIdPTR ")", i, l->refcnt);
+            l->deref();
+        }
+        libs[i] = NULL;
+    }
+
+    while (type_descs) {
+        type_desc *d = type_descs;
+        HASH_DEL(type_descs, d);
+        dom->log(rust_log::MEM,
+                 "rust_crate_cache::flush() tydesc %" PRIxPTR, d);
+        dom->free(d);
+    }
+}
+
+rust_crate_cache::~rust_crate_cache()
+{
+    flush();
+    dom->free(rust_syms);
+    dom->free(c_syms);
+    dom->free(libs);
+}
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//

src/rt/rust_crate_reader.cpp

@@ -0,0 +1,578 @@
+
+#include "rust_internal.h"
+
+bool
+rust_crate_reader::mem_reader::is_ok()
+{
+  return ok;
+}
+
+bool
+rust_crate_reader::mem_reader::at_end()
+{
+  return pos == mem.lim;
+}
+
+void
+rust_crate_reader::mem_reader::fail()
+{
+  ok = false;
+}
+
+void
+rust_crate_reader::mem_reader::reset()
+{
+  pos = mem.base;
+  ok = true;
+}
+
+rust_crate_reader::mem_reader::mem_reader(rust_crate::mem_area &m)
+  : mem(m),
+    ok(true),
+    pos(m.base)
+{}
+
+size_t
+rust_crate_reader::mem_reader::tell_abs()
+{
+  return pos;
+}
+
+size_t
+rust_crate_reader::mem_reader::tell_off()
+{
+  return pos - mem.base;
+}
+
+void
+rust_crate_reader::mem_reader::seek_abs(uintptr_t p)
+{
+  if (!ok || p < mem.base || p >= mem.lim)
+    ok = false;
+  else
+    pos = p;
+}
+
+void
+rust_crate_reader::mem_reader::seek_off(uintptr_t p)
+{
+  seek_abs(p + mem.base);
+}
+
+
+bool
+rust_crate_reader::mem_reader::adv_zstr(size_t sz)
+{
+  sz = 0;
+  while (ok) {
+    char c;
+    get(c);
+    ++sz;
+    if (c == '\0')
+      return true;
+  }
+  return false;
+}
+
+bool
+rust_crate_reader::mem_reader::get_zstr(char const *&c, size_t &sz)
+{
+  if (!ok)
+    return false;
+  c = (char const *)(pos);
+  return adv_zstr(sz);
+}
+
+void
+rust_crate_reader::mem_reader::adv(size_t amt)
+{
+  if (pos < mem.base
+      || pos >= mem.lim
+      || pos + amt > mem.lim)
+    ok = false;
+  if (!ok)
+    return;
+  // mem.dom->log(rust_log::MEM, "adv %d bytes", amt);
+  pos += amt;
+  ok &= !at_end();
+  I(mem.dom, at_end() || (mem.base <= pos && pos < mem.lim));
+}
+
+
+rust_crate_reader::abbrev::abbrev(rust_dom *dom,
+                                  uintptr_t body_off,
+                                  size_t body_sz,
+                                  uintptr_t tag,
+                                  uint8_t has_children) :
+  dom(dom),
+  body_off(body_off),
+  tag(tag),
+  has_children(has_children),
+  idx(0)
+{}
+
+
+rust_crate_reader::abbrev_reader::abbrev_reader
+  (rust_crate::mem_area &abbrev_mem)
+  : mem_reader(abbrev_mem),
+    abbrevs(abbrev_mem.dom)
+{
+  rust_dom *dom = mem.dom;
+  while (is_ok()) {
+
+    // dom->log(rust_log::DWARF, "reading new abbrev at 0x%" PRIxPTR,
+    //          tell_off());
+
+    uintptr_t idx, tag;
+    uint8_t has_children;
+    get_uleb(idx);
+    get_uleb(tag);
+    get(has_children);
+
+    uintptr_t attr, form;
+    size_t body_off = tell_off();
+    while (is_ok() && step_attr_form_pair(attr, form));
+
+    // dom->log(rust_log::DWARF,
+    //         "finished scanning attr/form pairs, pos=0x%"
+    //         PRIxPTR ", lim=0x%" PRIxPTR ", is_ok=%d, at_end=%d",
+    //        pos, mem.lim, is_ok(), at_end());
+
+    if (is_ok() || at_end()) {
+      dom->log(rust_log::DWARF, "read abbrev: %" PRIdPTR, idx);
+      I(dom, idx = abbrevs.length() + 1);
+      abbrevs.push(new (dom) abbrev(dom, body_off,
+                                    tell_off() - body_off,
+                                    tag, has_children));
+    }
+  }
+}
+
+rust_crate_reader::abbrev *
+rust_crate_reader::abbrev_reader::get_abbrev(size_t i) {
+  i -= 1;
+  if (i < abbrevs.length())
+    return abbrevs[i];
+  return NULL;
+}
+
+bool
+rust_crate_reader::abbrev_reader::step_attr_form_pair(uintptr_t &attr,
+                                                      uintptr_t &form)
+{
+  attr = 0;
+  form = 0;
+  // mem.dom->log(rust_log::DWARF, "reading attr/form pair at 0x%" PRIxPTR,
+  //              tell_off());
+  get_uleb(attr);
+  get_uleb(form);
+  // mem.dom->log(rust_log::DWARF, "attr 0x%" PRIxPTR ", form 0x%" PRIxPTR,
+  //              attr, form);
+  return ! (attr == 0 && form == 0);
+}
+rust_crate_reader::abbrev_reader::~abbrev_reader() {
+  while (abbrevs.length()) {
+    delete abbrevs.pop();
+  }
+}
+
+
+bool
+rust_crate_reader::attr::is_numeric() const
+{
+  switch (form) {
+  case DW_FORM_ref_addr:
+  case DW_FORM_addr:
+  case DW_FORM_data4:
+  case DW_FORM_data1:
+  case DW_FORM_flag:
+    return true;
+  default:
+    break;
+  }
+  return false;
+}
+
+bool
+rust_crate_reader::attr::is_string() const
+{
+  return form == DW_FORM_string;
+}
+
+size_t
+rust_crate_reader::attr::get_ssz(rust_dom *dom) const
+{
+  I(dom, is_string());
+  return val.str.sz;
+}
+
+char const *
+rust_crate_reader::attr::get_str(rust_dom *dom) const
+{
+  I(dom, is_string());
+  return val.str.s;
+}
+
+uintptr_t
+rust_crate_reader::attr::get_num(rust_dom *dom) const
+{
+  I(dom, is_numeric());
+  return val.num;
+}
+
+bool
+rust_crate_reader::attr::is_unknown() const {
+  return !(is_numeric() || is_string());
+}
+
+rust_crate_reader::rdr_sess::rdr_sess(die_reader *rdr) : rdr(rdr)
+{
+  I(rdr->mem.dom, !rdr->in_use);
+  rdr->in_use = true;
+}
+
+rust_crate_reader::rdr_sess::~rdr_sess()
+{
+  rdr->in_use = false;
+}
+
+rust_crate_reader::die::die(die_reader *rdr, uintptr_t off)
+  : rdr(rdr),
+    off(off),
+    using_rdr(false)
+{
+  rust_dom *dom = rdr->mem.dom;
+  rdr_sess use(rdr);
+
+  rdr->reset();
+  rdr->seek_off(off);
+  if (!rdr->is_ok()) {
+    ab = NULL;
+    return;
+  }
+  size_t ab_idx;
+  rdr->get_uleb(ab_idx);
+  if (!ab_idx) {
+    ab = NULL;
+    dom->log(rust_log::DWARF, "DIE <0x%" PRIxPTR "> (null)", off);
+  } else {
+    ab = rdr->abbrevs.get_abbrev(ab_idx);
+    dom->log(rust_log::DWARF, "DIE <0x%" PRIxPTR "> abbrev 0x%"
+             PRIxPTR, off, ab_idx);
+    dom->log(rust_log::DWARF, "  tag 0x%x, has children: %d",
+             ab->tag, ab->has_children);
+  }
+}
+
+bool
+rust_crate_reader::die::is_null() const
+{
+  return ab == NULL;
+}
+
+bool
+rust_crate_reader::die::has_children() const
+{
+  return (!is_null()) && ab->has_children;
+}
+
+dw_tag
+rust_crate_reader::die::tag() const
+{
+  if (is_null())
+    return (dw_tag) (-1);
+  return (dw_tag) ab->tag;
+}
+
+bool
+rust_crate_reader::die::start_attrs() const
+{
+  if (is_null())
+    return false;
+  rdr->reset();
+  rdr->seek_off(off + 1);
+  rdr->abbrevs.reset();
+  rdr->abbrevs.seek_off(ab->body_off);
+  return rdr->is_ok();
+}
+
+bool
+rust_crate_reader::die::step_attr(attr &a) const
+{
+  uintptr_t ai, fi;
+  if (rdr->abbrevs.step_attr_form_pair(ai, fi) && rdr->is_ok()) {
+    a.at = (dw_at)ai;
+    a.form = (dw_form)fi;
+
+    uint32_t u32;
+    uint8_t u8;
+
+    switch (a.form) {
+    case DW_FORM_string:
+      return rdr->get_zstr(a.val.str.s, a.val.str.sz);
+      break;
+
+    case DW_FORM_ref_addr:
+      I(rdr->mem.dom, sizeof(uintptr_t) == 4);
+    case DW_FORM_addr:
+    case DW_FORM_data4:
+      rdr->get(u32);
+      a.val.num = (uintptr_t)u32;
+      return rdr->is_ok() || rdr->at_end();
+      break;
+
+    case DW_FORM_data1:
+    case DW_FORM_flag:
+      rdr->get(u8);
+      a.val.num = u8;
+      return rdr->is_ok() || rdr->at_end();
+      break;
+
+    case DW_FORM_block1:
+      rdr->get(u8);
+      rdr->adv(u8);
+      return rdr->is_ok() || rdr->at_end();
+      break;
+
+    default:
+      rdr->mem.dom->log(rust_log::DWARF, "  unknown dwarf form: 0x%"
+                        PRIxPTR, a.form);
+      rdr->fail();
+      break;
+    }
+  }
+  return false;
+}
+
+bool
+rust_crate_reader::die::find_str_attr(dw_at at, char const *&c)
+{
+  rdr_sess use(rdr);
+  if (is_null())
+    return false;
+  if (start_attrs()) {
+    attr a;
+    while (step_attr(a)) {
+      if (a.at == at && a.is_string()) {
+        c = a.get_str(rdr->mem.dom);
+        return true;
+      }
+    }
+  }
+  return false;
+}
+
+bool
+rust_crate_reader::die::find_num_attr(dw_at at, uintptr_t &n)
+{
+  rdr_sess use(rdr);
+  if (is_null())
+    return false;
+  if (start_attrs()) {
+    attr a;
+    while (step_attr(a)) {
+      if (a.at == at && a.is_numeric()) {
+        n = a.get_num(rdr->mem.dom);
+        return true;
+      }
+    }
+  }
+  return false;
+}
+
+bool
+rust_crate_reader::die::is_transparent()
+{
+  // "semantically transparent" DIEs are those with
+  // children that serve to structure the tree but have
+  // tags that don't reflect anything in the rust-module
+  // name hierarchy.
+  switch (tag()) {
+  case DW_TAG_compile_unit:
+  case DW_TAG_lexical_block:
+    return (has_children());
+  default:
+    break;
+  }
+  return false;
+}
+
+bool
+rust_crate_reader::die::find_child_by_name(char const *c,
+                                                       die &child,
+                                                       bool exact)
+{
+  rust_dom *dom = rdr->mem.dom;
+  I(dom, has_children());
+  I(dom, !is_null());
+
+  for (die ch = next(); !ch.is_null(); ch = ch.next_sibling()) {
+    char const *ac;
+    if (!exact && ch.is_transparent()) {
+      if (ch.find_child_by_name(c, child, exact)) {
+        return true;
+      }
+    }
+    else if (ch.find_str_attr(DW_AT_name, ac)) {
+      if (strcmp(ac, c) == 0) {
+        child = ch;
+        return true;
+      }
+    }
+  }
+  return false;
+}
+
+bool
+rust_crate_reader::die::find_child_by_tag(dw_tag tag, die &child)
+{
+  rust_dom *dom = rdr->mem.dom;
+  I(dom, has_children());
+  I(dom, !is_null());
+
+  for (child = next(); !child.is_null();
+       child = child.next_sibling()) {
+    if (child.tag() == tag)
+      return true;
+  }
+  return false;
+}
+
+rust_crate_reader::die
+rust_crate_reader::die::next() const
+{
+  rust_dom *dom = rdr->mem.dom;
+
+  if (is_null()) {
+    rdr->seek_off(off + 1);
+    return die(rdr, rdr->tell_off());
+  }
+
+  {
+    rdr_sess use(rdr);
+    if (start_attrs()) {
+      attr a;
+      while (step_attr(a)) {
+        I(dom, !(a.is_numeric() && a.is_string()));
+        if (a.is_numeric())
+          dom->log(rust_log::DWARF, "  attr num: 0x%"
+                   PRIxPTR, a.get_num(dom));
+        else if (a.is_string())
+          dom->log(rust_log::DWARF, "  attr str: %s",
+                   a.get_str(dom));
+        else
+          dom->log(rust_log::DWARF, "  attr ??:");
+      }
+    }
+  }
+  return die(rdr, rdr->tell_off());
+}
+
+rust_crate_reader::die
+rust_crate_reader::die::next_sibling() const
+{
+  // FIXME: use DW_AT_sibling, when present.
+  if (has_children()) {
+    // rdr->mem.dom->log(rust_log::DWARF, "+++ children of die 0x%"
+    //                   PRIxPTR, off);
+    die child = next();
+    while (!child.is_null())
+      child = child.next_sibling();
+    // rdr->mem.dom->log(rust_log::DWARF, "--- children of die 0x%"
+    //                   PRIxPTR, off);
+    return child.next();
+  } else {
+    return next();
+  }
+}
+
+
+rust_crate_reader::die
+rust_crate_reader::die_reader::first_die()
+{
+  reset();
+  seek_off(cu_base
+           + sizeof(dwarf_vers)
+           + sizeof(cu_abbrev_off)
+           + sizeof(sizeof_addr));
+  return die(this, tell_off());
+}
+
+void
+rust_crate_reader::die_reader::dump()
+{
+  rust_dom *dom = mem.dom;
+  die d = first_die();
+  while (!d.is_null())
+    d = d.next_sibling();
+  I(dom, d.is_null());
+  I(dom, d.off == mem.lim - mem.base);
+}
+
+
+rust_crate_reader::die_reader::die_reader(rust_crate::mem_area &die_mem,
+                              abbrev_reader &abbrevs)
+  : mem_reader(die_mem),
+    abbrevs(abbrevs),
+    cu_unit_length(0),
+    cu_base(0),
+    dwarf_vers(0),
+    cu_abbrev_off(0),
+    sizeof_addr(0),
+    in_use(false)
+{
+  rust_dom *dom = mem.dom;
+
+  rdr_sess use(this);
+
+  get(cu_unit_length);
+  cu_base = tell_off();
+
+  get(dwarf_vers);
+  get(cu_abbrev_off);
+  get(sizeof_addr);
+
+  if (is_ok()) {
+    dom->log(rust_log::DWARF, "new root CU at 0x%" PRIxPTR, die_mem.base);
+    dom->log(rust_log::DWARF, "CU unit length: %" PRId32, cu_unit_length);
+    dom->log(rust_log::DWARF, "dwarf version: %" PRId16, dwarf_vers);
+    dom->log(rust_log::DWARF, "CU abbrev off: %" PRId32, cu_abbrev_off);
+    dom->log(rust_log::DWARF, "size of address: %" PRId8, sizeof_addr);
+    I(dom, sizeof_addr == sizeof(uintptr_t));
+    I(dom, dwarf_vers >= 2);
+    I(dom, cu_base + cu_unit_length == die_mem.lim - die_mem.base);
+  } else {
+    dom->log(rust_log::DWARF, "failed to read root CU header");
+  }
+}
+
+rust_crate_reader::die_reader::~die_reader() {
+}
+
+
+rust_crate_reader::rust_crate_reader(rust_dom *dom,
+                                     rust_crate const *crate)
+  : dom(dom),
+    crate(crate),
+    abbrev_mem(crate->get_debug_abbrev(dom)),
+    abbrevs(abbrev_mem),
+    die_mem(crate->get_debug_info(dom)),
+    dies(die_mem, abbrevs)
+{
+  dom->log(rust_log::MEM, "crate_reader on crate: 0x%" PRIxPTR, this);
+  dom->log(rust_log::MEM, "debug_abbrev: 0x%" PRIxPTR, abbrev_mem.base);
+  dom->log(rust_log::MEM, "debug_info: 0x%" PRIxPTR, die_mem.base);
+  // For now, perform diagnostics only.
+  dies.dump();
+}
+
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:

src/rt/rust_dom.cpp

@@ -0,0 +1,271 @@
+
+#include <stdarg.h>
+#include "rust_internal.h"
+
+template class ptr_vec<rust_task>;
+
+rust_dom::rust_dom(rust_srv *srv, rust_crate const *root_crate) :
+    interrupt_flag(0),
+    root_crate(root_crate),
+    _log(srv, this),
+    srv(srv),
+    running_tasks(this),
+    blocked_tasks(this),
+    dead_tasks(this),
+    caches(this),
+    root_task(NULL),
+    curr_task(NULL),
+    rval(0)
+{
+    logptr("new dom", (uintptr_t)this);
+    memset(&rctx, 0, sizeof(rctx));
+
+#ifdef __WIN32__
+    {
+        HCRYPTPROV hProv;
+        win32_require
+            (_T("CryptAcquireContext"),
+             CryptAcquireContext(&hProv, NULL, NULL, PROV_RSA_FULL,
+                                 CRYPT_VERIFYCONTEXT|CRYPT_SILENT));
+        win32_require
+            (_T("CryptGenRandom"),
+             CryptGenRandom(hProv, sizeof(rctx.randrsl),
+                            (BYTE*)(&rctx.randrsl)));
+        win32_require
+            (_T("CryptReleaseContext"),
+             CryptReleaseContext(hProv, 0));
+    }
+#else
+    int fd = open("/dev/urandom", O_RDONLY);
+    I(this, fd > 0);
+    I(this, read(fd, (void*) &rctx.randrsl, sizeof(rctx.randrsl))
+      == sizeof(rctx.randrsl));
+    I(this, close(fd) == 0);
+    pthread_attr_init(&attr);
+    pthread_attr_setstacksize(&attr, 1024 * 1024);
+    pthread_attr_setdetachstate(&attr, true);
+#endif
+    randinit(&rctx, 1);
+
+    root_task = new (this) rust_task(this, NULL);
+}
+
+static void
+del_all_tasks(rust_dom *dom, ptr_vec<rust_task> *v) {
+    I(dom, v);
+    while (v->length()) {
+        dom->log(rust_log::TASK, "deleting task %" PRIdPTR, v->length() - 1);
+        delete v->pop();
+    }
+}
+
+rust_dom::~rust_dom() {
+    log(rust_log::TASK, "deleting all running tasks");
+    del_all_tasks(this, &running_tasks);
+    log(rust_log::TASK, "deleting all blocked tasks");
+    del_all_tasks(this, &blocked_tasks);
+    log(rust_log::TASK, "deleting all dead tasks");
+    del_all_tasks(this, &dead_tasks);
+#ifndef __WIN32__
+    pthread_attr_destroy(&attr);
+#endif
+    while (caches.length())
+        delete caches.pop();
+}
+
+void
+rust_dom::activate(rust_task *task) {
+    curr_task = task;
+    root_crate->get_activate_glue()(task);
+    curr_task = NULL;
+}
+
+void
+rust_dom::log(uint32_t type_bits, char const *fmt, ...) {
+    char buf[256];
+    if (_log.is_tracing(type_bits)) {
+        va_list args;
+        va_start(args, fmt);
+        vsnprintf(buf, sizeof(buf), fmt, args);
+        _log.trace_ln(type_bits, buf);
+        va_end(args);
+    }
+}
+
+rust_log &
+rust_dom::get_log() {
+    return _log;
+}
+
+void
+rust_dom::logptr(char const *msg, uintptr_t ptrval) {
+    log(rust_log::MEM, "%s 0x%" PRIxPTR, msg, ptrval);
+}
+
+template<typename T> void
+rust_dom::logptr(char const *msg, T* ptrval) {
+    log(rust_log::MEM, "%s 0x%" PRIxPTR, msg, (uintptr_t)ptrval);
+}
+
+
+void
+rust_dom::fail() {
+    log(rust_log::DOM, "domain 0x%" PRIxPTR " root task failed", this);
+    I(this, rval == 0);
+    rval = 1;
+}
+
+void *
+rust_dom::malloc(size_t sz) {
+    void *p = srv->malloc(sz);
+    I(this, p);
+    log(rust_log::MEM, "rust_dom::malloc(%d) -> 0x%" PRIxPTR,
+        sz, p);
+    return p;
+}
+
+void *
+rust_dom::calloc(size_t sz) {
+    void *p = this->malloc(sz);
+    memset(p, 0, sz);
+    return p;
+}
+
+void *
+rust_dom::realloc(void *p, size_t sz) {
+    void *p1 = srv->realloc(p, sz);
+    I(this, p1);
+    log(rust_log::MEM, "rust_dom::realloc(0x%" PRIxPTR ", %d) -> 0x%" PRIxPTR,
+        p, sz, p1);
+    return p1;
+}
+
+void
+rust_dom::free(void *p) {
+    log(rust_log::MEM, "rust_dom::free(0x%" PRIxPTR ")", p);
+    I(this, p);
+    srv->free(p);
+}
+
+#ifdef __WIN32__
+void
+rust_dom::win32_require(LPCTSTR fn, BOOL ok) {
+    if (!ok) {
+        LPTSTR buf;
+        DWORD err = GetLastError();
+        FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER |
+                      FORMAT_MESSAGE_FROM_SYSTEM |
+                      FORMAT_MESSAGE_IGNORE_INSERTS,
+                      NULL, err,
+                      MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
+                      (LPTSTR) &buf, 0, NULL );
+        log(rust_log::ERR, "%s failed with error %ld: %s", fn, err, buf);
+        LocalFree((HLOCAL)buf);
+        I(this, ok);
+    }
+}
+#endif
+
+size_t
+rust_dom::n_live_tasks()
+{
+    return running_tasks.length() + blocked_tasks.length();
+}
+
+void
+rust_dom::add_task_to_state_vec(ptr_vec<rust_task> *v, rust_task *task)
+{
+    log(rust_log::MEM|rust_log::TASK,
+        "adding task 0x%" PRIxPTR " in state '%s' to vec 0x%" PRIxPTR,
+        (uintptr_t)task, state_vec_name(v), (uintptr_t)v);
+    v->push(task);
+}
+
+
+void
+rust_dom::remove_task_from_state_vec(ptr_vec<rust_task> *v, rust_task *task)
+{
+    log(rust_log::MEM|rust_log::TASK,
+        "removing task 0x%" PRIxPTR " in state '%s' from vec 0x%" PRIxPTR,
+        (uintptr_t)task, state_vec_name(v), (uintptr_t)v);
+    I(this, (*v)[task->idx] == task);
+    v->swapdel(task);
+}
+
+const char *
+rust_dom::state_vec_name(ptr_vec<rust_task> *v)
+{
+    if (v == &running_tasks)
+        return "running";
+    if (v == &blocked_tasks)
+        return "blocked";
+    I(this, v == &dead_tasks);
+    return "dead";
+}
+
+void
+rust_dom::reap_dead_tasks()
+{
+    for (size_t i = 0; i < dead_tasks.length(); ) {
+        rust_task *t = dead_tasks[i];
+        if (t == root_task || t->refcnt == 0) {
+            I(this, !t->waiting_tasks.length());
+            dead_tasks.swapdel(t);
+            log(rust_log::TASK,
+                "deleting unreferenced dead task 0x%" PRIxPTR, t);
+            delete t;
+            continue;
+        }
+        ++i;
+    }
+}
+
+rust_task *
+rust_dom::sched()
+{
+    I(this, this);
+    // FIXME: in the face of failing tasks, this is not always right.
+    // I(this, n_live_tasks() > 0);
+    if (running_tasks.length() > 0) {
+        size_t i = rand(&rctx);
+        i %= running_tasks.length();
+        return (rust_task *)running_tasks[i];
+    }
+    log(rust_log::DOM|rust_log::TASK,
+        "no schedulable tasks");
+    return NULL;
+}
+
+rust_crate_cache *
+rust_dom::get_cache(rust_crate const *crate) {
+    log(rust_log::CACHE,
+        "looking for crate-cache for crate 0x%" PRIxPTR, crate);
+    rust_crate_cache *cache = NULL;
+    for (size_t i = 0; i < caches.length(); ++i) {
+        rust_crate_cache *c = caches[i];
+        if (c->crate == crate) {
+            cache = c;
+            break;
+        }
+    }
+    if (!cache) {
+        log(rust_log::CACHE,
+            "making new crate-cache for crate 0x%" PRIxPTR, crate);
+        cache = new (this) rust_crate_cache(this, crate);
+        caches.push(cache);
+    }
+    cache->ref();
+    return cache;
+}
+
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 70;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//

src/rt/rust_dwarf.h

@@ -0,0 +1,198 @@
+#ifndef RUST_DWARF_H
+#define RUST_DWARF_H
+
+enum
+dw_form
+  {
+    DW_FORM_addr = 0x01,
+    DW_FORM_block2 = 0x03,
+    DW_FORM_block4 = 0x04,
+    DW_FORM_data2 = 0x05,
+    DW_FORM_data4 = 0x06,
+    DW_FORM_data8 = 0x07,
+    DW_FORM_string = 0x08,
+    DW_FORM_block = 0x09,
+    DW_FORM_block1 = 0x0a,
+    DW_FORM_data1 = 0x0b,
+    DW_FORM_flag = 0x0c,
+    DW_FORM_sdata = 0x0d,
+    DW_FORM_strp = 0x0e,
+    DW_FORM_udata = 0x0f,
+    DW_FORM_ref_addr = 0x10,
+    DW_FORM_ref1 = 0x11,
+    DW_FORM_ref2 = 0x12,
+    DW_FORM_ref4 = 0x13,
+    DW_FORM_ref8 = 0x14,
+    DW_FORM_ref_udata = 0x15,
+    DW_FORM_indirect = 0x16
+  };
+
+enum
+dw_at
+  {
+    DW_AT_sibling = 0x01,
+    DW_AT_location = 0x02,
+    DW_AT_name = 0x03,
+    DW_AT_ordering = 0x09,
+    DW_AT_byte_size = 0x0b,
+    DW_AT_bit_offset = 0x0c,
+    DW_AT_bit_size = 0x0d,
+    DW_AT_stmt_list = 0x10,
+    DW_AT_low_pc = 0x11,
+    DW_AT_high_pc = 0x12,
+    DW_AT_language = 0x13,
+    DW_AT_discr = 0x15,
+    DW_AT_discr_value = 0x16,
+    DW_AT_visibility = 0x17,
+    DW_AT_import = 0x18,
+    DW_AT_string_length = 0x19,
+    DW_AT_common_reference = 0x1a,
+    DW_AT_comp_dir = 0x1b,
+    DW_AT_const_value = 0x1c,
+    DW_AT_containing_type = 0x1d,
+    DW_AT_default_value = 0x1e,
+    DW_AT_inline = 0x20,
+    DW_AT_is_optional = 0x21,
+    DW_AT_lower_bound = 0x22,
+    DW_AT_producer = 0x25,
+    DW_AT_prototyped = 0x27,
+    DW_AT_return_addr = 0x2a,
+    DW_AT_start_scope = 0x2c,
+    DW_AT_bit_stride = 0x2e,
+    DW_AT_upper_bound = 0x2f,
+    DW_AT_abstract_origin = 0x31,
+    DW_AT_accessibility = 0x32,
+    DW_AT_address_class = 0x33,
+    DW_AT_artificial = 0x34,
+    DW_AT_base_types = 0x35,
+    DW_AT_calling_convention = 0x36,
+    DW_AT_count = 0x37,
+    DW_AT_data_member_location = 0x38,
+    DW_AT_decl_column = 0x39,
+    DW_AT_decl_file = 0x3a,
+    DW_AT_decl_line = 0x3b,
+    DW_AT_declaration = 0x3c,
+    DW_AT_discr_list = 0x3d,
+    DW_AT_encoding = 0x3e,
+    DW_AT_external = 0x3f,
+    DW_AT_frame_base = 0x40,
+    DW_AT_friend = 0x41,
+    DW_AT_identifier_case = 0x42,
+    DW_AT_macro_info = 0x43,
+    DW_AT_namelist_item = 0x44,
+    DW_AT_priority = 0x45,
+    DW_AT_segment = 0x46,
+    DW_AT_specification = 0x47,
+    DW_AT_static_link = 0x48,
+    DW_AT_type = 0x49,
+    DW_AT_use_location = 0x4a,
+    DW_AT_variable_parameter = 0x4b,
+    DW_AT_virtuality = 0x4c,
+    DW_AT_vtable_elem_location = 0x4d,
+    DW_AT_allocated = 0x4e,
+    DW_AT_associated = 0x4f,
+    DW_AT_data_location = 0x50,
+    DW_AT_byte_stride = 0x51,
+    DW_AT_entry_pc = 0x52,
+    DW_AT_use_UTF8 = 0x53,
+    DW_AT_extension = 0x54,
+    DW_AT_ranges = 0x55,
+    DW_AT_trampoline = 0x56,
+    DW_AT_call_column = 0x57,
+    DW_AT_call_file = 0x58,
+    DW_AT_call_line = 0x59,
+    DW_AT_description = 0x5a,
+    DW_AT_binary_scale = 0x5b,
+    DW_AT_decimal_scale = 0x5c,
+    DW_AT_small = 0x5d,
+    DW_AT_decimal_sign = 0x5e,
+    DW_AT_digit_count = 0x5f,
+    DW_AT_picture_string = 0x60,
+    DW_AT_mutable = 0x61,
+    DW_AT_threads_scaled = 0x62,
+    DW_AT_explicit = 0x63,
+    DW_AT_object_pointer = 0x64,
+    DW_AT_endianity = 0x65,
+    DW_AT_elemental = 0x66,
+    DW_AT_pure = 0x67,
+    DW_AT_recursive = 0x68,
+    DW_AT_lo_user = 0x2000,
+    DW_AT_hi_user = 0x3fff
+};
+
+enum
+dw_tag
+  {
+    DW_TAG_array_type = 0x01,
+    DW_TAG_class_type = 0x02,
+    DW_TAG_entry_point = 0x03,
+    DW_TAG_enumeration_type = 0x04,
+    DW_TAG_formal_parameter = 0x05,
+    DW_TAG_imported_declaration = 0x08,
+    DW_TAG_label = 0x0a,
+    DW_TAG_lexical_block = 0x0b,
+    DW_TAG_member = 0x0d,
+    DW_TAG_pointer_type = 0x0f,
+    DW_TAG_reference_type = 0x10,
+    DW_TAG_compile_unit = 0x11,
+    DW_TAG_string_type = 0x12,
+    DW_TAG_structure_type = 0x13,
+    DW_TAG_subroutine_type = 0x15,
+    DW_TAG_typedef = 0x16,
+    DW_TAG_union_type = 0x17,
+    DW_TAG_unspecified_parameters = 0x18,
+    DW_TAG_variant = 0x19,
+    DW_TAG_common_block = 0x1a,
+    DW_TAG_common_inclusion = 0x1b,
+    DW_TAG_inheritance = 0x1c,
+    DW_TAG_inlined_subroutine = 0x1d,
+    DW_TAG_module = 0x1e,
+    DW_TAG_ptr_to_member_type = 0x1f,
+    DW_TAG_set_type = 0x20,
+    DW_TAG_subrange_type = 0x21,
+    DW_TAG_with_stmt = 0x22,
+    DW_TAG_access_declaration = 0x23,
+    DW_TAG_base_type = 0x24,
+    DW_TAG_catch_block = 0x25,
+    DW_TAG_const_type = 0x26,
+    DW_TAG_constant = 0x27,
+    DW_TAG_enumerator = 0x28,
+    DW_TAG_file_type = 0x29,
+    DW_TAG_friend = 0x2a,
+    DW_TAG_namelist = 0x2b,
+    DW_TAG_namelist_item = 0x2c,
+    DW_TAG_packed_type = 0x2d,
+    DW_TAG_subprogram = 0x2e,
+    DW_TAG_template_type_parameter = 0x2f,
+    DW_TAG_template_value_parameter = 0x30,
+    DW_TAG_thrown_type = 0x31,
+    DW_TAG_try_block = 0x32,
+    DW_TAG_variant_part = 0x33,
+    DW_TAG_variable = 0x34,
+    DW_TAG_volatile_type = 0x35,
+    DW_TAG_dwarf_procedure = 0x36,
+    DW_TAG_restrict_type = 0x37,
+    DW_TAG_interface_type = 0x38,
+    DW_TAG_namespace = 0x39,
+    DW_TAG_imported_module = 0x3a,
+    DW_TAG_unspecified_type = 0x3b,
+    DW_TAG_partial_unit = 0x3c,
+    DW_TAG_imported_unit = 0x3d,
+    DW_TAG_condition = 0x3f,
+    DW_TAG_shared_type = 0x40,
+    DW_TAG_lo_user = 0x4080,
+    DW_TAG_hi_user = 0xffff,
+  };
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//
+
+#endif

src/rt/rust_internal.h

@@ -0,0 +1,730 @@
+#ifndef RUST_INTERNAL_H
+#define RUST_INTERNAL_H
+
+#define __STDC_LIMIT_MACROS 1
+#define __STDC_CONSTANT_MACROS 1
+#define __STDC_FORMAT_MACROS 1
+
+#include <stdlib.h>
+#include <stdint.h>
+#include <inttypes.h>
+
+#include <stdio.h>
+#include <string.h>
+
+#include "rust.h"
+
+#include "rand.h"
+#include "rust_log.h"
+#include "uthash.h"
+
+#if defined(__WIN32__)
+extern "C" {
+#include <windows.h>
+#include <tchar.h>
+#include <wincrypt.h>
+}
+#elif defined(__GNUC__)
+#include <unistd.h>
+#include <sys/types.h>
+#include <sys/stat.h>
+#include <fcntl.h>
+#include <dlfcn.h>
+#include <pthread.h>
+#include <errno.h>
+#else
+#error "Platform not supported."
+#endif
+
+#ifndef __i386__
+#error "Target CPU not supported."
+#endif
+
+#define I(dom, e) ((e) ? (void)0 :                              \
+                   (dom)->srv->fatal(#e, __FILE__, __LINE__))
+
+struct rust_task;
+struct rust_port;
+class rust_chan;
+struct rust_token;
+struct rust_dom;
+class rust_crate;
+class rust_crate_cache;
+class lockfree_queue;
+
+struct stk_seg;
+struct type_desc;
+struct frame_glue_fns;
+
+// This drives our preemption scheme.
+
+static size_t const TIME_SLICE_IN_MS = 10;
+
+// Every reference counted object should derive from this base class.
+
+template <typename T>
+struct
+rc_base
+{
+    size_t refcnt;
+
+    void ref() {
+        ++refcnt;
+    }
+
+    void deref() {
+        if (--refcnt == 0) {
+            delete (T*)this;
+        }
+    }
+
+  rc_base();
+  ~rc_base();
+};
+
+template <typename T>
+struct
+dom_owned
+{
+    void operator delete(void *ptr) {
+        ((T *)ptr)->dom->free(ptr);
+    }
+};
+
+template <typename T>
+struct
+task_owned
+{
+    void operator delete(void *ptr) {
+        ((T *)ptr)->task->dom->free(ptr);
+    }
+};
+
+
+// Helper class used regularly elsewhere.
+
+template <typename T>
+class
+ptr_vec : public dom_owned<ptr_vec<T> >
+{
+    static const size_t INIT_SIZE = 8;
+
+    rust_dom *dom;
+    size_t alloc;
+    size_t fill;
+    T **data;
+
+public:
+    ptr_vec(rust_dom *dom);
+    ~ptr_vec();
+
+    size_t length() {
+        return fill;
+    }
+
+    T *& operator[](size_t offset);
+    void push(T *p);
+    T *pop();
+    void trim(size_t fill);
+    void swapdel(T* p);
+};
+
+struct
+rust_dom
+{
+    // Fields known to the compiler:
+    uintptr_t interrupt_flag;
+
+    // Fields known only by the runtime:
+
+    // NB: the root crate must remain in memory until the root of the
+    // tree of domains exits. All domains within this tree have a
+    // copy of this root_crate value and use it for finding utility
+    // glue.
+    rust_crate const *root_crate;
+    rust_log _log;
+    rust_srv *srv;
+    // uint32_t logbits;
+    ptr_vec<rust_task> running_tasks;
+    ptr_vec<rust_task> blocked_tasks;
+    ptr_vec<rust_task> dead_tasks;
+    ptr_vec<rust_crate_cache> caches;
+    randctx rctx;
+    rust_task *root_task;
+    rust_task *curr_task;
+    int rval;
+    lockfree_queue *incoming; // incoming messages from other threads
+
+#ifndef __WIN32__
+    pthread_attr_t attr;
+#endif
+
+    rust_dom(rust_srv *srv, rust_crate const *root_crate);
+    ~rust_dom();
+
+    void activate(rust_task *task);
+    void log(uint32_t logbit, char const *fmt, ...);
+    rust_log & get_log();
+    void logptr(char const *msg, uintptr_t ptrval);
+    template<typename T>
+    void logptr(char const *msg, T* ptrval);
+    void fail();
+    void *malloc(size_t sz);
+    void *calloc(size_t sz);
+    void *realloc(void *data, size_t sz);
+    void free(void *p);
+
+#ifdef __WIN32__
+    void win32_require(LPCTSTR fn, BOOL ok);
+#endif
+
+    rust_crate_cache *get_cache(rust_crate const *crate);
+    size_t n_live_tasks();
+    void add_task_to_state_vec(ptr_vec<rust_task> *v, rust_task *task);
+    void remove_task_from_state_vec(ptr_vec<rust_task> *v, rust_task *task);
+    const char *state_vec_name(ptr_vec<rust_task> *v);
+
+    void reap_dead_tasks();
+    rust_task *sched();
+};
+
+inline void *operator new(size_t sz, void *mem) {
+    return mem;
+}
+
+inline void *operator new(size_t sz, rust_dom *dom) {
+    return dom->malloc(sz);
+}
+
+inline void *operator new[](size_t sz, rust_dom *dom) {
+    return dom->malloc(sz);
+}
+
+inline void *operator new(size_t sz, rust_dom &dom) {
+    return dom.malloc(sz);
+}
+
+inline void *operator new[](size_t sz, rust_dom &dom) {
+    return dom.malloc(sz);
+}
+
+struct
+rust_timer
+{
+    // FIXME: This will probably eventually need replacement
+    // with something more sophisticated and integrated with
+    // an IO event-handling library, when we have such a thing.
+    // For now it's just the most basic "thread that can interrupt
+    // its associated domain-thread" device, so that we have
+    // *some* form of task-preemption.
+    rust_dom &dom;
+    uintptr_t exit_flag;
+
+#if defined(__WIN32__)
+    HANDLE thread;
+#else
+    pthread_attr_t attr;
+    pthread_t thread;
+#endif
+
+    rust_timer(rust_dom &dom);
+    ~rust_timer();
+};
+
+#include "rust_util.h"
+
+// Crates.
+
+template<typename T> T*
+crate_rel(rust_crate const *crate, T *t) {
+    return (T*)(((uintptr_t)crate) + ((ptrdiff_t)t));
+}
+
+template<typename T> T const*
+crate_rel(rust_crate const *crate, T const *t) {
+    return (T const*)(((uintptr_t)crate) + ((ptrdiff_t)t));
+}
+
+typedef void CDECL (*activate_glue_ty)(rust_task *);
+
+class
+rust_crate
+{
+    // The following fields are emitted by the compiler for the static
+    // rust_crate object inside each compiled crate.
+
+    ptrdiff_t image_base_off;     // (Loaded image base) - this.
+    uintptr_t self_addr;          // Un-relocated addres of 'this'.
+
+    ptrdiff_t debug_abbrev_off;   // Offset from this to .debug_abbrev.
+    size_t debug_abbrev_sz;       // Size of .debug_abbrev.
+
+    ptrdiff_t debug_info_off;     // Offset from this to .debug_info.
+    size_t debug_info_sz;         // Size of .debug_info.
+
+    ptrdiff_t activate_glue_off;
+    ptrdiff_t exit_task_glue_off;
+    ptrdiff_t unwind_glue_off;
+    ptrdiff_t yield_glue_off;
+
+public:
+
+    size_t n_rust_syms;
+    size_t n_c_syms;
+    size_t n_libs;
+
+    // Crates are immutable, constructed by the compiler.
+
+    uintptr_t get_image_base() const;
+    ptrdiff_t get_relocation_diff() const;
+    activate_glue_ty get_activate_glue() const;
+    uintptr_t get_exit_task_glue() const;
+    uintptr_t get_unwind_glue() const;
+    uintptr_t get_yield_glue() const;
+    struct mem_area
+    {
+      rust_dom *dom;
+      uintptr_t base;
+      uintptr_t lim;
+      mem_area(rust_dom *dom, uintptr_t pos, size_t sz);
+    };
+
+    mem_area get_debug_info(rust_dom *dom) const;
+    mem_area get_debug_abbrev(rust_dom *dom) const;
+};
+
+
+struct type_desc {
+    // First part of type_desc is known to compiler.
+    // first_param = &descs[1] if dynamic, null if static.
+    const type_desc **first_param;
+    size_t size;
+    size_t align;
+    uintptr_t copy_glue_off;
+    uintptr_t drop_glue_off;
+    uintptr_t free_glue_off;
+    uintptr_t mark_glue_off;     // For GC.
+    uintptr_t obj_drop_glue_off; // For custom destructors.
+
+    // Residual fields past here are known only to runtime.
+    UT_hash_handle hh;
+    size_t n_descs;
+    const type_desc *descs[];
+};
+
+class
+rust_crate_cache : public dom_owned<rust_crate_cache>,
+                   public rc_base<rust_crate_cache>
+{
+public:
+    class lib :
+        public rc_base<lib>, public dom_owned<lib>
+    {
+        uintptr_t handle;
+    public:
+        rust_dom *dom;
+        lib(rust_dom *dom, char const *name);
+        uintptr_t get_handle();
+        ~lib();
+    };
+
+    class c_sym :
+        public rc_base<c_sym>, public dom_owned<c_sym>
+    {
+        uintptr_t val;
+        lib *library;
+    public:
+        rust_dom *dom;
+        c_sym(rust_dom *dom, lib *library, char const *name);
+        uintptr_t get_val();
+        ~c_sym();
+    };
+
+    class rust_sym :
+        public rc_base<rust_sym>, public dom_owned<rust_sym>
+    {
+        uintptr_t val;
+        c_sym *crate_sym;
+    public:
+        rust_dom *dom;
+        rust_sym(rust_dom *dom, rust_crate const *curr_crate,
+                 c_sym *crate_sym, char const **path);
+        uintptr_t get_val();
+        ~rust_sym();
+    };
+
+    lib *get_lib(size_t n, char const *name);
+    c_sym *get_c_sym(size_t n, lib *library, char const *name);
+    rust_sym *get_rust_sym(size_t n,
+                           rust_dom *dom,
+                           rust_crate const *curr_crate,
+                           c_sym *crate_sym,
+                           char const **path);
+    type_desc *get_type_desc(size_t size,
+                             size_t align,
+                             size_t n_descs,
+                             type_desc const **descs);
+
+private:
+
+    rust_sym **rust_syms;
+    c_sym **c_syms;
+    lib **libs;
+    type_desc *type_descs;
+
+public:
+
+    rust_crate const *crate;
+    rust_dom *dom;
+    size_t idx;
+
+    rust_crate_cache(rust_dom *dom,
+                     rust_crate const *crate);
+    ~rust_crate_cache();
+    void flush();
+};
+
+#include "rust_dwarf.h"
+
+class
+rust_crate_reader
+{
+    struct mem_reader
+    {
+        rust_crate::mem_area &mem;
+        bool ok;
+        uintptr_t pos;
+
+        bool is_ok();
+        bool at_end();
+        void fail();
+        void reset();
+        mem_reader(rust_crate::mem_area &m);
+        size_t tell_abs();
+        size_t tell_off();
+        void seek_abs(uintptr_t p);
+        void seek_off(uintptr_t p);
+
+        template<typename T>
+        void get(T &out) {
+            if (pos < mem.base
+                || pos >= mem.lim
+                || pos + sizeof(T) > mem.lim)
+                ok = false;
+            if (!ok)
+                return;
+            out = *((T*)(pos));
+            pos += sizeof(T);
+            ok &= !at_end();
+            I(mem.dom, at_end() || (mem.base <= pos && pos < mem.lim));
+        }
+
+        template<typename T>
+        void get_uleb(T &out) {
+            out = T(0);
+            for (size_t i = 0; i < sizeof(T) && ok; ++i) {
+                uint8_t byte;
+                get(byte);
+                out <<= 7;
+                out |= byte & 0x7f;
+                if (!(byte & 0x80))
+                    break;
+            }
+            I(mem.dom, at_end() || (mem.base <= pos && pos < mem.lim));
+        }
+
+        template<typename T>
+        void adv_sizeof(T &) {
+            adv(sizeof(T));
+        }
+
+        bool adv_zstr(size_t sz);
+        bool get_zstr(char const *&c, size_t &sz);
+        void adv(size_t amt);
+    };
+
+    struct
+    abbrev : dom_owned<abbrev>
+    {
+        rust_dom *dom;
+        uintptr_t body_off;
+        size_t body_sz;
+        uintptr_t tag;
+        uint8_t has_children;
+        size_t idx;
+        abbrev(rust_dom *dom, uintptr_t body_off, size_t body_sz,
+               uintptr_t tag, uint8_t has_children);
+    };
+
+    class
+    abbrev_reader : public mem_reader
+    {
+        ptr_vec<abbrev> abbrevs;
+    public:
+        abbrev_reader(rust_crate::mem_area &abbrev_mem);
+        abbrev *get_abbrev(size_t i);
+        bool step_attr_form_pair(uintptr_t &attr, uintptr_t &form);
+        ~abbrev_reader();
+    };
+
+    rust_dom *dom;
+    size_t idx;
+    rust_crate const *crate;
+
+    rust_crate::mem_area abbrev_mem;
+    abbrev_reader abbrevs;
+
+    rust_crate::mem_area die_mem;
+
+public:
+
+    struct
+    attr
+    {
+        dw_form form;
+        dw_at at;
+        union {
+            struct {
+                char const *s;
+                size_t sz;
+            } str;
+            uintptr_t num;
+        } val;
+
+        bool is_numeric() const;
+        bool is_string() const;
+        size_t get_ssz(rust_dom *dom) const;
+        char const *get_str(rust_dom *dom) const;
+        uintptr_t get_num(rust_dom *dom) const;
+        bool is_unknown() const;
+    };
+
+    struct die_reader;
+
+    struct
+    die
+    {
+        die_reader *rdr;
+        uintptr_t off;
+        abbrev *ab;
+        bool using_rdr;
+
+        die(die_reader *rdr, uintptr_t off);
+        bool is_null() const;
+        bool has_children() const;
+        dw_tag tag() const;
+        bool start_attrs() const;
+        bool step_attr(attr &a) const;
+        bool find_str_attr(dw_at at, char const *&c);
+        bool find_num_attr(dw_at at, uintptr_t &n);
+        bool is_transparent();
+        bool find_child_by_name(char const *c, die &child,
+                                bool exact=false);
+        bool find_child_by_tag(dw_tag tag, die &child);
+        die next() const;
+        die next_sibling() const;
+    };
+
+    struct
+    rdr_sess
+    {
+        die_reader *rdr;
+        rdr_sess(die_reader *rdr);
+        ~rdr_sess();
+    };
+
+    struct
+    die_reader : public mem_reader
+    {
+        abbrev_reader &abbrevs;
+        uint32_t cu_unit_length;
+        uintptr_t cu_base;
+        uint16_t dwarf_vers;
+        uint32_t cu_abbrev_off;
+        uint8_t sizeof_addr;
+        bool in_use;
+
+        die first_die();
+        void dump();
+        die_reader(rust_crate::mem_area &die_mem,
+                   abbrev_reader &abbrevs);
+        ~die_reader();
+    };
+    die_reader dies;
+    rust_crate_reader(rust_dom *dom, rust_crate const *crate);
+};
+
+
+// A cond(ition) is something we can block on. This can be a channel
+// (writing), a port (reading) or a task (waiting).
+
+struct
+rust_cond
+{
+};
+
+// An alarm can be put into a wait queue and the task will be notified
+// when the wait queue is flushed.
+
+struct
+rust_alarm
+{
+    rust_task *receiver;
+    size_t idx;
+
+    rust_alarm(rust_task *receiver);
+};
+
+
+typedef ptr_vec<rust_alarm> rust_wait_queue;
+
+
+struct stk_seg {
+    unsigned int valgrind_id;
+    uintptr_t limit;
+    uint8_t data[];
+};
+
+struct frame_glue_fns {
+    uintptr_t mark_glue_off;
+    uintptr_t drop_glue_off;
+    uintptr_t reloc_glue_off;
+};
+
+struct
+rust_task : public rc_base<rust_task>,
+            public dom_owned<rust_task>,
+            public rust_cond
+{
+    // Fields known to the compiler.
+    stk_seg *stk;
+    uintptr_t runtime_sp;      // Runtime sp while task running.
+    uintptr_t rust_sp;         // Saved sp when not running.
+    uintptr_t gc_alloc_chain;  // Linked list of GC allocations.
+    rust_dom *dom;
+    rust_crate_cache *cache;
+
+    // Fields known only to the runtime.
+    ptr_vec<rust_task> *state;
+    rust_cond *cond;
+    uintptr_t* dptr;           // Rendezvous pointer for send/recv.
+    rust_task *spawner;        // Parent-link.
+    size_t idx;
+
+    // Wait queue for tasks waiting for this task.
+    rust_wait_queue waiting_tasks;
+    rust_alarm alarm;
+
+    rust_task(rust_dom *dom,
+              rust_task *spawner);
+    ~rust_task();
+
+    void start(uintptr_t exit_task_glue,
+               uintptr_t spawnee_fn,
+               uintptr_t args,
+               size_t callsz);
+    void grow(size_t n_frame_bytes);
+    bool running();
+    bool blocked();
+    bool blocked_on(rust_cond *cond);
+    bool dead();
+
+    const char *state_str();
+    void transition(ptr_vec<rust_task> *svec, ptr_vec<rust_task> *dvec);
+
+    void block(rust_cond *on);
+    void wakeup(rust_cond *from);
+    void die();
+    void unblock();
+
+    void check_active() { I(dom, dom->curr_task == this); }
+    void check_suspended() { I(dom, dom->curr_task != this); }
+
+    // Swap in some glue code to run when we have returned to the
+    // task's context (assuming we're the active task).
+    void run_after_return(size_t nargs, uintptr_t glue);
+
+    // Swap in some glue code to run when we're next activated
+    // (assuming we're the suspended task).
+    void run_on_resume(uintptr_t glue);
+
+    // Save callee-saved registers and return to the main loop.
+    void yield(size_t nargs);
+
+    // Fail this task (assuming caller-on-stack is different task).
+    void kill();
+
+    // Fail self, assuming caller-on-stack is this task.
+    void fail(size_t nargs);
+
+    // Notify tasks waiting for us that we are about to die.
+    void notify_waiting_tasks();
+
+    uintptr_t get_fp();
+    uintptr_t get_previous_fp(uintptr_t fp);
+    frame_glue_fns *get_frame_glue_fns(uintptr_t fp);
+    rust_crate_cache * get_crate_cache(rust_crate const *curr_crate);
+};
+
+struct rust_port : public rc_base<rust_port>,
+                   public task_owned<rust_port>,
+                   public rust_cond {
+    rust_task *task;
+    size_t unit_sz;
+    ptr_vec<rust_token> writers;
+    ptr_vec<rust_chan> chans;
+
+    rust_port(rust_task *task, size_t unit_sz);
+    ~rust_port();
+};
+
+struct rust_token : public rust_cond {
+    rust_chan *chan;      // Link back to the channel this token belongs to
+    size_t idx;           // Index into port->writers.
+    bool submitted;       // Whether token is in a port->writers.
+
+    rust_token(rust_chan *chan);
+    ~rust_token();
+
+    bool pending() const;
+    void submit();
+    void withdraw();
+};
+
+
+struct circ_buf : public dom_owned<circ_buf> {
+    static const size_t INIT_CIRC_BUF_UNITS = 8;
+    static const size_t MAX_CIRC_BUF_SIZE = 1 << 24;
+
+    rust_dom *dom;
+    size_t alloc;
+    size_t unit_sz;
+    size_t next;
+    size_t unread;
+    uint8_t *data;
+
+    circ_buf(rust_dom *dom, size_t unit_sz);
+    ~circ_buf();
+
+    void transfer(void *dst);
+    void push(void *src);
+    void shift(void *dst);
+};
+
+#include "rust_chan.h"
+
+int
+rust_main_loop(rust_dom *dom);
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//
+
+#endif

src/rt/rust_log.cpp

@@ -0,0 +1,117 @@
+/*
+ * Logging infrastructure that aims to support multi-threading, indentation
+ * and ansi colors.
+ */
+
+#include "rust_internal.h"
+
+static uint32_t read_type_bit_mask() {
+    uint32_t bits = rust_log::ULOG | rust_log::ERR;
+    char *env_str = getenv("RUST_LOG");
+    if (env_str) {
+        bits = 0;
+        bits |= strstr(env_str, "err") ? rust_log::ERR : 0;
+        bits |= strstr(env_str, "mem") ? rust_log::MEM : 0;
+        bits |= strstr(env_str, "comm") ? rust_log::COMM : 0;
+        bits |= strstr(env_str, "task") ? rust_log::TASK : 0;
+        bits |= strstr(env_str, "up") ? rust_log::UPCALL : 0;
+        bits |= strstr(env_str, "dom") ? rust_log::DOM : 0;
+        bits |= strstr(env_str, "ulog") ? rust_log::ULOG : 0;
+        bits |= strstr(env_str, "trace") ? rust_log::TRACE : 0;
+        bits |= strstr(env_str, "dwarf") ? rust_log::DWARF : 0;
+        bits |= strstr(env_str, "cache") ? rust_log::CACHE : 0;
+        bits |= strstr(env_str, "timer") ? rust_log::TIMER : 0;
+        bits |= strstr(env_str, "all") ? rust_log::ALL : 0;
+    }
+    return bits;
+}
+
+rust_log::ansi_color rust_log::get_type_color(log_type type) {
+    switch (type) {
+    case ERR:
+        return rust_log::RED;
+    case UPCALL:
+        return rust_log::GREEN;
+    case COMM:
+        return rust_log::MAGENTA;
+    case DOM:
+    case TASK:
+        return rust_log::LIGHTTEAL;
+    case MEM:
+        return rust_log::YELLOW;
+    default:
+        return rust_log::WHITE;
+    }
+}
+
+static const char * _foreground_colors[] = { "[30m", "[1;30m", "[37m",
+                                             "[31m", "[1;31m", "[32m",
+                                             "[1;32m", "[33m", "[33m",
+                                             "[34m", "[1;34m", "[35m",
+                                             "[1;35m", "[36m", "[1;36m" };
+rust_log::rust_log(rust_srv *srv, rust_dom *dom) :
+    _srv(srv), _dom(dom), _type_bit_mask(read_type_bit_mask()),
+            _use_colors(getenv("RUST_COLOR_LOG")), _indent(0) {
+}
+
+rust_log::~rust_log() {
+
+}
+
+void rust_log::trace_ln(char *message) {
+    char buffer[512];
+    if (_use_colors) {
+        snprintf(buffer, sizeof(buffer), "\x1b%s0x%08" PRIxPTR "\x1b[0m: ",
+                 _foreground_colors[1 + ((uintptr_t) _dom % 2687 % (LIGHTTEAL
+                         - 1))], (uintptr_t) _dom);
+    } else {
+        snprintf(buffer, sizeof(buffer), "0x%08" PRIxPTR ": ",
+                 (uintptr_t) _dom);
+    }
+
+    for (uint32_t i = 0; i < _indent; i++) {
+        strncat(buffer, "\t", sizeof(buffer) - strlen(buffer) - 1);
+    }
+    strncat(buffer, message, sizeof(buffer) - strlen(buffer) - 1);
+    _srv->log(buffer);
+}
+
+/**
+ * Traces a log message if the specified logging type is not filtered.
+ */
+void rust_log::trace_ln(uint32_t type_bits, char *message) {
+    trace_ln(get_type_color((rust_log::log_type) type_bits), type_bits,
+             message);
+}
+
+/**
+ * Traces a log message using the specified ANSI color code.
+ */
+void rust_log::trace_ln(ansi_color color, uint32_t type_bits, char *message) {
+    if (is_tracing(type_bits)) {
+        if (_use_colors) {
+            char buffer[512];
+            snprintf(buffer, sizeof(buffer), "\x1b%s%s\x1b[0m",
+                     _foreground_colors[color], message);
+            trace_ln(buffer);
+        } else {
+            trace_ln(message);
+        }
+    }
+}
+
+bool rust_log::is_tracing(uint32_t type_bits) {
+    return type_bits & _type_bit_mask;
+}
+
+void rust_log::indent() {
+    _indent++;
+}
+
+void rust_log::outdent() {
+    _indent--;
+}
+
+void rust_log::reset_indent(uint32_t indent) {
+    _indent = indent;
+}

src/rt/rust_log.h

@@ -0,0 +1,59 @@
+#ifndef RUST_LOG_H_
+#define RUST_LOG_H_
+
+class rust_dom;
+
+class rust_log {
+    rust_srv *_srv;
+    rust_dom *_dom;
+    uint32_t _type_bit_mask;
+    bool _use_colors;
+    uint32_t _indent;
+    void trace_ln(char *message);
+public:
+    rust_log(rust_srv *srv, rust_dom *dom);
+    virtual ~rust_log();
+
+    enum ansi_color {
+        BLACK,
+        GRAY,
+        WHITE,
+        RED,
+        LIGHTRED,
+        GREEN,
+        LIGHTGREEN,
+        YELLOW,
+        LIGHTYELLOW,
+        BLUE,
+        LIGHTBLUE,
+        MAGENTA,
+        LIGHTMAGENTA,
+        TEAL,
+        LIGHTTEAL
+    };
+
+    enum log_type {
+        ERR = 0x1,
+        MEM = 0x2,
+        COMM = 0x4,
+        TASK = 0x8,
+        DOM = 0x10,
+        ULOG = 0x20,
+        TRACE = 0x40,
+        DWARF = 0x80,
+        CACHE = 0x100,
+        UPCALL = 0x200,
+        TIMER = 0x400,
+        ALL = 0xffffffff
+    };
+
+    void indent();
+    void outdent();
+    void reset_indent(uint32_t indent);
+    void trace_ln(uint32_t type_bits, char *message);
+    void trace_ln(ansi_color color, uint32_t type_bits, char *message);
+    bool is_tracing(uint32_t type_bits);
+    static ansi_color get_type_color(log_type type);
+};
+
+#endif /* RUST_LOG_H_ */

src/rt/rust_task.cpp

@@ -0,0 +1,474 @@
+
+#include "rust_internal.h"
+
+#include "valgrind.h"
+#include "memcheck.h"
+
+// Stacks
+
+static size_t const min_stk_bytes = 0x300;
+
+// Task stack segments. Heap allocated and chained together.
+
+static stk_seg*
+new_stk(rust_dom *dom, size_t minsz)
+{
+    if (minsz < min_stk_bytes)
+        minsz = min_stk_bytes;
+    size_t sz = sizeof(stk_seg) + minsz;
+    stk_seg *stk = (stk_seg *)dom->malloc(sz);
+    dom->logptr("new stk", (uintptr_t)stk);
+    memset(stk, 0, sizeof(stk_seg));
+    stk->limit = (uintptr_t) &stk->data[minsz];
+    dom->logptr("stk limit", stk->limit);
+    stk->valgrind_id =
+        VALGRIND_STACK_REGISTER(&stk->data[0],
+                                &stk->data[minsz]);
+    return stk;
+}
+
+static void
+del_stk(rust_dom *dom, stk_seg *stk)
+{
+    VALGRIND_STACK_DEREGISTER(stk->valgrind_id);
+    dom->logptr("freeing stk segment", (uintptr_t)stk);
+    dom->free(stk);
+}
+
+// Tasks
+
+// FIXME (issue #31): ifdef by platform. This is getting absurdly
+// x86-specific.
+
+size_t const n_callee_saves = 4;
+size_t const callee_save_fp = 0;
+
+static uintptr_t
+align_down(uintptr_t sp)
+{
+    // There is no platform we care about that needs more than a
+    // 16-byte alignment.
+    return sp & ~(16 - 1);
+}
+
+
+rust_task::rust_task(rust_dom *dom, rust_task *spawner) :
+    stk(new_stk(dom, 0)),
+    runtime_sp(0),
+    rust_sp(stk->limit),
+    gc_alloc_chain(0),
+    dom(dom),
+    cache(NULL),
+    state(&dom->running_tasks),
+    cond(NULL),
+    dptr(0),
+    spawner(spawner),
+    idx(0),
+    waiting_tasks(dom),
+    alarm(this)
+{
+    dom->logptr("new task", (uintptr_t)this);
+}
+
+rust_task::~rust_task()
+{
+    dom->log(rust_log::MEM|rust_log::TASK,
+             "~rust_task 0x%" PRIxPTR ", refcnt=%d",
+             (uintptr_t)this, refcnt);
+
+    /*
+      for (uintptr_t fp = get_fp(); fp; fp = get_previous_fp(fp)) {
+      frame_glue_fns *glue_fns = get_frame_glue_fns(fp);
+      dom->log(rust_log::MEM|rust_log::TASK,
+      "~rust_task, frame fp=0x%" PRIxPTR ", glue_fns=0x%" PRIxPTR,
+      fp, glue_fns);
+      if (glue_fns) {
+      dom->log(rust_log::MEM|rust_log::TASK,
+               "~rust_task, mark_glue=0x%" PRIxPTR,
+               glue_fns->mark_glue);
+      dom->log(rust_log::MEM|rust_log::TASK,
+               "~rust_task, drop_glue=0x%" PRIxPTR,
+               glue_fns->drop_glue);
+      dom->log(rust_log::MEM|rust_log::TASK,
+               "~rust_task, reloc_glue=0x%" PRIxPTR,
+               glue_fns->reloc_glue);
+      }
+      }
+    */
+
+    /* FIXME: tighten this up, there are some more
+       assertions that hold at task-lifecycle events. */
+    I(dom, refcnt == 0 ||
+      (refcnt == 1 && this == dom->root_task));
+
+    del_stk(dom, stk);
+    if (cache)
+        cache->deref();
+}
+
+void
+rust_task::start(uintptr_t exit_task_glue,
+                 uintptr_t spawnee_fn,
+                 uintptr_t args,
+                 size_t callsz)
+{
+    dom->logptr("exit-task glue", exit_task_glue);
+    dom->logptr("from spawnee", spawnee_fn);
+
+    // Set sp to last uintptr_t-sized cell of segment and align down.
+    rust_sp -= sizeof(uintptr_t);
+    rust_sp = align_down(rust_sp);
+
+    // Begin synthesizing frames. There are two: a "fully formed"
+    // exit-task frame at the top of the stack -- that pretends to be
+    // mid-execution -- and a just-starting frame beneath it that
+    // starts executing the first instruction of the spawnee. The
+    // spawnee *thinks* it was called by the exit-task frame above
+    // it. It wasn't; we put that fake frame in place here, but the
+    // illusion is enough for the spawnee to return to the exit-task
+    // frame when it's done, and exit.
+    uintptr_t *spp = (uintptr_t *)rust_sp;
+
+    // The exit_task_glue frame we synthesize above the frame we activate:
+    *spp-- = (uintptr_t) this;       // task
+    *spp-- = (uintptr_t) 0;          // output
+    *spp-- = (uintptr_t) 0;          // retpc
+    for (size_t j = 0; j < n_callee_saves; ++j) {
+        *spp-- = 0;
+    }
+
+    // We want 'frame_base' to point to the last callee-save in this
+    // (exit-task) frame, because we're going to inject this
+    // frame-pointer into the callee-save frame pointer value in the
+    // *next* (spawnee) frame. A cheap trick, but this means the
+    // spawnee frame will restore the proper frame pointer of the glue
+    // frame as it runs its epilogue.
+    uintptr_t frame_base = (uintptr_t) (spp+1);
+
+    *spp-- = (uintptr_t) dom->root_crate;  // crate ptr
+    *spp-- = (uintptr_t) 0;                // frame_glue_fns
+
+    // Copy args from spawner to spawnee.
+    if (args)  {
+        uintptr_t *src = (uintptr_t *)args;
+        src += 1;                  // spawn-call output slot
+        src += 1;                  // spawn-call task slot
+        // Memcpy all but the task and output pointers
+        callsz -= (2 * sizeof(uintptr_t));
+        spp = (uintptr_t*) (((uintptr_t)spp) - callsz);
+        memcpy(spp, src, callsz);
+
+        // Move sp down to point to task cell.
+        spp--;
+    } else {
+        // We're at root, starting up.
+        I(dom, callsz==0);
+    }
+
+    // The *implicit* incoming args to the spawnee frame we're
+    // activating:
+
+    *spp-- = (uintptr_t) this;            // task
+    *spp-- = (uintptr_t) 0;               // output addr
+    *spp-- = (uintptr_t) exit_task_glue;  // retpc
+
+    // The context the activate_glue needs to switch stack.
+    *spp-- = (uintptr_t) spawnee_fn;      // instruction to start at
+    for (size_t j = 0; j < n_callee_saves; ++j) {
+        // callee-saves to carry in when we activate
+        if (j == callee_save_fp)
+            *spp-- = frame_base;
+        else
+            *spp-- = NULL;
+    }
+
+    // Back up one, we overshot where sp should be.
+    rust_sp = (uintptr_t) (spp+1);
+
+    dom->add_task_to_state_vec(&dom->running_tasks, this);
+}
+
+void
+rust_task::grow(size_t n_frame_bytes)
+{
+    stk_seg *old_stk = this->stk;
+    uintptr_t old_top = (uintptr_t) old_stk->limit;
+    uintptr_t old_bottom = (uintptr_t) &old_stk->data[0];
+    uintptr_t rust_sp_disp = old_top - this->rust_sp;
+    size_t ssz = old_top - old_bottom;
+    dom->log(rust_log::MEM|rust_log::TASK|rust_log::UPCALL,
+             "upcall_grow_task(%" PRIdPTR
+             "), old size %" PRIdPTR
+             " bytes (old lim: 0x%" PRIxPTR ")",
+             n_frame_bytes, ssz, old_top);
+    ssz *= 2;
+    if (ssz < n_frame_bytes)
+        ssz = n_frame_bytes;
+    ssz = next_power_of_two(ssz);
+
+    dom->log(rust_log::MEM|rust_log::TASK, "upcall_grow_task growing stk 0x%"
+             PRIxPTR " to %d bytes", old_stk, ssz);
+
+    stk_seg *nstk = new_stk(dom, ssz);
+    uintptr_t new_top = (uintptr_t) &nstk->data[ssz];
+    size_t n_copy = old_top - old_bottom;
+    dom->log(rust_log::MEM|rust_log::TASK,
+             "copying %d bytes of stack from [0x%" PRIxPTR ", 0x%" PRIxPTR "]"
+             " to [0x%" PRIxPTR ", 0x%" PRIxPTR "]",
+             n_copy,
+             old_bottom, old_bottom + n_copy,
+             new_top - n_copy, new_top);
+
+    VALGRIND_MAKE_MEM_DEFINED((void*)old_bottom, n_copy);
+    memcpy((void*)(new_top - n_copy), (void*)old_bottom, n_copy);
+
+    nstk->limit = new_top;
+    this->stk = nstk;
+    this->rust_sp = new_top - rust_sp_disp;
+
+    dom->log(rust_log::MEM|rust_log::TASK, "processing relocations");
+
+    // FIXME (issue #32): this is the most ridiculously crude
+    // relocation scheme ever. Try actually, you know, writing out
+    // reloc descriptors?
+    size_t n_relocs = 0;
+    for (uintptr_t* p = (uintptr_t*)(new_top - n_copy);
+         p < (uintptr_t*)new_top; ++p) {
+        if (old_bottom <= *p && *p < old_top) {
+            //dom->log(rust_log::MEM, "relocating pointer 0x%" PRIxPTR
+            //        " by %d bytes", *p, (new_top - old_top));
+            n_relocs++;
+            *p += (new_top - old_top);
+        }
+    }
+    dom->log(rust_log::MEM|rust_log::TASK,
+             "processed %d relocations", n_relocs);
+    del_stk(dom, old_stk);
+    dom->logptr("grown stk limit", new_top);
+}
+
+void
+push_onto_thread_stack(uintptr_t &sp, uintptr_t value)
+{
+    asm("xchgl %0, %%esp\n"
+        "push %2\n"
+        "xchgl %0, %%esp\n"
+        : "=r" (sp)
+        : "0" (sp), "r" (value)
+        : "eax");
+}
+
+void
+rust_task::run_after_return(size_t nargs, uintptr_t glue)
+{
+    // This is only safe to call if we're the currently-running task.
+    check_active();
+
+    uintptr_t sp = runtime_sp;
+
+    // The compiler reserves nargs + 1 word for oldsp on the stack and
+    // then aligns it.
+    sp = align_down(sp - nargs * sizeof(uintptr_t));
+
+    uintptr_t *retpc = ((uintptr_t *) sp) - 1;
+    dom->log(rust_log::TASK|rust_log::MEM,
+             "run_after_return: overwriting retpc=0x%" PRIxPTR
+             " @ runtime_sp=0x%" PRIxPTR
+             " with glue=0x%" PRIxPTR,
+             *retpc, sp, glue);
+
+    // Move the current return address (which points into rust code)
+    // onto the rust stack and pretend we just called into the glue.
+    push_onto_thread_stack(rust_sp, *retpc);
+    *retpc = glue;
+}
+
+void
+rust_task::run_on_resume(uintptr_t glue)
+{
+    // This is only safe to call if we're suspended.
+    check_suspended();
+
+    // Inject glue as resume address in the suspended frame.
+    uintptr_t* rsp = (uintptr_t*) rust_sp;
+    rsp += n_callee_saves;
+    dom->log(rust_log::TASK|rust_log::MEM,
+             "run_on_resume: overwriting retpc=0x%" PRIxPTR
+             " @ rust_sp=0x%" PRIxPTR
+             " with glue=0x%" PRIxPTR,
+             *rsp, rsp, glue);
+    *rsp = glue;
+}
+
+void
+rust_task::yield(size_t nargs)
+{
+    dom->log(rust_log::TASK,
+             "task 0x%" PRIxPTR " yielding", this);
+    run_after_return(nargs, dom->root_crate->get_yield_glue());
+}
+
+static inline uintptr_t
+get_callee_save_fp(uintptr_t *top_of_callee_saves)
+{
+    return top_of_callee_saves[n_callee_saves - (callee_save_fp + 1)];
+}
+
+void
+rust_task::kill() {
+    // Note the distinction here: kill() is when you're in an upcall
+    // from task A and want to force-fail task B, you do B->kill().
+    // If you want to fail yourself you do self->fail(upcall_nargs).
+    dom->log(rust_log::TASK, "killing task 0x%" PRIxPTR, this);
+    // Unblock the task so it can unwind.
+    unblock();
+    if (this == dom->root_task)
+        dom->fail();
+    run_on_resume(dom->root_crate->get_unwind_glue());
+}
+
+void
+rust_task::fail(size_t nargs) {
+    // See note in ::kill() regarding who should call this.
+    dom->log(rust_log::TASK, "task 0x%" PRIxPTR " failing", this);
+    // Unblock the task so it can unwind.
+    unblock();
+    if (this == dom->root_task)
+        dom->fail();
+    run_after_return(nargs, dom->root_crate->get_unwind_glue());
+    if (spawner) {
+        dom->log(rust_log::TASK,
+                 "task 0x%" PRIxPTR
+                 " propagating failure to parent 0x%" PRIxPTR,
+                 this, spawner);
+        spawner->kill();
+    }
+}
+
+void
+rust_task::notify_waiting_tasks()
+{
+    while (waiting_tasks.length() > 0) {
+        rust_task *t = waiting_tasks.pop()->receiver;
+        if (!t->dead())
+            t->wakeup(this);
+    }
+}
+
+uintptr_t
+rust_task::get_fp() {
+    // sp in any suspended task points to the last callee-saved reg on
+    // the task stack.
+    return get_callee_save_fp((uintptr_t*)rust_sp);
+}
+
+uintptr_t
+rust_task::get_previous_fp(uintptr_t fp) {
+    // fp happens to, coincidentally (!) also point to the last
+    // callee-save on the task stack.
+    return get_callee_save_fp((uintptr_t*)fp);
+}
+
+frame_glue_fns*
+rust_task::get_frame_glue_fns(uintptr_t fp) {
+    fp -= sizeof(uintptr_t);
+    return *((frame_glue_fns**) fp);
+}
+
+bool
+rust_task::running()
+{
+    return state == &dom->running_tasks;
+}
+
+bool
+rust_task::blocked()
+{
+    return state == &dom->blocked_tasks;
+}
+
+bool
+rust_task::blocked_on(rust_cond *on)
+{
+    return blocked() && cond == on;
+}
+
+bool
+rust_task::dead()
+{
+    return state == &dom->dead_tasks;
+}
+
+void
+rust_task::transition(ptr_vec<rust_task> *src, ptr_vec<rust_task> *dst)
+{
+    I(dom, state == src);
+    dom->log(rust_log::TASK,
+             "task 0x%" PRIxPTR " state change '%s' -> '%s'",
+             (uintptr_t)this,
+             dom->state_vec_name(src),
+             dom->state_vec_name(dst));
+    dom->remove_task_from_state_vec(src, this);
+    dom->add_task_to_state_vec(dst, this);
+    state = dst;
+}
+
+void
+rust_task::block(rust_cond *on)
+{
+    I(dom, on);
+    transition(&dom->running_tasks, &dom->blocked_tasks);
+    dom->log(rust_log::TASK,
+             "task 0x%" PRIxPTR " blocking on 0x%" PRIxPTR,
+             (uintptr_t)this,
+             (uintptr_t)on);
+    cond = on;
+}
+
+void
+rust_task::wakeup(rust_cond *from)
+{
+    transition(&dom->blocked_tasks, &dom->running_tasks);
+    I(dom, cond == from);
+}
+
+void
+rust_task::die()
+{
+    transition(&dom->running_tasks, &dom->dead_tasks);
+}
+
+void
+rust_task::unblock()
+{
+    if (blocked())
+        wakeup(cond);
+}
+
+rust_crate_cache *
+rust_task::get_crate_cache(rust_crate const *curr_crate)
+{
+    if (cache && cache->crate != curr_crate) {
+        dom->log(rust_log::TASK, "switching task crate-cache to crate 0x%"
+                 PRIxPTR, curr_crate);
+        cache->deref();
+        cache = NULL;
+    }
+
+    if (!cache) {
+        dom->log(rust_log::TASK, "fetching cache for current crate");
+        cache = dom->get_cache(curr_crate);
+    }
+    return cache;
+}
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//

src/rt/rust_timer.cpp

@@ -0,0 +1,97 @@
+
+#include "rust_internal.h"
+
+// The mechanism in this file is very crude; every domain (thread) spawns its
+// own secondary timer thread, and that timer thread *never idles*. It
+// sleep-loops interrupting the domain.
+//
+// This will need replacement, particularly in order to achieve an actual
+// state of idling when we're waiting on the outside world.  Though that might
+// be as simple as making a secondary waitable start/stop-timer signalling
+// system between the domain and its timer thread. We'll see.
+//
+// On the other hand, we don't presently have the ability to idle domains *at
+// all*, and without the timer thread we're unable to otherwise preempt rust
+// tasks. So ... one step at a time.
+//
+// The implementation here is "lockless" in the sense that it only involves
+// one-directional signaling of one-shot events, so the event initiator just
+// writes a nonzero word to a prederermined location and waits for the
+// receiver to see it show up in their memory.
+
+#if defined(__WIN32__)
+static DWORD WINAPI
+win32_timer_loop(void *ptr)
+{
+    // We were handed the rust_timer that owns us.
+    rust_timer *timer = (rust_timer *)ptr;
+    rust_dom &dom = timer->dom;
+    dom.log(LOG_TIMER, "in timer 0x%" PRIxPTR, (uintptr_t)timer);
+    while (!timer->exit_flag) {
+        Sleep(TIME_SLICE_IN_MS);
+        dom.log(LOG_TIMER,
+                "timer 0x%" PRIxPTR
+                " interrupting domain 0x%" PRIxPTR,
+                (uintptr_t)timer,
+                (uintptr_t)&dom);
+        dom.interrupt_flag = 1;
+    }
+    ExitThread(0);
+    return 0;
+}
+
+#elif defined(__GNUC__)
+static void *
+pthread_timer_loop(void *ptr)
+{
+    // We were handed the rust_timer that owns us.
+    rust_timer *timer = (rust_timer *)ptr;
+    rust_dom &dom(timer->dom);
+    while (!timer->exit_flag) {
+        usleep(TIME_SLICE_IN_MS * 1000);
+        dom.interrupt_flag = 1;
+    }
+    pthread_exit(NULL);
+    return 0;
+
+}
+#else
+#error "Platform not supported"
+#endif
+
+
+rust_timer::rust_timer(rust_dom &dom) : dom(dom), exit_flag(0)
+{
+    dom.log(rust_log::TIMER, "creating timer for domain 0x%" PRIxPTR, &dom);
+#if defined(__WIN32__)
+    thread = CreateThread(NULL, 0, win32_timer_loop, this, 0, NULL);
+    dom.win32_require("CreateThread", thread != NULL);
+#else
+    pthread_attr_init(&attr);
+    pthread_attr_setdetachstate(&attr, PTHREAD_CREATE_JOINABLE);
+    pthread_create(&thread, &attr, pthread_timer_loop, (void *)this);
+#endif
+}
+
+rust_timer::~rust_timer()
+{
+    exit_flag = 1;
+#if defined(__WIN32__)
+    dom.win32_require("WaitForSingleObject",
+                      WaitForSingleObject(thread, INFINITE)
+                      == WAIT_OBJECT_0);
+#else
+    pthread_join(thread, NULL);
+#endif
+}
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//

src/rt/rust_upcall.cpp

@@ -0,0 +1,654 @@
+
+#include "rust_internal.h"
+
+
+// Upcalls.
+
+#ifdef __GNUC__
+#define LOG_UPCALL_ENTRY(task)                              \
+    (task)->dom->get_log().reset_indent(0);                 \
+    (task)->dom->log(rust_log::UPCALL,                      \
+                     "upcall task: 0x%" PRIxPTR             \
+                     " retpc: 0x%" PRIxPTR,                 \
+                     (task), __builtin_return_address(0));  \
+    (task)->dom->get_log().indent();
+#else
+#define LOG_UPCALL_ENTRY(task)                              \
+    (task)->dom->get_log().reset_indent(0);                 \
+    (task)->dom->log(rust_log::UPCALL,                      \
+                     "upcall task: 0x%" PRIxPTR (task));    \
+    (task)->dom->get_log().indent();
+#endif
+
+extern "C" CDECL char const *str_buf(rust_task *task, rust_str *s);
+
+extern "C" void
+upcall_grow_task(rust_task *task, size_t n_frame_bytes)
+{
+    LOG_UPCALL_ENTRY(task);
+    task->grow(n_frame_bytes);
+}
+
+extern "C" CDECL void
+upcall_log_int(rust_task *task, int32_t i)
+{
+    LOG_UPCALL_ENTRY(task);
+    task->dom->log(rust_log::UPCALL|rust_log::ULOG,
+                   "upcall log_int(0x%" PRIx32 " = %" PRId32 " = '%c')",
+                   i, i, (char)i);
+}
+
+extern "C" CDECL void
+upcall_log_str(rust_task *task, rust_str *str)
+{
+    LOG_UPCALL_ENTRY(task);
+    const char *c = str_buf(task, str);
+    task->dom->log(rust_log::UPCALL|rust_log::ULOG,
+                   "upcall log_str(\"%s\")",
+                   c);
+}
+
+extern "C" CDECL void
+upcall_trace_word(rust_task *task, uintptr_t i)
+{
+    LOG_UPCALL_ENTRY(task);
+    task->dom->log(rust_log::UPCALL|rust_log::TRACE,
+                   "trace: 0x%" PRIxPTR "",
+                   i, i, (char)i);
+}
+
+extern "C" CDECL void
+upcall_trace_str(rust_task *task, char const *c)
+{
+    LOG_UPCALL_ENTRY(task);
+    task->dom->log(rust_log::UPCALL|rust_log::TRACE,
+                   "trace: %s",
+                   c);
+}
+
+extern "C" CDECL rust_port*
+upcall_new_port(rust_task *task, size_t unit_sz)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::MEM|rust_log::COMM,
+             "upcall_new_port(task=0x%" PRIxPTR ", unit_sz=%d)",
+             (uintptr_t)task, unit_sz);
+    return new (dom) rust_port(task, unit_sz);
+}
+
+extern "C" CDECL void
+upcall_del_port(rust_task *task, rust_port *port)
+{
+    LOG_UPCALL_ENTRY(task);
+    task->dom->log(rust_log::UPCALL|rust_log::MEM|rust_log::COMM,
+                   "upcall del_port(0x%" PRIxPTR ")", (uintptr_t)port);
+    I(task->dom, !port->refcnt);
+    delete port;
+}
+
+extern "C" CDECL rust_chan*
+upcall_new_chan(rust_task *task, rust_port *port)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::MEM|rust_log::COMM,
+             "upcall_new_chan(task=0x%" PRIxPTR ", port=0x%" PRIxPTR ")",
+             (uintptr_t)task, port);
+    I(dom, port);
+    return new (dom) rust_chan(task, port);
+}
+
+extern "C" CDECL void
+upcall_del_chan(rust_task *task, rust_chan *chan)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::MEM|rust_log::COMM,
+             "upcall del_chan(0x%" PRIxPTR ")", (uintptr_t)chan);
+    I(dom, !chan->refcnt);
+    delete chan;
+}
+
+extern "C" CDECL rust_chan *
+upcall_clone_chan(rust_task *task, rust_task *owner, rust_chan *chan)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::MEM|rust_log::COMM,
+             "upcall clone_chan(owner 0x%" PRIxPTR ", chan 0x%" PRIxPTR ")",
+             (uintptr_t)owner, (uintptr_t)chan);
+    return new (owner->dom) rust_chan(owner, chan->port);
+}
+
+
+/*
+ * Buffering protocol:
+ *
+ *   - Reader attempts to read:
+ *     - Set reader to blocked-reading state.
+ *     - If buf with data exists:
+ *       - Attempt transmission.
+ *
+ *  - Writer attempts to write:
+ *     - Set writer to blocked-writing state.
+ *     - Copy data into chan.
+ *     - Attempt transmission.
+ *
+ *  - Transmission:
+ *       - Copy data from buf to reader
+ *       - Decr buf
+ *       - Set reader to running
+ *       - If buf now empty and blocked writer:
+ *         - Set blocked writer to running
+ *
+ */
+
+static int
+attempt_transmission(rust_dom *dom,
+                     rust_chan *src,
+                     rust_task *dst)
+{
+    I(dom, src);
+    I(dom, dst);
+
+    rust_port *port = src->port;
+    if (!port) {
+        dom->log(rust_log::COMM,
+                 "src died, transmission incomplete");
+        return 0;
+    }
+
+    circ_buf *buf = &src->buffer;
+    if (buf->unread == 0) {
+        dom->log(rust_log::COMM,
+                 "buffer empty, transmission incomplete");
+        return 0;
+    }
+
+    if (!dst->blocked_on(port)) {
+        dom->log(rust_log::COMM,
+                 "dst in non-reading state, transmission incomplete");
+        return 0;
+    }
+
+    uintptr_t *dptr = dst->dptr;
+    dom->log(rust_log::COMM,
+             "receiving %d bytes into dst_task=0x%" PRIxPTR
+             ", dptr=0x%" PRIxPTR,
+             port->unit_sz, dst, dptr);
+    buf->shift(dptr);
+
+    // Wake up the sender if its waiting for the send operation.
+    rust_task *sender = src->task;
+    rust_token *token = &src->token;
+    if (sender->blocked_on(token))
+        sender->wakeup(token);
+
+    // Wake up the receiver, there is new data.
+    dst->wakeup(port);
+
+    dom->log(rust_log::COMM, "transmission complete");
+    return 1;
+}
+
+extern "C" CDECL void
+upcall_yield(rust_task *task)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::COMM, "upcall yield()");
+    task->yield(1);
+}
+
+extern "C" CDECL void
+upcall_join(rust_task *task, rust_task *other)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::COMM,
+             "upcall join(other=0x%" PRIxPTR ")",
+             (uintptr_t)other);
+
+    // If the other task is already dying, we dont have to wait for it.
+    if (!other->dead()) {
+        other->waiting_tasks.push(&task->alarm);
+        task->block(other);
+        task->yield(2);
+    }
+}
+
+extern "C" CDECL void
+upcall_send(rust_task *task, rust_chan *chan, void *sptr)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::COMM,
+             "upcall send(chan=0x%" PRIxPTR ", sptr=0x%" PRIxPTR ")",
+             (uintptr_t)chan,
+             (uintptr_t)sptr);
+
+    I(dom, chan);
+    I(dom, sptr);
+
+    rust_port *port = chan->port;
+    dom->log(rust_log::MEM|rust_log::COMM,
+             "send to port", (uintptr_t)port);
+    I(dom, port);
+
+    rust_token *token = &chan->token;
+    dom->log(rust_log::MEM|rust_log::COMM,
+             "sending via token 0x%" PRIxPTR,
+             (uintptr_t)token);
+
+    if (port->task) {
+        chan->buffer.push(sptr);
+        task->block(token);
+        attempt_transmission(dom, chan, port->task);
+        if (chan->buffer.unread && !token->pending())
+            token->submit();
+    } else {
+        dom->log(rust_log::COMM|rust_log::ERR,
+                 "port has no task (possibly throw?)");
+    }
+
+    if (!task->running())
+        task->yield(3);
+}
+
+extern "C" CDECL void
+upcall_recv(rust_task *task, uintptr_t *dptr, rust_port *port)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::COMM,
+             "upcall recv(dptr=0x" PRIxPTR ", port=0x%" PRIxPTR ")",
+             (uintptr_t)dptr,
+             (uintptr_t)port);
+
+    I(dom, port);
+    I(dom, port->task);
+    I(dom, task);
+    I(dom, port->task == task);
+
+    task->block(port);
+
+    if (port->writers.length() > 0) {
+        I(dom, task->dom);
+        size_t i = rand(&dom->rctx);
+        i %= port->writers.length();
+        rust_token *token = port->writers[i];
+        rust_chan *chan = token->chan;
+        if (attempt_transmission(dom, chan, task))
+            token->withdraw();
+    } else {
+        dom->log(rust_log::COMM,
+                 "no writers sending to port", (uintptr_t)port);
+    }
+
+    if (!task->running()) {
+        task->dptr = dptr;
+        task->yield(3);
+    }
+}
+
+extern "C" CDECL void
+upcall_fail(rust_task *task, char const *expr, char const *file, size_t line)
+{
+    LOG_UPCALL_ENTRY(task);
+    task->dom->log(rust_log::UPCALL|rust_log::ERR,
+                   "upcall fail '%s', %s:%" PRIdPTR,
+                   expr, file, line);
+    task->fail(4);
+}
+
+extern "C" CDECL void
+upcall_kill(rust_task *task, rust_task *target)
+{
+    LOG_UPCALL_ENTRY(task);
+    task->dom->log(rust_log::UPCALL|rust_log::TASK,
+                   "upcall kill target=0x%" PRIxPTR, target);
+    target->kill();
+}
+
+extern "C" CDECL void
+upcall_exit(rust_task *task)
+{
+    LOG_UPCALL_ENTRY(task);
+
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::TASK, "upcall exit");
+    task->die();
+    task->notify_waiting_tasks();
+    task->yield(1);
+}
+
+extern "C" CDECL uintptr_t
+upcall_malloc(rust_task *task, size_t nbytes)
+{
+    LOG_UPCALL_ENTRY(task);
+
+    void *p = task->dom->malloc(nbytes);
+    task->dom->log(rust_log::UPCALL|rust_log::MEM,
+                   "upcall malloc(%u) = 0x%" PRIxPTR,
+                   nbytes, (uintptr_t)p);
+    return (uintptr_t) p;
+}
+
+extern "C" CDECL void
+upcall_free(rust_task *task, void* ptr)
+{
+    LOG_UPCALL_ENTRY(task);
+
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::MEM,
+             "upcall free(0x%" PRIxPTR ")",
+             (uintptr_t)ptr);
+    dom->free(ptr);
+}
+
+extern "C" CDECL rust_str *
+upcall_new_str(rust_task *task, char const *s, size_t fill)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::MEM,
+             "upcall new_str('%s', %" PRIdPTR ")", s, fill);
+    size_t alloc = next_power_of_two(sizeof(rust_str) + fill);
+    void *mem = dom->malloc(alloc);
+    if (!mem) {
+        task->fail(3);
+        return NULL;
+    }
+    rust_str *st = new (mem) rust_str(dom, alloc, fill, (uint8_t const *)s);
+    dom->log(rust_log::UPCALL|rust_log::MEM,
+             "upcall new_str('%s', %" PRIdPTR ") = 0x%" PRIxPTR,
+             s, fill, st);
+    return st;
+}
+
+extern "C" CDECL rust_vec *
+upcall_new_vec(rust_task *task, size_t fill)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::MEM,
+             "upcall new_vec(%" PRIdPTR ")", fill);
+    size_t alloc = next_power_of_two(sizeof(rust_vec) + fill);
+    void *mem = dom->malloc(alloc);
+    if (!mem) {
+        task->fail(3);
+        return NULL;
+    }
+    rust_vec *v = new (mem) rust_vec(dom, alloc, 0, NULL);
+    dom->log(rust_log::UPCALL|rust_log::MEM,
+             "upcall new_vec(%" PRIdPTR ") = 0x%" PRIxPTR,
+             fill, v);
+    return v;
+}
+
+
+extern "C" CDECL rust_str *
+upcall_vec_grow(rust_task *task, rust_vec *v, size_t n_bytes)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::MEM,
+             "upcall vec_grow(%" PRIxPTR ", %" PRIdPTR ")", v, n_bytes);
+    size_t alloc = next_power_of_two(sizeof(rust_vec) + v->fill + n_bytes);
+    if (v->refcnt == 1) {
+
+        // Fastest path: already large enough.
+        if (v->alloc >= alloc) {
+            dom->log(rust_log::UPCALL|rust_log::MEM, "no-growth path");
+            return v;
+        }
+
+        // Second-fastest path: can at least realloc.
+        dom->log(rust_log::UPCALL|rust_log::MEM, "realloc path");
+        v = (rust_vec*)dom->realloc(v, alloc);
+        if (!v) {
+            task->fail(3);
+            return NULL;
+        }
+        v->alloc = alloc;
+
+    } else {
+        // Slowest path: make a new vec.
+        dom->log(rust_log::UPCALL|rust_log::MEM, "new vec path");
+        void *mem = dom->malloc(alloc);
+        if (!mem) {
+            task->fail(3);
+            return NULL;
+        }
+        v->deref();
+        v = new (mem) rust_vec(dom, alloc, v->fill, &v->data[0]);
+    }
+    I(dom, sizeof(rust_vec) + v->fill <= v->alloc);
+    return v;
+}
+
+
+static rust_crate_cache::c_sym *
+fetch_c_sym(rust_task *task,
+            rust_crate const *curr_crate,
+            size_t lib_num,
+            size_t c_sym_num,
+            char const *library,
+            char const *symbol)
+{
+    rust_crate_cache *cache = task->get_crate_cache(curr_crate);
+    rust_crate_cache::lib *l = cache->get_lib(lib_num, library);
+    return cache->get_c_sym(c_sym_num, l, symbol);
+}
+
+extern "C" CDECL uintptr_t
+upcall_require_rust_sym(rust_task *task,
+                        rust_crate const *curr_crate,
+                        size_t lib_num,      // # of lib
+                        size_t c_sym_num,    // # of C sym "rust_crate" in lib
+                        size_t rust_sym_num, // # of rust sym
+                        char const *library,
+                        char const **path)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+
+    dom->log(rust_log::UPCALL|rust_log::CACHE,
+             "upcall require rust sym: lib #%" PRIdPTR
+             " = %s, c_sym #%" PRIdPTR
+             ", rust_sym #%" PRIdPTR
+             ", curr_crate = 0x%" PRIxPTR,
+             lib_num, library, c_sym_num, rust_sym_num,
+             curr_crate);
+    for (char const **c = crate_rel(curr_crate, path); *c; ++c) {
+        dom->log(rust_log::UPCALL, " + %s", crate_rel(curr_crate, *c));
+    }
+
+    dom->log(rust_log::UPCALL|rust_log::CACHE,
+             "require C symbol 'rust_crate' from lib #%" PRIdPTR,lib_num);
+    rust_crate_cache::c_sym *c =
+        fetch_c_sym(task, curr_crate, lib_num, c_sym_num,
+                    library, "rust_crate");
+
+    dom->log(rust_log::UPCALL|rust_log::CACHE,
+             "require rust symbol inside crate");
+    rust_crate_cache::rust_sym *s =
+        task->cache->get_rust_sym(rust_sym_num, dom, curr_crate, c, path);
+
+    uintptr_t addr = s->get_val();
+    if (addr) {
+        dom->log(rust_log::UPCALL|rust_log::CACHE,
+                 "found-or-cached addr: 0x%" PRIxPTR, addr);
+    } else {
+        dom->log(rust_log::UPCALL|rust_log::CACHE,
+                 "failed to resolve symbol");
+        task->fail(7);
+    }
+    return addr;
+}
+
+extern "C" CDECL uintptr_t
+upcall_require_c_sym(rust_task *task,
+                     rust_crate const *curr_crate,
+                     size_t lib_num,      // # of lib
+                     size_t c_sym_num,    // # of C sym
+                     char const *library,
+                     char const *symbol)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+
+    dom->log(rust_log::UPCALL|rust_log::CACHE,
+             "upcall require c sym: lib #%" PRIdPTR
+             " = %s, c_sym #%" PRIdPTR
+             " = %s"
+             ", curr_crate = 0x%" PRIxPTR,
+             lib_num, library, c_sym_num, symbol, curr_crate);
+
+    rust_crate_cache::c_sym *c =
+        fetch_c_sym(task, curr_crate, lib_num, c_sym_num, library, symbol);
+
+    uintptr_t addr = c->get_val();
+    if (addr) {
+        dom->log(rust_log::UPCALL|rust_log::CACHE,
+                 "found-or-cached addr: 0x%" PRIxPTR, addr);
+    } else {
+        dom->log(rust_log::UPCALL|rust_log::CACHE,
+                 "failed to resolve symbol");
+        task->fail(6);
+    }
+    return addr;
+}
+
+extern "C" CDECL type_desc *
+upcall_get_type_desc(rust_task *task,
+                     rust_crate const *curr_crate,
+                     size_t size,
+                     size_t align,
+                     size_t n_descs,
+                     type_desc const **descs)
+{
+    LOG_UPCALL_ENTRY(task);
+    rust_dom *dom = task->dom;
+    dom->log(rust_log::UPCALL|rust_log::CACHE,
+             "upcall get_type_desc with size=%" PRIdPTR
+             ", align=%" PRIdPTR ", %" PRIdPTR " descs",
+             size, align, n_descs);
+    rust_crate_cache *cache = task->get_crate_cache(curr_crate);
+    type_desc *td = cache->get_type_desc(size, align, n_descs, descs);
+    dom->log(rust_log::UPCALL|rust_log::CACHE,
+             "returning tydesc 0x%" PRIxPTR, td);
+    return td;
+}
+
+
+#if defined(__WIN32__)
+static DWORD WINAPI rust_thread_start(void *ptr)
+#elif defined(__GNUC__)
+static void *rust_thread_start(void *ptr)
+#else
+#error "Platform not supported"
+#endif
+{
+    // We were handed the domain we are supposed to run.
+    rust_dom *dom = (rust_dom *)ptr;
+
+    // Start a new rust main loop for this thread.
+    rust_main_loop(dom);
+
+    rust_srv *srv = dom->srv;
+    delete dom;
+    delete srv;
+
+    return 0;
+}
+
+extern "C" CDECL rust_task *
+upcall_new_task(rust_task *spawner)
+{
+    LOG_UPCALL_ENTRY(spawner);
+
+    rust_dom *dom = spawner->dom;
+    rust_task *task = new (dom) rust_task(dom, spawner);
+    dom->log(rust_log::UPCALL|rust_log::MEM|rust_log::TASK,
+             "upcall new_task(spawner 0x%" PRIxPTR ") = 0x%" PRIxPTR,
+             spawner, task);
+    return task;
+}
+
+extern "C" CDECL rust_task *
+upcall_start_task(rust_task *spawner,
+                  rust_task *task,
+                  uintptr_t exit_task_glue,
+                  uintptr_t spawnee_fn,
+                  size_t callsz)
+{
+    LOG_UPCALL_ENTRY(spawner);
+
+    rust_dom *dom = spawner->dom;
+    dom->log(rust_log::UPCALL|rust_log::MEM|rust_log::TASK,
+             "upcall start_task(task 0x%" PRIxPTR
+             " exit_task_glue 0x%" PRIxPTR
+             ", spawnee 0x%" PRIxPTR
+             ", callsz %" PRIdPTR ")",
+             task, exit_task_glue, spawnee_fn, callsz);
+    task->start(exit_task_glue, spawnee_fn, spawner->rust_sp, callsz);
+    return task;
+}
+
+extern "C" CDECL rust_task *
+upcall_new_thread(rust_task *task)
+{
+    LOG_UPCALL_ENTRY(task);
+
+    rust_dom *old_dom = task->dom;
+    rust_dom *new_dom = new rust_dom(old_dom->srv->clone(),
+                                     old_dom->root_crate);
+    new_dom->log(rust_log::UPCALL|rust_log::MEM,
+                 "upcall new_thread() = 0x%" PRIxPTR,
+                 new_dom->root_task);
+    return new_dom->root_task;
+}
+
+extern "C" CDECL rust_task *
+upcall_start_thread(rust_task *spawner,
+                    rust_task *root_task,
+                    uintptr_t exit_task_glue,
+                    uintptr_t spawnee_fn,
+                    size_t callsz)
+{
+    LOG_UPCALL_ENTRY(spawner);
+
+    rust_dom *dom = spawner->dom;
+    dom->log(rust_log::UPCALL|rust_log::MEM|rust_log::TASK,
+             "upcall start_thread(exit_task_glue 0x%" PRIxPTR
+             ", spawnee 0x%" PRIxPTR
+             ", callsz %" PRIdPTR ")",
+             exit_task_glue, spawnee_fn, callsz);
+    root_task->start(exit_task_glue, spawnee_fn, spawner->rust_sp, callsz);
+
+#if defined(__WIN32__)
+    HANDLE thread;
+    thread = CreateThread(NULL, 0, rust_thread_start, root_task->dom,
+                          0, NULL);
+    dom->win32_require("CreateThread", thread != NULL);
+#else
+    pthread_t thread;
+    pthread_create(&thread, &dom->attr, rust_thread_start,
+                   (void *)root_task->dom);
+#endif
+
+    return 0;
+}
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//

src/rt/rust_util.h

@@ -0,0 +1,155 @@
+#ifndef RUST_UTIL_H
+#define RUST_UTIL_H
+
+// Reference counted objects
+
+template <typename T>
+rc_base<T>::rc_base() :
+    refcnt(1)
+{
+}
+
+template <typename T>
+rc_base<T>::~rc_base()
+{
+}
+
+// Utility type: pointer-vector.
+
+template <typename T>
+ptr_vec<T>::ptr_vec(rust_dom *dom) :
+    dom(dom),
+    alloc(INIT_SIZE),
+    fill(0),
+    data(new (dom) T*[alloc])
+{
+    I(dom, data);
+    dom->log(rust_log::MEM,
+             "new ptr_vec(data=0x%" PRIxPTR ") -> 0x%" PRIxPTR,
+             (uintptr_t)data, (uintptr_t)this);
+}
+
+template <typename T>
+ptr_vec<T>::~ptr_vec()
+{
+    I(dom, data);
+    dom->log(rust_log::MEM,
+             "~ptr_vec 0x%" PRIxPTR ", data=0x%" PRIxPTR,
+             (uintptr_t)this, (uintptr_t)data);
+    I(dom, fill == 0);
+    dom->free(data);
+}
+
+template <typename T> T *&
+ptr_vec<T>::operator[](size_t offset) {
+    I(dom, data[offset]->idx == offset);
+    return data[offset];
+}
+
+template <typename T>
+void
+ptr_vec<T>::push(T *p)
+{
+    I(dom, data);
+    I(dom, fill <= alloc);
+    if (fill == alloc) {
+        alloc *= 2;
+        data = (T **)dom->realloc(data, alloc * sizeof(T*));
+        I(dom, data);
+    }
+    I(dom, fill < alloc);
+    p->idx = fill;
+    data[fill++] = p;
+}
+
+template <typename T>
+T *
+ptr_vec<T>::pop()
+{
+    return data[--fill];
+}
+
+template <typename T>
+void
+ptr_vec<T>::trim(size_t sz)
+{
+    I(dom, data);
+    if (sz <= (alloc / 4) &&
+        (alloc / 2) >= INIT_SIZE) {
+        alloc /= 2;
+        I(dom, alloc >= fill);
+        data = (T **)dom->realloc(data, alloc * sizeof(T*));
+        I(dom, data);
+    }
+}
+
+template <typename T>
+void
+ptr_vec<T>::swapdel(T *item)
+{
+    /* Swap the endpoint into i and decr fill. */
+    I(dom, data);
+    I(dom, fill > 0);
+    I(dom, item->idx < fill);
+    fill--;
+    if (fill > 0) {
+        T *subst = data[fill];
+        size_t idx = item->idx;
+        data[idx] = subst;
+        subst->idx = idx;
+    }
+}
+
+// Inline fn used regularly elsewhere.
+
+static inline size_t
+next_power_of_two(size_t s)
+{
+    size_t tmp = s - 1;
+    tmp |= tmp >> 1;
+    tmp |= tmp >> 2;
+    tmp |= tmp >> 4;
+    tmp |= tmp >> 8;
+    tmp |= tmp >> 16;
+#if SIZE_MAX == UINT64_MAX
+    tmp |= tmp >> 32;
+#endif
+    return tmp + 1;
+}
+
+// Vectors (rust-user-code level).
+
+struct
+rust_vec : public rc_base<rust_vec>
+{
+    size_t alloc;
+    size_t fill;
+    uint8_t data[];
+    rust_vec(rust_dom *dom, size_t alloc, size_t fill, uint8_t const *d) :
+        alloc(alloc),
+        fill(fill)
+    {
+        if (d || fill) {
+            I(dom, d);
+            I(dom, fill);
+            memcpy(&data[0], d, fill);
+        }
+    }
+    ~rust_vec() {}
+};
+
+// Rust types vec and str look identical from our perspective.
+typedef rust_vec rust_str;
+
+//
+// Local Variables:
+// mode: C++
+// fill-column: 78;
+// indent-tabs-mode: nil
+// c-basic-offset: 4
+// buffer-file-coding-system: utf-8-unix
+// compile-command: "make -k -C .. 2>&1 | sed -e 's/\\/x\\//x:\\//g'";
+// End:
+//
+
+#endif

src/rt/sync/fair_ticket_lock.cpp

@@ -0,0 +1,43 @@
+/*
+ * This works well as long as the number of contending threads
+ * is less than the number of processors. This is because of
+ * the fair locking scheme. If the thread that is next in line
+ * for acquiring the lock is not currently running, no other
+ * thread can acquire the lock. This is terrible for performance,
+ * and it seems that all fair locking schemes suffer from this
+ * behavior.
+ */
+
+// #define TRACE
+
+fair_ticket_lock::fair_ticket_lock() {
+    next_ticket = now_serving = 0;
+}
+
+fair_ticket_lock::~fair_ticket_lock() {
+
+}
+
+void fair_ticket_lock::lock() {
+    unsigned ticket = __sync_fetch_and_add(&next_ticket, 1);
+    while (now_serving != ticket) {
+        pause();
+    }
+#ifdef TRACE
+    printf("locked   nextTicket: %d nowServing: %d",
+            next_ticket, now_serving);
+#endif
+}
+
+void fair_ticket_lock::unlock() {
+    now_serving++;
+#ifdef TRACE
+    printf("unlocked nextTicket: %d nowServing: %d",
+            next_ticket, now_serving);
+#endif
+}
+
+void fair_ticket_lock::pause() {
+    asm volatile("pause\n" : : : "memory");
+}
+

src/rt/sync/fair_ticket_lock.h

@@ -0,0 +1,15 @@
+#ifndef FAIR_TICKET_LOCK_H
+#define FAIR_TICKET_LOCK_H
+
+class fair_ticket_lock {
+    unsigned next_ticket;
+    unsigned now_serving;
+    void pause();
+public:
+    fair_ticket_lock();
+    virtual ~fair_ticket_lock();
+    void lock();
+    void unlock();
+};
+
+#endif /* FAIR_TICKET_LOCK_H */

src/rt/sync/lock_free_queue.cpp

@@ -0,0 +1,37 @@
+/*
+ * Interrupt transparent queue, Schoen et. al, "On Interrupt-Transparent
+ * Synchronization in an Embedded Object-Oriented Operating System", 2000.
+ * enqueue() is allowed to interrupt enqueue() and dequeue(), however,
+ * dequeue() is not allowed to interrupt itself.
+ */
+
+#include "lock_free_queue.h"
+
+lock_free_queue::lock_free_queue() :
+    tail(this) {
+}
+
+void lock_free_queue::enqueue(lock_free_queue_node *item) {
+    item->next = (lock_free_queue_node *) 0;
+    lock_free_queue_node *last = tail;
+    tail = item;
+    while (last->next)
+        last = last->next;
+    last->next = item;
+}
+
+lock_free_queue_node *lockfree_queue::dequeue() {
+    lock_free_queue_node *item = next;
+    if (item && !(next = item->next)) {
+        tail = (lock_free_queue_node *) this;
+        if (item->next) {
+            lock_free_queue_node *lost = item->next;
+            lock_free_queue_node *help;
+            do {
+                help = lost->next;
+                enqueue(lost);
+            } while ((lost = help) != (lock_free_queue_node *) 0);
+        }
+    }
+    return item;
+}

src/rt/sync/lock_free_queue.h

@@ -0,0 +1,15 @@
+#ifndef LOCK_FREE_QUEUE_H
+#define LOCK_FREE_QUEUE_H
+
+class lock_free_queue_node {
+    lock_free_queue_node *next;
+};
+
+class lock_free_queue {
+public:
+    lock_free_queue();
+    void enqueue(lock_free_queue_node *item);
+    lock_free_queue_node *dequeue();
+};
+
+#endif /* LOCK_FREE_QUEUE_H */

src/rt/sync/spin_lock.cpp

@@ -0,0 +1,47 @@
+/*
+ * Your average spin lock.
+ */
+
+#include "globals.h"
+
+// #define TRACE
+
+spin_lock::spin_lock() {
+    unlock();
+}
+
+spin_lock::~spin_lock() {
+}
+
+static inline unsigned xchg32(void *ptr, unsigned x) {
+    __asm__ __volatile__("xchgl %0,%1"
+                :"=r" ((unsigned) x)
+                :"m" (*(volatile unsigned *)ptr), "0" (x)
+                :"memory");
+    return x;
+}
+
+void spin_lock::lock() {
+    while (true) {
+        if (!xchg32(&ticket, 1)) {
+            return;
+        }
+        while (ticket) {
+            pause();
+        }
+    }
+#ifdef TRACE
+    printf("  lock: %d", ticket);
+#endif
+}
+
+void spin_lock::unlock() {
+    ticket = 0;
+#ifdef TRACE
+    printf("unlock:");
+#endif
+}
+
+void spin_lock::pause() {
+    asm volatile("pause\n" : : : "memory");
+}

src/rt/sync/spin_lock.h

@@ -0,0 +1,14 @@
+#ifndef UNFAIR_TICKET_LOCK_H
+#define UNFAIR_TICKET_LOCK_H
+
+class spin_lock {
+    unsigned ticket;
+    void pause();
+public:
+    spin_lock();
+    virtual ~spin_lock();
+    void lock();
+    void unlock();
+};
+
+#endif /* UNFAIR_TICKET_LOCK_H */

src/rt/uthash/uthash.h

@@ -0,0 +1,766 @@
+/*
+Copyright (c) 2003-2009, Troy D. Hanson     http://uthash.sourceforge.net
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT OWNER
+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.
+*/
+
+#ifndef UTHASH_H
+#define UTHASH_H 
+
+#include <string.h>   /* memcmp,strlen */
+#include <stddef.h>   /* ptrdiff_t */
+#include <inttypes.h> /* uint32_t etc */
+
+#define UTHASH_VERSION 1.6
+
+/* C++ requires extra stringent casting */
+#if defined __cplusplus
+#define TYPEOF(x) (typeof(x))
+#else
+#define TYPEOF(x)
+#endif
+
+
+#define uthash_fatal(msg) exit(-1)        /* fatal error (out of memory,etc) */
+#define uthash_bkt_malloc(sz) malloc(sz)  /* malloc fcn for UT_hash_bucket's */
+#define uthash_bkt_free(ptr) free(ptr)    /* free fcn for UT_hash_bucket's   */
+#define uthash_tbl_malloc(sz) malloc(sz)  /* malloc fcn for UT_hash_table    */
+#define uthash_tbl_free(ptr) free(ptr)    /* free fcn for UT_hash_table      */
+
+#define uthash_noexpand_fyi(tbl)          /* can be defined to log noexpand  */
+#define uthash_expand_fyi(tbl)            /* can be defined to log expands   */
+
+/* initial number of buckets */
+#define HASH_INITIAL_NUM_BUCKETS 32      /* initial number of buckets        */
+#define HASH_INITIAL_NUM_BUCKETS_LOG2 5  /* lg2 of initial number of buckets */
+#define HASH_BKT_CAPACITY_THRESH 10      /* expand when bucket count reaches */
+
+/* calculate the element whose hash handle address is hhe */
+#define ELMT_FROM_HH(tbl,hhp) ((void*)(((char*)hhp) - (tbl)->hho))
+
+#define HASH_FIND(hh,head,keyptr,keylen,out)                                   \
+do {                                                                           \
+  unsigned _hf_bkt,_hf_hashv;                                                  \
+  out=TYPEOF(out)head;                                                         \
+  if (head) {                                                                  \
+     HASH_FCN(keyptr,keylen, (head)->hh.tbl->num_buckets, _hf_hashv, _hf_bkt); \
+     HASH_FIND_IN_BKT((head)->hh.tbl, hh, (head)->hh.tbl->buckets[ _hf_bkt ],  \
+                      keyptr,keylen,out);                                      \
+  }                                                                            \
+} while (0)
+
+#define HASH_MAKE_TABLE(hh,head)                                               \
+do {                                                                           \
+  (head)->hh.tbl = (UT_hash_table*)uthash_tbl_malloc(                          \
+                  sizeof(UT_hash_table));                                      \
+  if (!((head)->hh.tbl))  { uthash_fatal( "out of memory"); }                  \
+  memset((head)->hh.tbl, 0, sizeof(UT_hash_table));                            \
+  (head)->hh.tbl->tail = &((head)->hh);                                        \
+  (head)->hh.tbl->num_buckets = HASH_INITIAL_NUM_BUCKETS;                      \
+  (head)->hh.tbl->log2_num_buckets = HASH_INITIAL_NUM_BUCKETS_LOG2;            \
+  (head)->hh.tbl->hho = (char*)(&(head)->hh) - (char*)(head);                  \
+  (head)->hh.tbl->buckets = (UT_hash_bucket*)uthash_bkt_malloc(                \
+          HASH_INITIAL_NUM_BUCKETS*sizeof(struct UT_hash_bucket));             \
+  if (! (head)->hh.tbl->buckets) { uthash_fatal( "out of memory"); }           \
+  memset((head)->hh.tbl->buckets, 0,                                           \
+          HASH_INITIAL_NUM_BUCKETS*sizeof(struct UT_hash_bucket));             \
+} while(0)
+
+#define HASH_ADD(hh,head,fieldname,keylen_in,add)                              \
+        HASH_ADD_KEYPTR(hh,head,&add->fieldname,keylen_in,add)
+ 
+#define HASH_ADD_KEYPTR(hh,head,keyptr,keylen_in,add)                          \
+do {                                                                           \
+ unsigned _ha_bkt;                                                             \
+ (add)->hh.next = NULL;                                                        \
+ (add)->hh.key = (char*)keyptr;                                                \
+ (add)->hh.keylen = keylen_in;                                                 \
+ if (!(head)) {                                                                \
+    head = (add);                                                              \
+    (head)->hh.prev = NULL;                                                    \
+    HASH_MAKE_TABLE(hh,head);                                                  \
+ } else {                                                                      \
+    (head)->hh.tbl->tail->next = (add);                                        \
+    (add)->hh.prev = ELMT_FROM_HH((head)->hh.tbl, (head)->hh.tbl->tail);       \
+    (head)->hh.tbl->tail = &((add)->hh);                                       \
+ }                                                                             \
+ (head)->hh.tbl->num_items++;                                                  \
+ (add)->hh.tbl = (head)->hh.tbl;                                               \
+ HASH_FCN(keyptr,keylen_in, (head)->hh.tbl->num_buckets,                       \
+         (add)->hh.hashv, _ha_bkt);                                            \
+ HASH_ADD_TO_BKT((head)->hh.tbl->buckets[_ha_bkt],&(add)->hh);                 \
+ HASH_EMIT_KEY(hh,head,keyptr,keylen_in);                                      \
+ HASH_FSCK(hh,head);                                                           \
+} while(0)
+
+#define HASH_TO_BKT( hashv, num_bkts, bkt )                                    \
+do {                                                                           \
+  bkt = ((hashv) & ((num_bkts) - 1));                                          \
+} while(0)
+
+/* delete "delptr" from the hash table.
+ * "the usual" patch-up process for the app-order doubly-linked-list.
+ * The use of _hd_hh_del below deserves special explanation.
+ * These used to be expressed using (delptr) but that led to a bug
+ * if someone used the same symbol for the head and deletee, like
+ *  HASH_DELETE(hh,users,users);
+ * We want that to work, but by changing the head (users) below
+ * we were forfeiting our ability to further refer to the deletee (users)
+ * in the patch-up process. Solution: use scratch space in the table to
+ * copy the deletee pointer, then the latter references are via that
+ * scratch pointer rather than through the repointed (users) symbol.
+ */
+#define HASH_DELETE(hh,head,delptr)                                            \
+do {                                                                           \
+    unsigned _hd_bkt;                                                          \
+    struct UT_hash_handle *_hd_hh_del;                                         \
+    if ( ((delptr)->hh.prev == NULL) && ((delptr)->hh.next == NULL) )  {       \
+        uthash_bkt_free((head)->hh.tbl->buckets );                             \
+        uthash_tbl_free((head)->hh.tbl);                                       \
+        head = NULL;                                                           \
+    } else {                                                                   \
+        _hd_hh_del = &((delptr)->hh);                                          \
+        if ((delptr) == ELMT_FROM_HH((head)->hh.tbl,(head)->hh.tbl->tail)) {   \
+            (head)->hh.tbl->tail =                                             \
+                (UT_hash_handle*)((char*)((delptr)->hh.prev) +                 \
+                (head)->hh.tbl->hho);                                          \
+        }                                                                      \
+        if ((delptr)->hh.prev) {                                               \
+            ((UT_hash_handle*)((char*)((delptr)->hh.prev) +                    \
+                    (head)->hh.tbl->hho))->next = (delptr)->hh.next;           \
+        } else {                                                               \
+            head = TYPEOF(head)((delptr)->hh.next);                            \
+        }                                                                      \
+        if (_hd_hh_del->next) {                                                \
+            ((UT_hash_handle*)((char*)_hd_hh_del->next +                       \
+                    (head)->hh.tbl->hho))->prev =                              \
+                    _hd_hh_del->prev;                                          \
+        }                                                                      \
+        HASH_TO_BKT( _hd_hh_del->hashv, (head)->hh.tbl->num_buckets, _hd_bkt); \
+        HASH_DEL_IN_BKT(hh,(head)->hh.tbl->buckets[_hd_bkt], _hd_hh_del);      \
+        (head)->hh.tbl->num_items--;                                           \
+    }                                                                          \
+    HASH_FSCK(hh,head);                                                        \
+} while (0)
+
+
+/* convenience forms of HASH_FIND/HASH_ADD/HASH_DEL */
+#define HASH_FIND_STR(head,findstr,out)                                        \
+    HASH_FIND(hh,head,findstr,strlen(findstr),out)
+#define HASH_ADD_STR(head,strfield,add)                                        \
+    HASH_ADD(hh,head,strfield,strlen(add->strfield),add)
+#define HASH_FIND_INT(head,findint,out)                                        \
+    HASH_FIND(hh,head,findint,sizeof(int),out)
+#define HASH_ADD_INT(head,intfield,add)                                        \
+    HASH_ADD(hh,head,intfield,sizeof(int),add)
+#define HASH_DEL(head,delptr)                                                  \
+    HASH_DELETE(hh,head,delptr)
+
+/* HASH_FSCK checks hash integrity on every add/delete when HASH_DEBUG is defined.
+ * This is for uthash developer only; it compiles away if HASH_DEBUG isn't defined.
+ */
+#ifdef HASH_DEBUG
+#define HASH_OOPS(...) do { fprintf(stderr,__VA_ARGS__); exit(-1); } while (0)
+#define HASH_FSCK(hh,head)                                                     \
+do {                                                                           \
+    unsigned _bkt_i;                                                           \
+    unsigned _count, _bkt_count;                                               \
+    char *_prev;                                                               \
+    struct UT_hash_handle *_thh;                                               \
+    if (head) {                                                                \
+        _count = 0;                                                            \
+        for( _bkt_i = 0; _bkt_i < (head)->hh.tbl->num_buckets; _bkt_i++) {     \
+            _bkt_count = 0;                                                    \
+            _thh = (head)->hh.tbl->buckets[_bkt_i].hh_head;                    \
+            _prev = NULL;                                                      \
+            while (_thh) {                                                     \
+               if (_prev != (char*)(_thh->hh_prev)) {                          \
+                   HASH_OOPS("invalid hh_prev %p, actual %p\n",                \
+                    _thh->hh_prev, _prev );                                    \
+               }                                                               \
+               _bkt_count++;                                                   \
+               _prev = (char*)(_thh);                                          \
+               _thh = _thh->hh_next;                                           \
+            }                                                                  \
+            _count += _bkt_count;                                              \
+            if ((head)->hh.tbl->buckets[_bkt_i].count !=  _bkt_count) {        \
+               HASH_OOPS("invalid bucket count %d, actual %d\n",               \
+                (head)->hh.tbl->buckets[_bkt_i].count, _bkt_count);            \
+            }                                                                  \
+        }                                                                      \
+        if (_count != (head)->hh.tbl->num_items) {                             \
+            HASH_OOPS("invalid hh item count %d, actual %d\n",                 \
+                (head)->hh.tbl->num_items, _count );                           \
+        }                                                                      \
+        /* traverse hh in app order; check next/prev integrity, count */       \
+        _count = 0;                                                            \
+        _prev = NULL;                                                          \
+        _thh =  &(head)->hh;                                                   \
+        while (_thh) {                                                         \
+           _count++;                                                           \
+           if (_prev !=(char*)(_thh->prev)) {                                  \
+              HASH_OOPS("invalid prev %p, actual %p\n",                        \
+                    _thh->prev, _prev );                                       \
+           }                                                                   \
+           _prev = (char*)ELMT_FROM_HH((head)->hh.tbl, _thh);                  \
+           _thh = ( _thh->next ?  (UT_hash_handle*)((char*)(_thh->next) +      \
+                                  (head)->hh.tbl->hho) : NULL );               \
+        }                                                                      \
+        if (_count != (head)->hh.tbl->num_items) {                             \
+            HASH_OOPS("invalid app item count %d, actual %d\n",                \
+                (head)->hh.tbl->num_items, _count );                           \
+        }                                                                      \
+    }                                                                          \
+} while (0)
+#else
+#define HASH_FSCK(hh,head) 
+#endif
+
+/* When compiled with -DHASH_EMIT_KEYS, length-prefixed keys are emitted to 
+ * the descriptor to which this macro is defined for tuning the hash function.
+ * The app can #include <unistd.h> to get the prototype for write(2). */
+#ifdef HASH_EMIT_KEYS
+#define HASH_EMIT_KEY(hh,head,keyptr,fieldlen)                                 \
+do {                                                                           \
+    unsigned _klen = fieldlen;                                                 \
+    write(HASH_EMIT_KEYS, &_klen, sizeof(_klen));                              \
+    write(HASH_EMIT_KEYS, keyptr, fieldlen);                                   \
+} while (0)
+#else 
+#define HASH_EMIT_KEY(hh,head,keyptr,fieldlen)                    
+#endif
+
+/* default to MurmurHash unless overridden e.g. DHASH_FUNCTION=HASH_SAX */
+#ifdef HASH_FUNCTION 
+#define HASH_FCN HASH_FUNCTION
+#else
+#define HASH_FCN HASH_MUR
+#endif
+
+/* The Bernstein hash function, used in Perl prior to v5.6 */
+#define HASH_BER(key,keylen,num_bkts,hashv,bkt)                                \
+do {                                                                           \
+  unsigned _hb_keylen=keylen;                                                  \
+  char *_hb_key=(char*)key;                                                    \
+  (hashv) = 0;                                                                 \
+  while (_hb_keylen--)  { (hashv) = ((hashv) * 33) + *_hb_key++; }             \
+  bkt = (hashv) & (num_bkts-1);                                                \
+} while (0)
+
+
+/* SAX/FNV/OAT/JEN hash functions are macro variants of those listed at 
+ * http://eternallyconfuzzled.com/tuts/algorithms/jsw_tut_hashing.aspx */
+#define HASH_SAX(key,keylen,num_bkts,hashv,bkt)                                \
+do {                                                                           \
+  unsigned _sx_i;                                                              \
+  char *_hs_key=(char*)key;                                                    \
+  hashv = 0;                                                                   \
+  for(_sx_i=0; _sx_i < keylen; _sx_i++)                                        \
+      hashv ^= (hashv << 5) + (hashv >> 2) + _hs_key[_sx_i];                   \
+  bkt = hashv & (num_bkts-1);                                                  \
+} while (0)
+
+#define HASH_FNV(key,keylen,num_bkts,hashv,bkt)                                \
+do {                                                                           \
+  unsigned _fn_i;                                                              \
+  char *_hf_key=(char*)key;                                                    \
+  hashv = 2166136261UL;                                                        \
+  for(_fn_i=0; _fn_i < keylen; _fn_i++)                                        \
+      hashv = (hashv * 16777619) ^ _hf_key[_fn_i];                             \
+  bkt = hashv & (num_bkts-1);                                                  \
+} while(0);
+ 
+#define HASH_OAT(key,keylen,num_bkts,hashv,bkt)                                \
+do {                                                                           \
+  unsigned _ho_i;                                                              \
+  char *_ho_key=(char*)key;                                                    \
+  hashv = 0;                                                                   \
+  for(_ho_i=0; _ho_i < keylen; _ho_i++) {                                      \
+      hashv += _ho_key[_ho_i];                                                 \
+      hashv += (hashv << 10);                                                  \
+      hashv ^= (hashv >> 6);                                                   \
+  }                                                                            \
+  hashv += (hashv << 3);                                                       \
+  hashv ^= (hashv >> 11);                                                      \
+  hashv += (hashv << 15);                                                      \
+  bkt = hashv & (num_bkts-1);                                                  \
+} while(0)
+
+#define HASH_JEN_MIX(a,b,c)                                                    \
+do {                                                                           \
+  a -= b; a -= c; a ^= ( c >> 13 );                                            \
+  b -= c; b -= a; b ^= ( a << 8 );                                             \
+  c -= a; c -= b; c ^= ( b >> 13 );                                            \
+  a -= b; a -= c; a ^= ( c >> 12 );                                            \
+  b -= c; b -= a; b ^= ( a << 16 );                                            \
+  c -= a; c -= b; c ^= ( b >> 5 );                                             \
+  a -= b; a -= c; a ^= ( c >> 3 );                                             \
+  b -= c; b -= a; b ^= ( a << 10 );                                            \
+  c -= a; c -= b; c ^= ( b >> 15 );                                            \
+} while (0)
+
+#define HASH_JEN(key,keylen,num_bkts,hashv,bkt)                                \
+do {                                                                           \
+  unsigned _hj_i,_hj_j,_hj_k;                                                  \
+  char *_hj_key=(char*)key;                                                    \
+  hashv = 0xfeedbeef;                                                          \
+  _hj_i = _hj_j = 0x9e3779b9;                                                  \
+  _hj_k = keylen;                                                              \
+  while (_hj_k >= 12) {                                                        \
+    _hj_i +=    (_hj_key[0] + ( (unsigned)_hj_key[1] << 8 )                    \
+        + ( (unsigned)_hj_key[2] << 16 )                                       \
+        + ( (unsigned)_hj_key[3] << 24 ) );                                    \
+    _hj_j +=    (_hj_key[4] + ( (unsigned)_hj_key[5] << 8 )                    \
+        + ( (unsigned)_hj_key[6] << 16 )                                       \
+        + ( (unsigned)_hj_key[7] << 24 ) );                                    \
+    hashv += (_hj_key[8] + ( (unsigned)_hj_key[9] << 8 )                       \
+        + ( (unsigned)_hj_key[10] << 16 )                                      \
+        + ( (unsigned)_hj_key[11] << 24 ) );                                   \
+                                                                               \
+     HASH_JEN_MIX(_hj_i, _hj_j, hashv);                                        \
+                                                                               \
+     _hj_key += 12;                                                            \
+     _hj_k -= 12;                                                              \
+  }                                                                            \
+  hashv += keylen;                                                             \
+  switch ( _hj_k ) {                                                           \
+     case 11: hashv += ( (unsigned)_hj_key[10] << 24 );                        \
+     case 10: hashv += ( (unsigned)_hj_key[9] << 16 );                         \
+     case 9:  hashv += ( (unsigned)_hj_key[8] << 8 );                          \
+     case 8:  _hj_j += ( (unsigned)_hj_key[7] << 24 );                         \
+     case 7:  _hj_j += ( (unsigned)_hj_key[6] << 16 );                         \
+     case 6:  _hj_j += ( (unsigned)_hj_key[5] << 8 );                          \
+     case 5:  _hj_j += _hj_key[4];                                             \
+     case 4:  _hj_i += ( (unsigned)_hj_key[3] << 24 );                         \
+     case 3:  _hj_i += ( (unsigned)_hj_key[2] << 16 );                         \
+     case 2:  _hj_i += ( (unsigned)_hj_key[1] << 8 );                          \
+     case 1:  _hj_i += _hj_key[0];                                             \
+  }                                                                            \
+  HASH_JEN_MIX(_hj_i, _hj_j, hashv);                                           \
+  bkt = hashv & (num_bkts-1);                                                  \
+} while(0)
+
+/* The Paul Hsieh hash function */
+#undef get16bits
+#if (defined(__GNUC__) && defined(__i386__)) || defined(__WATCOMC__)           \
+  || defined(_MSC_VER) || defined (__BORLANDC__) || defined (__TURBOC__)
+#define get16bits(d) (*((const uint16_t *) (d)))
+#endif
+
+#if !defined (get16bits)
+#define get16bits(d) ((((uint32_t)(((const uint8_t *)(d))[1])) << 8)\
+                       +(uint32_t)(((const uint8_t *)(d))[0]) )
+#endif
+#define HASH_SFH(key,keylen,num_bkts,hashv,bkt)                                \
+do {                                                                           \
+  char *_sfh_key=(char*)key;                                                   \
+  hashv = 0xcafebabe;                                                          \
+  uint32_t _sfh_tmp, _sfh_len = keylen;                                        \
+                                                                               \
+  int _sfh_rem = _sfh_len & 3;                                                 \
+  _sfh_len >>= 2;                                                              \
+                                                                               \
+  /* Main loop */                                                              \
+  for (;_sfh_len > 0; _sfh_len--) {                                            \
+    hashv    += get16bits (_sfh_key);                                          \
+    _sfh_tmp       = (get16bits (_sfh_key+2) << 11) ^ hashv;                   \
+    hashv     = (hashv << 16) ^ _sfh_tmp;                                      \
+    _sfh_key += 2*sizeof (uint16_t);                                           \
+    hashv    += hashv >> 11;                                                   \
+  }                                                                            \
+                                                                               \
+  /* Handle end cases */                                                       \
+  switch (_sfh_rem) {                                                          \
+    case 3: hashv += get16bits (_sfh_key);                                     \
+            hashv ^= hashv << 16;                                              \
+            hashv ^= _sfh_key[sizeof (uint16_t)] << 18;                        \
+            hashv += hashv >> 11;                                              \
+            break;                                                             \
+    case 2: hashv += get16bits (_sfh_key);                                     \
+            hashv ^= hashv << 11;                                              \
+            hashv += hashv >> 17;                                              \
+            break;                                                             \
+    case 1: hashv += *_sfh_key;                                                \
+            hashv ^= hashv << 10;                                              \
+            hashv += hashv >> 1;                                               \
+  }                                                                            \
+                                                                               \
+    /* Force "avalanching" of final 127 bits */                                \
+    hashv ^= hashv << 3;                                                       \
+    hashv += hashv >> 5;                                                       \
+    hashv ^= hashv << 4;                                                       \
+    hashv += hashv >> 17;                                                      \
+    hashv ^= hashv << 25;                                                      \
+    hashv += hashv >> 6;                                                       \
+    bkt = hashv & (num_bkts-1);                                                \
+} while(0);
+
+/* Austin Appleby's MurmurHash */
+#define HASH_MUR(key,keylen,num_bkts,hashv,bkt)                                \
+do {                                                                           \
+  const unsigned int _mur_m = 0x5bd1e995;                                      \
+  const int _mur_r = 24;                                                       \
+  hashv = 0xcafebabe ^ keylen;                                                 \
+  char *_mur_key = (char *)key;                                                \
+  uint32_t _mur_tmp, _mur_len = keylen;                                        \
+                                                                               \
+  for (;_mur_len >= 4; _mur_len-=4) {                                          \
+    _mur_tmp = *(uint32_t *)_mur_key;                                          \
+    _mur_tmp *= _mur_m;                                                        \
+    _mur_tmp ^= _mur_tmp >> _mur_r;                                            \
+    _mur_tmp *= _mur_m;                                                        \
+    hashv *= _mur_m;                                                           \
+    hashv ^= _mur_tmp;                                                         \
+    _mur_key += 4;                                                             \
+  }                                                                            \
+                                                                               \
+  switch(_mur_len)                                                             \
+  {                                                                            \
+    case 3: hashv ^= _mur_key[2] << 16;                                        \
+    case 2: hashv ^= _mur_key[1] << 8;                                         \
+    case 1: hashv ^= _mur_key[0];                                              \
+            hashv *= _mur_m;                                                   \
+  };                                                                           \
+                                                                               \
+  hashv ^= hashv >> 13;                                                        \
+  hashv *= _mur_m;                                                             \
+  hashv ^= hashv >> 15;                                                        \
+                                                                               \
+  bkt = hashv & (num_bkts-1);                                                  \
+} while(0)
+
+/* key comparison function; return 0 if keys equal */
+#define HASH_KEYCMP(a,b,len) memcmp(a,b,len) 
+
+/* iterate over items in a known bucket to find desired item */
+#define HASH_FIND_IN_BKT(tbl,hh,head,keyptr,keylen_in,out)                     \
+out = TYPEOF(out)((head.hh_head) ? ELMT_FROM_HH(tbl,head.hh_head) : NULL);     \
+while (out) {                                                                  \
+    if (out->hh.keylen == keylen_in) {                                         \
+        if ((HASH_KEYCMP(out->hh.key,keyptr,keylen_in)) == 0) break;           \
+    }                                                                          \
+    out= TYPEOF(out)((out->hh.hh_next) ?                                       \
+                     ELMT_FROM_HH(tbl,out->hh.hh_next) : NULL);                \
+}
+
+/* add an item to a bucket  */
+#define HASH_ADD_TO_BKT(head,addhh)                                            \
+do {                                                                           \
+ head.count++;                                                                 \
+ (addhh)->hh_next = head.hh_head;                                              \
+ (addhh)->hh_prev = NULL;                                                      \
+ if (head.hh_head) { (head).hh_head->hh_prev = (addhh); }                      \
+ (head).hh_head=addhh;                                                         \
+ if (head.count >= ((head.expand_mult+1) * HASH_BKT_CAPACITY_THRESH)           \
+     && (addhh)->tbl->noexpand != 1) {                                         \
+       HASH_EXPAND_BUCKETS((addhh)->tbl);                                      \
+ }                                                                             \
+} while(0)
+
+/* remove an item from a given bucket */
+#define HASH_DEL_IN_BKT(hh,head,hh_del)                                        \
+    (head).count--;                                                            \
+    if ((head).hh_head == hh_del) {                                            \
+      (head).hh_head = hh_del->hh_next;                                        \
+    }                                                                          \
+    if (hh_del->hh_prev) {                                                     \
+        hh_del->hh_prev->hh_next = hh_del->hh_next;                            \
+    }                                                                          \
+    if (hh_del->hh_next) {                                                     \
+        hh_del->hh_next->hh_prev = hh_del->hh_prev;                            \
+    }                                                                
+
+/* Bucket expansion has the effect of doubling the number of buckets
+ * and redistributing the items into the new buckets. Ideally the
+ * items will distribute more or less evenly into the new buckets
+ * (the extent to which this is true is a measure of the quality of
+ * the hash function as it applies to the key domain). 
+ * 
+ * With the items distributed into more buckets, the chain length
+ * (item count) in each bucket is reduced. Thus by expanding buckets
+ * the hash keeps a bound on the chain length. This bounded chain 
+ * length is the essence of how a hash provides constant time lookup.
+ * 
+ * The calculation of tbl->ideal_chain_maxlen below deserves some
+ * explanation. First, keep in mind that we're calculating the ideal
+ * maximum chain length based on the *new* (doubled) bucket count.
+ * In fractions this is just n/b (n=number of items,b=new num buckets).
+ * Since the ideal chain length is an integer, we want to calculate 
+ * ceil(n/b). We don't depend on floating point arithmetic in this
+ * hash, so to calculate ceil(n/b) with integers we could write
+ * 
+ *      ceil(n/b) = (n/b) + ((n%b)?1:0)
+ * 
+ * and in fact a previous version of this hash did just that.
+ * But now we have improved things a bit by recognizing that b is
+ * always a power of two. We keep its base 2 log handy (call it lb),
+ * so now we can write this with a bit shift and logical AND:
+ * 
+ *      ceil(n/b) = (n>>lb) + ( (n & (b-1)) ? 1:0)
+ * 
+ */
+#define HASH_EXPAND_BUCKETS(tbl)                                               \
+do {                                                                           \
+    unsigned _he_bkt;                                                          \
+    unsigned _he_bkt_i;                                                        \
+    struct UT_hash_handle *_he_thh, *_he_hh_nxt;                               \
+    UT_hash_bucket *_he_new_buckets, *_he_newbkt;                              \
+    _he_new_buckets = (UT_hash_bucket*)uthash_bkt_malloc(                      \
+             2 * tbl->num_buckets * sizeof(struct UT_hash_bucket));            \
+    if (!_he_new_buckets) { uthash_fatal( "out of memory"); }                  \
+    memset(_he_new_buckets, 0,                                                 \
+            2 * tbl->num_buckets * sizeof(struct UT_hash_bucket));             \
+    tbl->ideal_chain_maxlen =                                                  \
+       (tbl->num_items >> (tbl->log2_num_buckets+1)) +                         \
+       ((tbl->num_items & ((tbl->num_buckets*2)-1)) ? 1 : 0);                  \
+    tbl->nonideal_items = 0;                                                   \
+    for(_he_bkt_i = 0; _he_bkt_i < tbl->num_buckets; _he_bkt_i++)              \
+    {                                                                          \
+        _he_thh = tbl->buckets[ _he_bkt_i ].hh_head;                           \
+        while (_he_thh) {                                                      \
+           _he_hh_nxt = _he_thh->hh_next;                                      \
+           HASH_TO_BKT( _he_thh->hashv, tbl->num_buckets*2, _he_bkt);          \
+           _he_newbkt = &(_he_new_buckets[ _he_bkt ]);                         \
+           if (++(_he_newbkt->count) > tbl->ideal_chain_maxlen) {              \
+             tbl->nonideal_items++;                                            \
+             _he_newbkt->expand_mult = _he_newbkt->count /                     \
+                                        tbl->ideal_chain_maxlen;               \
+           }                                                                   \
+           _he_thh->hh_prev = NULL;                                            \
+           _he_thh->hh_next = _he_newbkt->hh_head;                             \
+           if (_he_newbkt->hh_head) _he_newbkt->hh_head->hh_prev =             \
+                _he_thh;                                                       \
+           _he_newbkt->hh_head = _he_thh;                                      \
+           _he_thh = _he_hh_nxt;                                               \
+        }                                                                      \
+    }                                                                          \
+    tbl->num_buckets *= 2;                                                     \
+    tbl->log2_num_buckets++;                                                   \
+    uthash_bkt_free( tbl->buckets );                                           \
+    tbl->buckets = _he_new_buckets;                                            \
+    tbl->ineff_expands = (tbl->nonideal_items > (tbl->num_items >> 1)) ?       \
+        (tbl->ineff_expands+1) : 0;                                            \
+    if (tbl->ineff_expands > 1) {                                              \
+        tbl->noexpand=1;                                                       \
+        uthash_noexpand_fyi(tbl);                                              \
+    }                                                                          \
+    uthash_expand_fyi(tbl);                                                    \
+} while(0)
+
+
+/* This is an adaptation of Simon Tatham's O(n log(n)) mergesort */
+/* Note that HASH_SORT assumes the hash handle name to be hh. 
+ * HASH_SRT was added to allow the hash handle name to be passed in. */
+#define HASH_SORT(head,cmpfcn) HASH_SRT(hh,head,cmpfcn)
+#define HASH_SRT(hh,head,cmpfcn)                                               \
+do {                                                                           \
+  unsigned _hs_i;                                                              \
+  unsigned _hs_looping,_hs_nmerges,_hs_insize,_hs_psize,_hs_qsize;             \
+  struct UT_hash_handle *_hs_p, *_hs_q, *_hs_e, *_hs_list, *_hs_tail;          \
+  if (head) {                                                                  \
+      _hs_insize = 1;                                                          \
+      _hs_looping = 1;                                                         \
+      _hs_list = &((head)->hh);                                                \
+      while (_hs_looping) {                                                    \
+          _hs_p = _hs_list;                                                    \
+          _hs_list = NULL;                                                     \
+          _hs_tail = NULL;                                                     \
+          _hs_nmerges = 0;                                                     \
+          while (_hs_p) {                                                      \
+              _hs_nmerges++;                                                   \
+              _hs_q = _hs_p;                                                   \
+              _hs_psize = 0;                                                   \
+              for ( _hs_i = 0; _hs_i  < _hs_insize; _hs_i++ ) {                \
+                  _hs_psize++;                                                 \
+                  _hs_q = (UT_hash_handle*)((_hs_q->next) ?                    \
+                          ((void*)((char*)(_hs_q->next) +                      \
+                          (head)->hh.tbl->hho)) : NULL);                       \
+                  if (! (_hs_q) ) break;                                       \
+              }                                                                \
+              _hs_qsize = _hs_insize;                                          \
+              while ((_hs_psize > 0) || ((_hs_qsize > 0) && _hs_q )) {         \
+                  if (_hs_psize == 0) {                                        \
+                      _hs_e = _hs_q;                                           \
+                      _hs_q = (UT_hash_handle*)((_hs_q->next) ?                \
+                              ((void*)((char*)(_hs_q->next) +                  \
+                              (head)->hh.tbl->hho)) : NULL);                   \
+                      _hs_qsize--;                                             \
+                  } else if ( (_hs_qsize == 0) || !(_hs_q) ) {                 \
+                      _hs_e = _hs_p;                                           \
+                      _hs_p = (UT_hash_handle*)((_hs_p->next) ?                \
+                              ((void*)((char*)(_hs_p->next) +                  \
+                              (head)->hh.tbl->hho)) : NULL);                   \
+                      _hs_psize--;                                             \
+                  } else if ((                                                 \
+                      cmpfcn(TYPEOF(head)(ELMT_FROM_HH((head)->hh.tbl,_hs_p)), \
+                            TYPEOF(head)(ELMT_FROM_HH((head)->hh.tbl,_hs_q)))  \
+                             ) <= 0) {                                         \
+                      _hs_e = _hs_p;                                           \
+                      _hs_p = (UT_hash_handle*)((_hs_p->next) ?                \
+                              ((void*)((char*)(_hs_p->next) +                  \
+                              (head)->hh.tbl->hho)) : NULL);                   \
+                      _hs_psize--;                                             \
+                  } else {                                                     \
+                      _hs_e = _hs_q;                                           \
+                      _hs_q = (UT_hash_handle*)((_hs_q->next) ?                \
+                              ((void*)((char*)(_hs_q->next) +                  \
+                              (head)->hh.tbl->hho)) : NULL);                   \
+                      _hs_qsize--;                                             \
+                  }                                                            \
+                  if ( _hs_tail ) {                                            \
+                      _hs_tail->next = ((_hs_e) ?                              \
+                            ELMT_FROM_HH((head)->hh.tbl,_hs_e) : NULL);        \
+                  } else {                                                     \
+                      _hs_list = _hs_e;                                        \
+                  }                                                            \
+                  _hs_e->prev = ((_hs_tail) ?                                  \
+                     ELMT_FROM_HH((head)->hh.tbl,_hs_tail) : NULL);            \
+                  _hs_tail = _hs_e;                                            \
+              }                                                                \
+              _hs_p = _hs_q;                                                   \
+          }                                                                    \
+          _hs_tail->next = NULL;                                               \
+          if ( _hs_nmerges <= 1 ) {                                            \
+              _hs_looping=0;                                                   \
+              (head)->hh.tbl->tail = _hs_tail;                                 \
+              (head) = TYPEOF(head)ELMT_FROM_HH((head)->hh.tbl, _hs_list);     \
+          }                                                                    \
+          _hs_insize *= 2;                                                     \
+      }                                                                        \
+      HASH_FSCK(hh,head);                                                      \
+ }                                                                             \
+} while (0)
+
+/* This function selects items from one hash into another hash. 
+ * The end result is that the selected items have dual presence 
+ * in both hashes. There is no copy of the items made; rather 
+ * they are added into the new hash through a secondary hash 
+ * hash handle that must be present in the structure. */
+#define HASH_SELECT(hh_dst, dst, hh_src, src, cond)                            \
+do {                                                                           \
+  unsigned _src_bkt, _dst_bkt;                                                 \
+  void *_last_elt=NULL, *_elt;                                                 \
+  UT_hash_handle *_src_hh, *_dst_hh, *_last_elt_hh=NULL;                       \
+  ptrdiff_t _dst_hho = ((char*)(&(dst)->hh_dst) - (char*)(dst));               \
+  if (src) {                                                                   \
+    for(_src_bkt=0; _src_bkt < (src)->hh_src.tbl->num_buckets; _src_bkt++) {   \
+      for(_src_hh = (src)->hh_src.tbl->buckets[_src_bkt].hh_head;              \
+          _src_hh;                                                             \
+          _src_hh = _src_hh->hh_next) {                                        \
+          _elt = ELMT_FROM_HH((src)->hh_src.tbl, _src_hh);                     \
+          if (cond(_elt)) {                                                    \
+            _dst_hh = (UT_hash_handle*)(((char*)_elt) + _dst_hho);             \
+            _dst_hh->key = _src_hh->key;                                       \
+            _dst_hh->keylen = _src_hh->keylen;                                 \
+            _dst_hh->hashv = _src_hh->hashv;                                   \
+            _dst_hh->prev = _last_elt;                                         \
+            _dst_hh->next = NULL;                                              \
+            if (_last_elt_hh) { _last_elt_hh->next = _elt; }                   \
+            if (!dst) {                                                        \
+              dst = TYPEOF(dst)_elt;                                           \
+              HASH_MAKE_TABLE(hh_dst,dst);                                     \
+            } else {                                                           \
+              _dst_hh->tbl = (dst)->hh_dst.tbl;                                \
+            }                                                                  \
+            HASH_TO_BKT(_dst_hh->hashv, _dst_hh->tbl->num_buckets, _dst_bkt);  \
+            HASH_ADD_TO_BKT(_dst_hh->tbl->buckets[_dst_bkt],_dst_hh);          \
+            (dst)->hh_dst.tbl->num_items++;                                    \
+            _last_elt = _elt;                                                  \
+            _last_elt_hh = _dst_hh;                                            \
+          }                                                                    \
+      }                                                                        \
+    }                                                                          \
+  }                                                                            \
+  HASH_FSCK(hh_dst,dst);                                                       \
+} while (0)
+
+#define HASH_CLEAR(hh,head)                                                    \
+do {                                                                           \
+  if (head) {                                                                  \
+    uthash_bkt_free((head)->hh.tbl->buckets );                                 \
+    uthash_tbl_free((head)->hh.tbl);                                           \
+    (head)=NULL;                                                               \
+  }                                                                            \
+} while(0)
+
+/* obtain a count of items in the hash */
+#define HASH_COUNT(head) HASH_CNT(hh,head) 
+#define HASH_CNT(hh,head) (head?(head->hh.tbl->num_items):0)
+
+typedef struct UT_hash_bucket {
+   struct UT_hash_handle *hh_head;
+   unsigned count;
+
+   /* expand_mult is normally set to 0. In this situation, the max chain length
+    * threshold is enforced at its default value, HASH_BKT_CAPACITY_THRESH. (If
+    * the bucket's chain exceeds this length, bucket expansion is triggered). 
+    * However, setting expand_mult to a non-zero value delays bucket expansion
+    * (that would be triggered by additions to this particular bucket)
+    * until its chain length reaches a *multiple* of HASH_BKT_CAPACITY_THRESH.
+    * (The multiplier is simply expand_mult+1). The whole idea of this
+    * multiplier is to reduce bucket expansions, since they are expensive, in
+    * situations where we know that a particular bucket tends to be overused.
+    * It is better to let its chain length grow to a longer yet-still-bounded
+    * value, than to do an O(n) bucket expansion too often. 
+    */
+   unsigned expand_mult;
+
+} UT_hash_bucket;
+
+typedef struct UT_hash_table {
+   UT_hash_bucket *buckets;
+   unsigned num_buckets, log2_num_buckets;
+   unsigned num_items;
+   struct UT_hash_handle *tail; /* tail hh in app order, for fast append    */
+   ptrdiff_t hho; /* hash handle offset (byte pos of hash handle in element */
+
+   /* in an ideal situation (all buckets used equally), no bucket would have
+    * more than ceil(#items/#buckets) items. that's the ideal chain length. */
+   unsigned ideal_chain_maxlen;
+
+   /* nonideal_items is the number of items in the hash whose chain position
+    * exceeds the ideal chain maxlen. these items pay the penalty for an uneven
+    * hash distribution; reaching them in a chain traversal takes >ideal steps */
+   unsigned nonideal_items;
+
+   /* ineffective expands occur when a bucket doubling was performed, but 
+    * afterward, more than half the items in the hash had nonideal chain
+    * positions. If this happens on two consecutive expansions we inhibit any
+    * further expansion, as it's not helping; this happens when the hash
+    * function isn't a good fit for the key domain. When expansion is inhibited
+    * the hash will still work, albeit no longer in constant time. */
+   unsigned ineff_expands, noexpand;
+
+
+} UT_hash_table;
+
+
+typedef struct UT_hash_handle {
+   struct UT_hash_table *tbl;
+   void *prev;                       /* prev element in app order      */
+   void *next;                       /* next element in app order      */
+   struct UT_hash_handle *hh_prev;   /* previous hh in bucket order    */
+   struct UT_hash_handle *hh_next;   /* next hh in bucket order        */
+   void *key;                        /* ptr to enclosing struct's key  */
+   unsigned keylen;                  /* enclosing struct's key len     */
+   unsigned hashv;                   /* result of hash-fcn(key)        */
+} UT_hash_handle;
+
+#endif /* UTHASH_H */

src/rt/uthash/utlist.h

@@ -0,0 +1,280 @@
+/*
+Copyright (c) 2007-2009, Troy D. Hanson
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT OWNER
+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.
+*/
+
+#ifndef UTLIST_H
+#define UTLIST_H
+
+#define UTLIST_VERSION 1.0
+
+/* C++ requires extra stringent casting */
+#if defined __cplusplus
+#define LTYPEOF(x) (typeof(x))
+#else
+#define LTYPEOF(x)
+#endif
+/* 
+ * This file contains macros to manipulate singly and doubly-linked lists.
+ *
+ * 1. LL_ macros:  singly-linked lists.
+ * 2. DL_ macros:  doubly-linked lists.
+ * 3. CDL_ macros: circular doubly-linked lists.
+ *
+ * To use singly-linked lists, your structure must have a "next" pointer.
+ * To use doubly-linked lists, your structure must "prev" and "next" pointers.
+ * Either way, the pointer to the head of the list must be initialized to NULL.
+ * 
+ * ----------------.EXAMPLE -------------------------
+ * struct item {
+ *      int id;
+ *      struct item *prev, *next;
+ * }
+ *
+ * struct item *list = NULL:
+ *
+ * int main() {
+ *      struct item *item;
+ *      ... allocate and populate item ...
+ *      DL_APPEND(list, item);
+ * }
+ * --------------------------------------------------
+ *
+ * For doubly-linked lists, the append and delete macros are O(1)
+ * For singly-linked lists, append and delete are O(n) but prepend is O(1)
+ * The sort macro is O(n log(n)) for all types of single/double/circular lists.
+ */
+
+/******************************************************************************
+ * The SORT macros                                                            *
+ *****************************************************************************/
+#define LL_SORT(l,cmp)                                                           \
+ LISTSORT(l,0,0,FIELD_OFFSET(l,next),cmp)
+#define DL_SORT(l,cmp)                                                           \
+ LISTSORT(l,0,FIELD_OFFSET(l,prev),FIELD_OFFSET(l,next),cmp)
+#define CDL_SORT(l,cmp)                                                          \
+ LISTSORT(l,1,FIELD_OFFSET(l,prev),FIELD_OFFSET(l,next),cmp)
+
+/* The macros can't assume or cast to the caller's list element type. So we use
+ * a couple tricks when we need to deal with those element's prev/next pointers.
+ * Basically we use char pointer arithmetic to get those field offsets. */
+#define FIELD_OFFSET(ptr,field) ((char*)&((ptr)->field) - (char*)(ptr))
+#define LNEXT(e,no) (*(char**)(((char*)e) + no))
+#define LPREV(e,po) (*(char**)(((char*)e) + po))
+/******************************************************************************
+ * The LISTSORT macro is an adaptation of Simon Tatham's O(n log(n)) mergesort*
+ * Unwieldy variable names used here to avoid shadowing passed-in variables.  *
+ *****************************************************************************/
+#define LISTSORT(list, is_circular, po, no, cmp)                                 \
+do {                                                                             \
+  void *_ls_p, *_ls_q, *_ls_e, *_ls_tail, *_ls_oldhead;                          \
+  int _ls_insize, _ls_nmerges, _ls_psize, _ls_qsize, _ls_i, _ls_looping;         \
+  int _ls_is_double = (po==0) ? 0 : 1;                                           \
+  if (list) {                                                                    \
+    _ls_insize = 1;                                                              \
+    _ls_looping = 1;                                                             \
+    while (_ls_looping) {                                                        \
+      _ls_p = list;                                                              \
+      _ls_oldhead = list;                                                        \
+      list = NULL;                                                               \
+      _ls_tail = NULL;                                                           \
+      _ls_nmerges = 0;                                                           \
+      while (_ls_p) {                                                            \
+        _ls_nmerges++;                                                           \
+        _ls_q = _ls_p;                                                           \
+        _ls_psize = 0;                                                           \
+        for (_ls_i = 0; _ls_i < _ls_insize; _ls_i++) {                           \
+          _ls_psize++;                                                           \
+          if (is_circular)  {                                                    \
+            _ls_q = ((LNEXT(_ls_q,no) == _ls_oldhead) ? NULL : LNEXT(_ls_q,no)); \
+          } else  {                                                              \
+            _ls_q = LNEXT(_ls_q,no);                                             \
+          }                                                                      \
+          if (!_ls_q) break;                                                     \
+        }                                                                        \
+        _ls_qsize = _ls_insize;                                                  \
+        while (_ls_psize > 0 || (_ls_qsize > 0 && _ls_q)) {                      \
+          if (_ls_psize == 0) {                                                  \
+            _ls_e = _ls_q; _ls_q = LNEXT(_ls_q,no); _ls_qsize--;                 \
+            if (is_circular && _ls_q == _ls_oldhead) { _ls_q = NULL; }           \
+          } else if (_ls_qsize == 0 || !_ls_q) {                                 \
+            _ls_e = _ls_p; _ls_p = LNEXT(_ls_p,no); _ls_psize--;                 \
+            if (is_circular && (_ls_p == _ls_oldhead)) { _ls_p = NULL; }         \
+          } else if (cmp(LTYPEOF(list)_ls_p,LTYPEOF(list)_ls_q) <= 0) {          \
+            _ls_e = _ls_p; _ls_p = LNEXT(_ls_p,no); _ls_psize--;                 \
+            if (is_circular && (_ls_p == _ls_oldhead)) { _ls_p = NULL; }         \
+          } else {                                                               \
+            _ls_e = _ls_q; _ls_q = LNEXT(_ls_q,no); _ls_qsize--;                 \
+            if (is_circular && (_ls_q == _ls_oldhead)) { _ls_q = NULL; }         \
+          }                                                                      \
+          if (_ls_tail) {                                                        \
+            LNEXT(_ls_tail,no) = (char*)_ls_e;                                   \
+          } else {                                                               \
+            list = LTYPEOF(list)_ls_e;                                           \
+          }                                                                      \
+          if (_ls_is_double) {                                                   \
+            LPREV(_ls_e,po) = (char*)_ls_tail;                                   \
+          }                                                                      \
+          _ls_tail = _ls_e;                                                      \
+        }                                                                        \
+        _ls_p = _ls_q;                                                           \
+      }                                                                          \
+      if (is_circular) {                                                         \
+        LNEXT(_ls_tail,no) = (char*)list;                                        \
+        if (_ls_is_double) {                                                     \
+          LPREV(list,po) = (char*)_ls_tail;                                      \
+        }                                                                        \
+      } else  {                                                                  \
+        LNEXT(_ls_tail,no) = NULL;                                               \
+      }                                                                          \
+      if (_ls_nmerges <= 1) {                                                    \
+        _ls_looping=0;                                                           \
+      }                                                                          \
+      _ls_insize *= 2;                                                           \
+    }                                                                            \
+  }                                                                              \
+} while (0)
+
+/******************************************************************************
+ * singly linked list macros (non-circular)                                   *
+ *****************************************************************************/
+#define LL_PREPEND(head,add)                                                     \
+do {                                                                             \
+  (add)->next = head;                                                            \
+  head = add;                                                                    \
+} while (0)
+
+#define LL_APPEND(head,add)                                                      \
+do {                                                                             \
+  (add)->next=NULL;                                                              \
+  if (head) {                                                                    \
+    char *_lla_el = (char*)(head);                                               \
+    unsigned _lla_no = FIELD_OFFSET(head,next);                                  \
+    while (LNEXT(_lla_el,_lla_no)) { _lla_el = LNEXT(_lla_el,_lla_no); }         \
+    LNEXT(_lla_el,_lla_no)=(char*)(add);                                         \
+  } else {                                                                       \
+    (head)=(add);                                                                \
+  }                                                                              \
+} while (0)
+
+#define LL_DELETE(head,del)                                                      \
+do {                                                                             \
+  if ((head) == (del)) {                                                         \
+    (head)=(head)->next;                                                         \
+  } else {                                                                       \
+    char *_lld_el = (char*)(head);                                               \
+    unsigned _lld_no = FIELD_OFFSET(head,next);                                  \
+    while (LNEXT(_lld_el,_lld_no) && (LNEXT(_lld_el,_lld_no) != (char*)(del))) { \
+      _lld_el = LNEXT(_lld_el,_lld_no);                                          \
+    }                                                                            \
+    if (LNEXT(_lld_el,_lld_no)) {                                                \
+      LNEXT(_lld_el,_lld_no) = (char*)((del)->next);                             \
+    }                                                                            \
+  }                                                                              \
+} while (0)
+
+#define LL_FOREACH(head,el)                                                      \
+    for(el=head;el;el=el->next)
+
+/******************************************************************************
+ * doubly linked list macros (non-circular)                                   *
+ *****************************************************************************/
+#define DL_PREPEND(head,add)                                                     \
+do {                                                                             \
+ (add)->next = head;                                                             \
+ if (head) {                                                                     \
+   (add)->prev = (head)->prev;                                                   \
+   (head)->prev = (add);                                                         \
+ } else {                                                                        \
+   (add)->prev = (add);                                                          \
+ }                                                                               \
+ (head) = (add);                                                                 \
+} while (0)
+
+#define DL_APPEND(head,add)                                                      \
+do {                                                                             \
+  if (head) {                                                                    \
+      (add)->prev = (head)->prev;                                                \
+      (head)->prev->next = (add);                                                \
+      (head)->prev = (add);                                                      \
+      (add)->next = NULL;                                                        \
+  } else {                                                                       \
+      (head)=(add);                                                              \
+      (head)->prev = (head);                                                     \
+      (head)->next = NULL;                                                       \
+  }                                                                              \
+} while (0);
+
+#define DL_DELETE(head,del)                                                      \
+do {                                                                             \
+  if ((del)->prev == (del)) {                                                    \
+      (head)=NULL;                                                               \
+  } else if ((del)==(head)) {                                                    \
+      (del)->next->prev = (del)->prev;                                           \
+      (head) = (del)->next;                                                      \
+  } else {                                                                       \
+      (del)->prev->next = (del)->next;                                           \
+      if ((del)->next) {                                                         \
+          (del)->next->prev = (del)->prev;                                       \
+      } else {                                                                   \
+          (head)->prev = (del)->prev;                                            \
+      }                                                                          \
+  }                                                                              \
+} while (0);
+
+
+#define DL_FOREACH(head,el)                                                      \
+    for(el=head;el;el=el->next)
+
+/******************************************************************************
+ * circular doubly linked list macros                                         *
+ *****************************************************************************/
+#define CDL_PREPEND(head,add)                                                    \
+do {                                                                             \
+ if (head) {                                                                     \
+   (add)->prev = (head)->prev;                                                   \
+   (add)->next = (head);                                                         \
+   (head)->prev = (add);                                                         \
+   (add)->prev->next = (add);                                                    \
+ } else {                                                                        \
+   (add)->prev = (add);                                                          \
+   (add)->next = (add);                                                          \
+ }                                                                               \
+(head)=(add);                                                                    \
+} while (0)
+
+#define CDL_DELETE(head,del)                                                     \
+do {                                                                             \
+  if ( ((head)==(del)) && ((head)->next == (head))) {                            \
+      (head) = 0L;                                                               \
+  } else {                                                                       \
+     (del)->next->prev = (del)->prev;                                            \
+     (del)->prev->next = (del)->next;                                            \
+     if ((del) == (head)) (head)=(del)->next;                                    \
+  }                                                                              \
+} while (0);
+
+#define CDL_FOREACH(head,el)                                                     \
+    for(el=head;el;el= (el->next==head ? 0L : el->next)) 
+
+
+#endif /* UTLIST_H */
+

src/rt/util/array_list.h

@@ -0,0 +1,69 @@
+#ifndef ARRAY_LIST_H
+#define ARRAY_LIST_H
+
+/**
+ * A simple, resizable array list.
+ */
+template<typename T> class array_list {
+    static const size_t INITIAL_CAPACITY = 8;
+    size_t _size;
+    T * _data;
+    size_t _capacity;
+public:
+    array_list();
+    ~array_list();
+    size_t size();
+    void append(T value);
+    T replace(T old_value, T new_value);
+    size_t index_of(T value);
+    T & operator[](size_t index);
+};
+
+template<typename T> array_list<T>::array_list() {
+    _capacity = INITIAL_CAPACITY;
+    _data = (T *) malloc(sizeof(T) * _capacity);
+}
+
+template<typename T> array_list<T>::~array_list() {
+    delete _data;
+}
+
+template<typename T> size_t array_list<T>::size() {
+    return _size;
+}
+
+template<typename T> void array_list<T>::append(T value) {
+    if (_size == _capacity) {
+        _capacity = _capacity * 2;
+        _data = (T *) realloc(_data, _capacity * sizeof(T));
+    }
+    _data[_size++] = value;
+}
+
+/**
+ * Replaces the old_value in the list with the new_value.
+ * Returns the old_value if the replacement succeeded, or NULL otherwise.
+ */
+template<typename T> T array_list<T>::replace(T old_value, T new_value) {
+    int index = index_of(old_value);
+    if (index < 0) {
+        return NULL;
+    }
+    _data[index] = new_value;
+    return old_value;
+}
+
+template<typename T> size_t array_list<T>::index_of(T value) {
+    for (size_t i = 0; i < _size; i++) {
+        if (_data[i] == value) {
+            return i;
+        }
+    }
+    return -1;
+}
+
+template<typename T> T & array_list<T>::operator[](size_t index) {
+    return _data[index];
+}
+
+#endif /* ARRAY_LIST_H */

src/test/bench/shootout/ackermann.rs

@@ -0,0 +1,25 @@
+// -*- rust -*-
+
+fn ack(int m, int n) -> int {
+  if (m == 0) {
+    ret n+1;
+  } else {
+    if (n == 0) {
+      ret ack(m-1, 1);
+    } else {
+      ret ack(m-1, ack(m, n-1));
+    }
+  }
+}
+
+fn main() {
+  check (ack(0,0) == 1);
+  check (ack(3,2) == 29);
+  check (ack(3,4) == 125);
+
+  // This takes a while; but a comparison may amuse: on win32 at least, the
+  // posted C version of the 'benchmark' running ack(4,1) overruns its stack
+  // segment and crashes. We just grow our stack (to 4mb) as we go.
+
+  // check (ack(4,1) == 65533);
+}